HTTP/1.0 TEST

Index: .fossil-settings/binary-glob ================================================================== --- .fossil-settings/binary-glob +++ .fossil-settings/binary-glob @@ -2,8 +2,28 @@ compat/zlib/win32/zlib1.dll compat/zlib/win64/zdll.lib compat/zlib/win64/zlib1.dll compat/zlib/win64/libz.dll.a compat/zlib/zlib.3.pdf +compat/zlib/win32/zdll.lib +compat/zlib/win32/zlib1.dll +compat/zlib/win64/zdll.lib +compat/zlib/win64/zlib1.dll +compat/zlib/win64/libz.dll.a +compat/zlib/zlib.3.pdf +libtommath/win32/tommath.lib +libtommath/win32/libtommath.dll +libtommath/win64/tommath.lib +libtommath/win64/libtommath.dll +libtommath/win64/libtommath.dll.a +*.a *.bmp +*.dll +*.exe *.gif +*.gz +*.jpg +*.lib +*.pdf *.png +*.xlsx +*.zip Index: .fossil-settings/ignore-glob ================================================================== --- .fossil-settings/ignore-glob +++ .fossil-settings/ignore-glob @@ -1,11 +1,13 @@ *.a *.dll *.dylib *.exe *.exp +*.la *.lib +*.lo *.o *.obj *.pdb *.res *.sl @@ -26,11 +28,11 @@ libtommath/bn.ind libtommath/pretty.build libtommath/tommath.src libtommath/*.log libtommath/*.pdf -libtommath/*.pl +libtommath/gen.pl libtommath/*.sh libtommath/doc/* libtommath/tombc/* libtommath/pre_gen/* libtommath/pics/* @@ -45,9 +47,10 @@ unix/tcl.pc unix/tclIndex unix/pkgs/* win/Debug* win/Release* +win/*.manifest win/pkgs/* win/coffbase.txt win/tcl.hpj win/nmhlp-out.txt ADDED .gitattributes Index: .gitattributes ================================================================== --- /dev/null +++ .gitattributes @@ -0,0 +1,39 @@ +# Set the default behavior, in case people don't have core.autocrlf set. +* eol=lf +* text=auto + +# Explicitly declare text files you want to always be normalized and converted +# to native line endings on checkout. +*.3 text +*.c text +*.css text +*.enc text +*.h text +*.htm text +*.html text +*.java text +*.js text +*.json text +*.n text +*.svg text +*.ts text +*.tcl text +*.test text + +# Declare files that will always have CRLF line endings on checkout. +*.bat eol=crlf +*.sln eol=crlf +*.vc eol=crlf + +# Denote all files that are truly binary and should not be modified. +*.a binary +*.dll binary +*.exe binary +*.gif binary +*.gz binary +*.jpg binary +*.lib binary +*.pdf binary +*.png binary +*.xlsx binary +*.zip binary ADDED .gitignore Index: .gitignore ================================================================== --- /dev/null +++ .gitignore @@ -0,0 +1,54 @@ +*.a +*.dll +*.dylib +*.exe +*.exp +*.lib +*.o +*.obj +*.pdb +*.res +*.sl +*.so +*/Makefile +*/config.cache +*/config.log +*/config.status +*/tclConfig.sh +*/tclsh* +*/tcltest* +*/versions.vc +*/version.vc +*/libtcl.vfs +*/libtcl_*.zip +html +libtommath/bn.ilg +libtommath/bn.ind +libtommath/pretty.build +libtommath/tommath.src +libtommath/*.log +libtommath/*.pdf +libtommath/*.pl +libtommath/*.sh +libtommath/doc/* +libtommath/tombc/* +libtommath/pre_gen/* +libtommath/pics/* +libtommath/mtest/* +libtommath/logs/* +libtommath/etc/* +libtommath/demo/* +libtommath/*.out +libtommath/*.tex +unix/autoMkindex.tcl +unix/dltest.marker +unix/tcl.pc +unix/tclIndex +unix/pkgs/* +win/Debug* +win/Release* +win/*.manifest +win/pkgs/* +win/coffbase.txt +win/tcl.hpj +win/nmhlp-out.txt Index: .project ================================================================== --- .project +++ .project @@ -1,8 +1,8 @@ - tcl9 + tcl8 Index: .travis.yml ================================================================== --- .travis.yml +++ .travis.yml @@ -1,297 +1,459 @@ sudo: false language: c - +addons: + apt: + 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 + homebrew: + packages: + - libtommath + update: true matrix: include: - - os: linux - dist: xenial - compiler: clang - env: - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: clang - env: - - CFGOPT=--disable-shared - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: gcc - env: - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: gcc - env: - - CFGOPT=--disable-shared - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: gcc-4.9 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-4.9 - env: - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: gcc-5 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-5 - env: - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: gcc-6 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-6 - env: - - BUILD_DIR=unix - - os: linux - dist: xenial - compiler: gcc-7 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-7 - env: - - BUILD_DIR=unix - - os: linux - dist: xenial +# Testing on Linux with various compilers + - name: "Linux/GCC/Shared" + os: linux + dist: bionic + compiler: gcc + env: + - BUILD_DIR=unix + - name: "Linux/GCC/Shared: UTF_MAX=4" + os: linux + dist: bionic + compiler: gcc + env: + - BUILD_DIR=unix + - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 + - name: "Linux/GCC/Shared: NO_DEPRECATED" + os: linux + dist: bionic + compiler: gcc + env: + - BUILD_DIR=unix + - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" + - name: "Linux/GCC/Static" + os: linux + dist: bionic + compiler: gcc + env: + - CFGOPT="--disable-shared" + - BUILD_DIR=unix + - name: "Linux/GCC/Debug" + os: linux + dist: bionic + compiler: gcc + env: + - BUILD_DIR=unix + - CFGOPT="--enable-symbols" + - name: "Linux/GCC/Mem-Debug" + os: linux + dist: bionic + compiler: gcc + env: + - BUILD_DIR=unix + - CFGOPT="--enable-symbols=mem" +# C++ build. + - name: "Linux/G++/Shared" + os: linux + dist: bionic + compiler: g++ + env: + - BUILD_DIR=unix + - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register" +# Older versions of GCC... + - name: "Linux/GCC 7/Shared" + os: linux + dist: bionic compiler: gcc-7 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - - os: linux - dist: xenial - compiler: gcc-7 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-7 - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3 - - os: linux - dist: xenial - compiler: gcc-7 - addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - g++-7 - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1 - - os: osx - osx_image: xcode8 - env: - - BUILD_DIR=unix - - os: osx - osx_image: xcode8 - env: - - BUILD_DIR=macosx - - NO_DIRECT_CONFIGURE=1 - - os: osx - osx_image: xcode9 - env: - - BUILD_DIR=macosx - - NO_DIRECT_CONFIGURE=1 - - os: osx - osx_image: xcode10.2 - env: - - BUILD_DIR=macosx - - NO_DIRECT_CONFIGURE=1 -### C builds not currently supported on Windows instances -# - os: windows -# env: -# - BUILD_DIR=win -### ... so proxy with a Mingw cross-compile -# Test with mingw-w64 (32 bit) - - os: linux - dist: xenial - compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine - env: - - BUILD_DIR=win - - CFGOPT=--host=i686-w64-mingw32 - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 --disable-shared" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: i686-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-i686 - - gcc-mingw-w64-i686 - - gcc-mingw-w64 - - gcc-multilib - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1" - - NO_DIRECT_TEST=1 -# Test with mingw-w64 (64 bit) - - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3" - - NO_DIRECT_TEST=1 - - os: linux - dist: xenial - compiler: x86_64-w64-mingw32-gcc - addons: - apt: - packages: - - gcc-mingw-w64-base - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64-x86-64 - - gcc-mingw-w64 - - wine - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" - - NO_DIRECT_TEST=1 -before_install: - - export ERROR_ON_FAILURES=1 - - cd ${BUILD_DIR} -install: - - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT} -script: - - make - # The styles=develop avoids some weird problems on OSX - - test -n "$NO_DIRECT_TEST" || make test styles=develop + - name: "Linux/GCC 6/Shared" + os: linux + dist: bionic + compiler: gcc-6 + addons: + apt: + sources: + - ubuntu-toolchain-r-test + packages: + - g++-6 + env: + - BUILD_DIR=unix + - name: "Linux/GCC 5/Shared" + os: linux + dist: bionic + compiler: gcc-5 + addons: + apt: + sources: + - ubuntu-toolchain-r-test + packages: + - g++-5 + env: + - BUILD_DIR=unix +# Clang + - name: "Linux/Clang/Shared" + os: linux + dist: bionic + compiler: clang + env: + - BUILD_DIR=unix + - name: "Linux/Clang/Shared:NO_DEPRECATED" + os: linux + dist: xenial + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" + - name: "Linux/Clang/Static" + os: linux + dist: bionic + compiler: clang + env: + - CFGOPT="--disable-shared" + - BUILD_DIR=unix + - name: "Linux/Clang/Debug" + os: linux + dist: bionic + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT="--enable-symbols" + - name: "Linux/Clang/Mem-Debug" + os: linux + dist: bionic + compiler: clang + env: + - BUILD_DIR=unix + - CFGOPT="--enable-symbols=mem" +# Testing on Mac, various styles + - name: "macOS/Clang/Xcode 11.5/Shared" + os: osx + osx_image: xcode11.5 + 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 11.5/Shared/Unix-like" + os: osx + osx_image: xcode11.5 + env: + - BUILD_DIR=unix + - name: "macOS/Clang++/Xcode 11.5/Shared" + os: osx + osx_image: xcode11.5 + env: + - BUILD_DIR=unix + - CFGOPT="CC=clang++ --enable-framework CFLAGS=-Dregister=dont+use+register CPPFLAGS=-D__private_extern__=extern" + script: + - make all tcltest +# Older MacOS versions + - name: "macOS/Clang/Xcode 11/Shared" + os: osx + osx_image: xcode11 + 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 + addons: + homebrew: + packages: + - libtommath + - name: "macOS/Clang/Xcode 9/Shared" + os: osx + osx_image: xcode9.2 + env: + - BUILD_DIR=macosx + install: [] + script: *mactest + addons: + homebrew: + packages: + - libtommath + - name: "macOS/Clang/Xcode 8/Shared" + os: osx + osx_image: xcode8.3 + env: + - BUILD_DIR=macosx + install: [] + script: *mactest + addons: + homebrew: + packages: + - libtommath +# 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: bionic + 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: bionic + 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 + - 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: UTF_MAX=4" + os: windows + compiler: cl + env: *vcenv + before_install: *vcpreinst + install: [] + script: + - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-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 'OPTS=nodep' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=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,msvcrt' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-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: UTF_MAX=4" + os: windows + compiler: cl + env: *vcenv + before_install: *vcpreinst + install: [] + script: + - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-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 'OPTS=nodep' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=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,msvcrt' '-f' makefile.vc all tcltest + - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-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 + - choco install -y make zip + - cd ${BUILD_DIR} + - name: "Windows/GCC/Shared: UTF_MAX=4" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4" + before_install: *makepreinst + - 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/G++/Shared" + os: windows + compiler: g++ + env: + - BUILD_DIR=win + - CFGOPT="CC=g++ --enable-64bit" + before_install: *makepreinst + script: + - make all tcltest + - 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: UTF_MAX=4" + os: windows + compiler: gcc + env: + - BUILD_DIR=win + - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4" + 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/G++-x86/Shared" + os: windows + compiler: g++ + env: + - BUILD_DIR=win + - CFGOPT="CC=g++" + before_install: *makepreinst + script: + - make all tcltest + - 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 +before_install: + - 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 + - make test + - make install Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1845,11 +1845,11 @@ 2012-01-22 Jan Nijtmans * tools/uniClass.tcl: [FRQ 3473670]: Various Unicode-related * tools/uniParse.tcl: speedups/robustness. Enhanced tools to be - * generic/tclUniData.c: able to handle characters > 0xffff. Done in + * generic/tclUniData.c: able to handle characters > 0xFFFF. Done in * generic/tclUtf.c: all branches in order to simplify merges for * generic/regc_locale.c: new Unicode versions (such as 6.1) 2012-01-22 Donal K. Fellows Index: ChangeLog.2000 ================================================================== --- ChangeLog.2000 +++ ChangeLog.2000 @@ -1777,11 +1777,11 @@ -all]. * generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all] [Bug: 4981]. - * tests/*.test: Changed all occurances of "namespace import + * tests/*.test: Changed all occurrences of "namespace import ::tcltest" to "namespace import -force ::tcltest" [Bug: 3948]. 2000-04-09 Brent Welch * lib/httpd2.1/http.tcl: Worked on the "server closes before reading Index: ChangeLog.2005 ================================================================== --- ChangeLog.2005 +++ ChangeLog.2005 @@ -2911,11 +2911,11 @@ * generic/tclExecute.c: Updated callers to call new routine. * generic/tclBasic.c: Updated callers to call new routine. * generic/tclCompCmds.c: Updated callers to call new routine. * generic/tclDictObj.c: Updated callers to call new routine. * tests/obj.test: Corrected bad tests that actually expected - values like "47" and "0xac" to be accepted as booleans. + values like "47" and "0xAC" to be accepted as booleans. * generic/tclLiteral.c: Disabled the code that forces some literals into the "int" Tcl_ObjType during registration. We can re-enable it if this change causes trouble, but it seems more sensible to let Tcl's "on-demand" shimmering rule, and not try to pre-guess things. Index: README.md ================================================================== --- README.md +++ README.md @@ -1,13 +1,13 @@ # README: Tcl -This is the **Tcl 9.0a0** source distribution. +This is the **Tcl 8.7a4** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). -[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=master)](https://travis-ci.org/tcltk/tcl) +[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-branch)](https://travis-ci.org/tcltk/tcl) ## Contents 1. [Introduction](#intro) 2. [Documentation](#doc) 3. [Compiling and installing Tcl](#build) @@ -41,22 +41,22 @@ `license.terms` for complete information. ## 2. Documentation Extensive documentation is available at our website. The home page for this release, including new features, is -[here](https://www.tcl.tk/software/tcltk/9.0.html). +[here](https://www.tcl.tk/software/tcltk/8.7.html). Detailed release notes can be found at the [file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) by clicking on the relevant version. Information about Tcl itself can be found at the [Developer Xchange](https://www.tcl-lang.org/about/). There have been many Tcl books on the market. Many are mentioned in [the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206). -The complete set of reference manual entries for Tcl 9.0 is [online, -here](https://www.tcl-lang.org/man/tcl9.0/). +The complete set of reference manual entries for Tcl 8.7 is [online, +here](https://www.tcl-lang.org/man/tcl8.7/). ### 2a. Unix Documentation The `doc` subdirectory in this release contains a complete set of reference manual entries for Tcl. Files with extension "`.1`" are for programs (for example, `tclsh.1`); files with extension "`.3`" are for C Index: changes ================================================================== --- changes +++ changes @@ -2305,11 +2305,11 @@ 9/6/96 (bug fix) If standard channel is NULL, because Tcl cannot connect to the standard channel, do not increment the refcount. The channel can be NULL if there is for example no standard input. (JL) 9/6/96 (portability improvement) Changed parsing of backslash sequences -like \n to translate directly to absolute values like 0xa instead of +like \n to translate directly to absolute values like 0xA instead of letting the compiler do the translation. This guarantees that the translation is done the same everywhere. (JO) 9/9/96 (bug fix) If channel is opened and not associated with any interpreter, but Tcl decides to use it as one of the standard channels, it @@ -8301,11 +8301,11 @@ 2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter) Many optmizations, improvements, and tightened stack management in bytecode. ---- Released 8.6.1, September 20, 2013 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.1, September 20, 2013 --- https://core.tcl-lang.org/tcl/ for details 2013-09-27 (enhancement) improved ::env synchronization (fellows) 2013-10-20 (bug fix)[2835313] segfault from [apply {{} {while 1 {a {*}[return -level 0 -code continue]}}}] (fellows) @@ -8449,11 +8449,11 @@ 2014-08-17 (bug fix)[7d52e11] [info class subclasses oo::object] should include ::oo::class (fellows) 2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux) ---- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.2, August 27, 2014 --- https://core.tcl-lang.org/tcl/ for details 2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows) => TclOO 1.0.3 *** POTENTIAL INCOMPATIBILITY *** @@ -8489,11 +8489,11 @@ 2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter) 2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter) ---- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.3, November 12, 2014 --- https://core.tcl-lang.org/tcl/ for details 2014-11-21 (bug)[743338] Win: socket error encoding (ladayaroslav,nijtmans) 2014-12-01 (bug) restore tbcload/tclcompiler support (kupries) @@ -8525,11 +8525,11 @@ 2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect) 2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer) *** POTENTIAL INCOMPATIBILITY *** ---- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.4, March 12, 2015 --- https://core.tcl-lang.org/tcl/ for details 2015-03-19 (bug)[e66e44] Win: Ctrl-C/Ctrl-Break in console not EOF (nadkarni) 2015-03-21 (bug)[d87cb1] Proper tailcall from compiled ensembles (sofer) @@ -8621,11 +8621,11 @@ 2016-02-04 (bug)[3d96b7][593baa][cf74de] crashes in OO teardown (porter,fellows) 2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans) ---- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.5, February 29, 2016 --- https://core.tcl-lang.org/tcl/ for details 2016-03-01 (bug)[803042] mem leak due to reference cycle (porter) 2016-03-08 (bug)[bbc304] reflected watch race condition (porter) @@ -8695,11 +8695,11 @@ 2016-07-10 (bug)[da340d] integer division in clock math (nadkarni) 2016-07-20 tzdata updated to Olson's tzdata2016f (venkat) ---- Released 8.6.6, July 27, 2016 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.6, July 27, 2016 --- https://core.tcl-lang.org/tcl/ for details 2016-09-07 (bug)[c09edf] Bad caching with custom resolver (neumann,nijtmans) 2016-09-07 (bug)[4dbdd9] Memleak in test var-8.3 (mr_calvin,porter) @@ -8792,11 +8792,60 @@ 2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter) 2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans) ---- Released 8.6.7, August 9, 2017 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.7, August 9, 2017 --- https://core.tcl-lang.org/tcl/ for details + +Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7, +plus the following, which focuses on the high-level feature changes +in this changeset (new minor version) rather than bug fixes: + +2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter) + *** POTENTIAL INCOMPATIBILITY *** + +2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter) + +2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans) + +2016-07-19 (bug)[0363f0] Partial array search ID reform (porter) + +2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter) + *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") *** + +2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max) + +2016-11-25 [array names -regexp] supports backrefs (goth) + +2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy) + +2017-01-04 (TIP 459) New subcommand [package files] (nijtmans) + +2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans) + +2017-01-30 Add to Win shell builtins: assoc ftype move (ashok) + +2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans) + +2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans) + +2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz) + +2017-05-31 Purge build support for SunOS-4.* (stu) + +2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows) + +2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows) +=> TclOO 1.2.0 + +2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) + +2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) + +2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) + +--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details 2017-08-10 [array names -regexp] supports backrefs (goth) 2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows) @@ -8827,11 +8876,11 @@ 2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni) 2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter) ---- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.8, December 22, 2017 --- https://core.tcl-lang.org/tcl/ for details 2018-02-11 (enhance) stop blocking conversion of object to/from class (coulter) 2018-02-12 (enhance) NR-enable [package require] (coulter) @@ -8893,60 +8942,181 @@ 2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres) - Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ - -Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7, +2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres) + +2018-12-30 (bug)[3cf3a9] variable 'timezone' deprecated in vc2017 (nijtmans) + +2019-01-09 (bug)[cc1e91] [list [list {*}[set a " "]]] regression (sebres) + +2019-02-01 (bug)[e3f481] tests var-1.2[01] (sebres) + +2019-03-01 (new) Update to Unicode 12.0 (nijtmans) + +2019-03-05 (new)[TIP 527] New command [timerate] (sebres) + +2019-03-08 (bug)[39fed4] [package require] memory validity (hume,porter) + +2019-04-23 (new) New command tcl::unsupported::corotype (fellows) + +2019-05-04 (bug) memlink when namespace deletion kills linked var (porter) + +2019-05-28 (new) README file converted to README.md in Markdown (nijtmans) + +2019-06-17 (bug)[8b9854] [info level 0] regression with ensembles (porter) + +2019-06-20 (bug)[6bdadf] crash multi-arg write-traced [lappend] (fellows,porter) + +2019-06-21 (bug)[f8a33c] crash Tcl_Exit before init (brooks,sebres) + +2019-08-27 (bug)[fa6bf3] Bytecode fails epoch recovery at numLevel=0 (sebres) + +2019-08-29 (bug)[fec0c1] C stack overflow compiling bytecode (ade,sebres) + +2019-09-12 tzdata updated to Olson's tzdata2019c (jima) + +2019-09-20 (new) registry/dde no longer need -DUNICODE (nijtmans) +=> registry 1.3.4 +=> dde 1.4.2 + +2019-10-02 (bug)[16768d] Fix [info hostname] on NetBSD (rytaro) + +2019-10-23 (new) libtommath updated to release 1.2.0 (nijtmans) + +2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer) + +2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter) + +2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres) + +- Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ - + +Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10, plus the following, which focuses on the high-level feature changes in this changeset (new minor version) rather than bug fixes: -2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter) - -2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans) - -2016-07-19 (bug)[0363f0] Partial array search ID reform (porter) - -2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter) - *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") *** - -2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max) - -2016-11-25 [array names -regexp] supports backrefs (goth) - -2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy) - -2017-01-04 (TIP 459) New subcommand [package files] (nijtmans) - -2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans) - -2017-01-30 Add to Win shell builtins: assoc ftype move (ashok) - -2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans) - -2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans) - -2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz) - -2017-05-31 Purge build support for SunOS-4.* (stu) - -2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows) - -2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows) -=> TclOO 1.2.0 - -2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) - -2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) - -2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) - ---- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details - -2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann) - -2018-03-12 (TIP 499) custom locale preference list (oehlmann) +2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter) + +2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter) + +2017-11-04 (bug)[0d902e] [string first] on ASCII stored as Unicode (fellows) + +2017-11-17 [TIP 422] Mark all Tcl_*VA() routines deprecated. (nijtmans) + +2017-11-20 (support) Ended use of the obsolete values.h header (culler) + +2017-11-30 (bug)[8e1e31] [lsort] ordering of U+0000 (nijtmans) + +2017-12-07 [TIP 487] Terminate support for pre-XP Windows (nijtmans) + +2017-12-08 [TIP 477] Reform of nmake build (nadkarni) + +2017-12-20 (bug)[ba1419] Crash: complex ensemble delete, namespace-7.8 (coulter) + +2018-01-17 [TIP 485] Removal of many deprecated features (nijtmans) + +2018-01-27 (bug) Crash in [join $l $l], join-4.1 (porter) + +2018-02-06 [TIP 493] Cease Distribution of http 1.0 (porter) + +2018-02-06 [TIP 484] internal rep for native ints are all 64-bit (nijtmans) + +2018-02-14 [TIP 476] Scan/Printf consistency (nijtmans) + +2018-03-05 [TIP 351] [lsearch] striding + +2018-03-05 [TIPs 330,336] tighten access to Interp fields (porter) + +2018-03-12 [TIP 462] [::tcl::process] + +2018-03-12 [TIP 490] add oo support for msgcat => msgcat 1.7.0 (oehlmann) + +2018-03-12 [TIP 499] custom locale preference list (oehlmann) => msgcat 1.7.0 -- Released 8.7a3, Nov 30, 2018 --- http://core.tcl-lang.org/tcl/ for details - +2018-03-20 [TIP 503] End CONST84 support for Tcl 8.3 (porter) + +2018-03-30 Refactored [lrange] (spjuth) + +2018-04-20 [TIP 389] Unicode beyond BMP (nijtmans) + +2018-04-20 [TIP 421] [array for] + +2018-05-11 [TIP 425] Windows panic callback use of UTF-8 + +2018-05-17 [TIP 491] Phase out --disable-threads support + +2018-06-03 [TIP 500] TclOO Private Methods and Variables + +2018-07-26 (bug)[ba921a] [string cat] of bytearrays (coulter,porter) + +2018-09-02 [TIP 478] Many new features in TclOO (lester,fellows) + +2018-09-04 (bug)[540bed] [binary format w] from bignum (nijtmans) + +2018-09-12 [TIP 430] zipfs and embedded script library (woods) + +2018-09-26 [TIP 508] [array default] (bonnet,fellows) + +2018-09-27 [TIP 515] level value reform (nijtmans) + +2018-09-27 [TIP 516] More OO slot operations (fellows) + +2018-09-27 [TIP 426] [info cmdtype] (fellows) + +2018-09-28 [TIP 509] Cross platform reentrant mutex + +2018-10-08 [TIP 514] native integers are 64-bit + +2018-10-12 [TIP 502] index value reform (porter) + +2018-11-06 [TIP 406] http cookies (fellows) + +2018-11-06 [TIP 445] Tcl_ObjType utilities (migrate to Tcl 9) (porter) + +2018-11-06 [TIP 501] [string is dict] + +2018-11-06 [TIP 519] inline export/unexport option for [oo::define] + +2018-11-06 [TIP 523] [lpop] + +2018-11-06 [TIP 524] TclOO custom dialects + +2018-11-06 [TIP 506] Tcl_(Incr|Decr)RefCount macros -> functions (porter) + +2018-11-15 [TIP 512] No stub for Tcl_SetExitProc() + +2019-04-08 (bug)[45b9fa] crash in [try] (coulter) + +2019-04-14 [TIP 160] terminal and serial channel controls + +2019-04-14 [TIP 312] more types for Tcl_LinkVar + +2019-04-14 [TIP 367] [lremove] + +2019-04-14 [TIP 504] [string insert] + +2019-04-16 [TIP 342] [dict getwithdefault] + +2019-05-25 [TIP 431] [file tempdir] + +2019-05-25 [TIP 383] [coroinject], [coroprobe] + +2019-05-31 [TIP 544] Tcl_GetIntForIndex() + +2019-06-12 Replace TclOffset() with offsetof() + +2019-06-15 [TIP 461] string compare operators for [expr] + +2019-06-16 [TIP 521] floating point classification functions for [expr] + +2019-06-20 (bug)[6bdadf] crash multi-arg traced [lappend] (fellows) + +2019-06-28 [TIP 547] New encodings utf-16, ucs-2 + +2019-09-14 [TIP 414] Tcl_InitSubsystems() + +2019-09-14 [TIP 548] wchar_t conversion functions + +- Released 8.7a3, Nov 21, 2019 --- http://core.tcl-lang.org/tcl/ for details - Index: compat/fake-rfc2553.c ================================================================== --- compat/fake-rfc2553.c +++ compat/fake-rfc2553.c @@ -71,10 +71,11 @@ size_t hostlen, char *serv, size_t servlen, int flags) { struct sockaddr_in *sin = (struct sockaddr_in *)sa; struct hostent *hp; char tmpserv[16]; + (void)salen; if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET) return (EAI_FAMILY); if (serv != NULL) { snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port)); @@ -151,11 +152,11 @@ static struct addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) { struct addrinfo *ai; - ai = malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); + ai = (struct addrinfo *)malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); if (ai == NULL) return (NULL); memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in)); @@ -215,11 +216,11 @@ return (EAI_MEMORY); return (0); } if (!hostname) { - *res = malloc_ai(port, htonl(0x7f000001), hints); + *res = malloc_ai(port, htonl(0x7F000001), hints); if (*res == NULL) return (EAI_MEMORY); return (0); } Index: compat/gettod.c ================================================================== --- compat/gettod.c +++ compat/gettod.c @@ -19,12 +19,13 @@ gettimeofday( struct timeval *tp, struct timezone *tz) { struct timeb t; + (void)tz; ftime(&t); tp->tv_sec = t.time; - tp->tv_usec = t. millitm * 1000; + tp->tv_usec = t.millitm * 1000; return 0; } Index: compat/mkstemp.c ================================================================== --- compat/mkstemp.c +++ compat/mkstemp.c @@ -11,10 +11,11 @@ #include #include #include #include +#include /* *---------------------------------------------------------------------- * * mkstemp -- @@ -30,23 +31,23 @@ *---------------------------------------------------------------------- */ int mkstemp( - char *template) /* Template for filename. */ + char *tmpl) /* Template for filename. */ { static const char alphanumerics[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; - register char *a, *b; + char *a, *b; int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */ - a = template + strlen(template); - while (a > template && *(a-1) == 'X') { + a = tmpl + strlen(tmpl); + while (a > tmpl && *(a-1) == 'X') { a--; } - if (a == template) { + if (a == tmpl) { errno = ENOENT; return -1; } /* @@ -69,10 +70,10 @@ /* * Template is now realized; try to open (with correct options). */ - fd = open(template, O_RDWR|O_CREAT|O_EXCL, 0600); + fd = open(tmpl, O_RDWR|O_CREAT|O_EXCL, 0600); } while (fd == -1 && errno == EEXIST && --count > 0); return fd; } Index: compat/opendir.c ================================================================== --- compat/opendir.c +++ compat/opendir.c @@ -18,19 +18,19 @@ DIR * opendir( char *name) { - register DIR *dirp; - register int fd; - char *myname; + DIR *dirp; + int fd; + const char *myname; myname = ((*name == '\0') ? "." : name); if ((fd = open(myname, 0, 0)) == -1) { return NULL; } - dirp = (DIR *) Tcl_Alloc(sizeof(DIR)); + dirp = (DIR *) ckalloc(sizeof(DIR)); if (dirp == NULL) { /* unreachable? */ close(fd); return NULL; } @@ -63,13 +63,13 @@ * get next entry in a directory. */ struct dirent * readdir( - register DIR *dirp) + DIR *dirp) { - register struct olddirect *dp; + struct olddirect *dp; static struct dirent dir; for (;;) { if (dirp->dd_loc == 0) { dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ); @@ -99,12 +99,12 @@ * close a directory. */ void closedir( - register DIR *dirp) + DIR *dirp) { close(dirp->dd_fd); dirp->dd_fd = -1; dirp->dd_loc = 0; - Tcl_Free(dirp); + ckfree(dirp); } ADDED compat/stdint.h Index: compat/stdint.h ================================================================== --- /dev/null +++ compat/stdint.h @@ -0,0 +1,919 @@ +/* A portable stdint.h + **************************************************************************** + * BSD License: + **************************************************************************** + * + * Copyright (c) 2005-2016 Paul Hsieh + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + **************************************************************************** + * + * Version 0.1.16.0 + * + * The ANSI C standard committee, for the C99 standard, specified the + * inclusion of a new standard include file called stdint.h. This is + * a very useful and long desired include file which contains several + * very precise definitions for integer scalar types that is critically + * important for making several classes of applications portable + * including cryptography, hashing, variable length integer libraries + * and so on. But for most developers its likely useful just for + * programming sanity. + * + * The problem is that some compiler vendors chose to ignore the C99 + * standard and some older compilers have no opportunity to be updated. + * Because of this situation, simply including stdint.h in your code + * makes it unportable. + * + * So that's what this file is all about. It's an attempt to build a + * single universal include file that works on as many platforms as + * possible to deliver what stdint.h is supposed to. Even compilers + * that already come with stdint.h can use this file instead without + * any loss of functionality. A few things that should be noted about + * this file: + * + * 1) It is not guaranteed to be portable and/or present an identical + * interface on all platforms. The extreme variability of the + * ANSI C standard makes this an impossibility right from the + * very get go. Its really only meant to be useful for the vast + * majority of platforms that possess the capability of + * implementing usefully and precisely defined, standard sized + * integer scalars. Systems which are not intrinsically 2s + * complement may produce invalid constants. + * + * 2) There is an unavoidable use of non-reserved symbols. + * + * 3) Other standard include files are invoked. + * + * 4) This file may come in conflict with future platforms that do + * include stdint.h. The hope is that one or the other can be + * used with no real difference. + * + * 5) In the current version, if your platform can't represent + * int32_t, int16_t and int8_t, it just dumps out with a compiler + * error. + * + * 6) 64 bit integers may or may not be defined. Test for their + * presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX. + * Note that this is different from the C99 specification which + * requires the existence of 64 bit support in the compiler. If + * this is not defined for your platform, yet it is capable of + * dealing with 64 bits then it is because this file has not yet + * been extended to cover all of your system's capabilities. + * + * 7) (u)intptr_t may or may not be defined. Test for its presence + * with the test: #ifdef PTRDIFF_MAX. If this is not defined + * for your platform, then it is because this file has not yet + * been extended to cover all of your system's capabilities, not + * because its optional. + * + * 8) The following might not been defined even if your platform is + * capable of defining it: + * + * WCHAR_MIN + * WCHAR_MAX + * (u)int64_t + * PTRDIFF_MIN + * PTRDIFF_MAX + * (u)intptr_t + * + * 9) The following have not been defined: + * + * WINT_MIN + * WINT_MAX + * + * 10) The criteria for defining (u)int_least(*)_t isn't clear, + * except for systems which don't have a type that precisely + * defined 8, 16, or 32 bit types (which this include file does + * not support anyways). Default definitions have been given. + * + * 11) The criteria for defining (u)int_fast(*)_t isn't something I + * would trust to any particular compiler vendor or the ANSI C + * committee. It is well known that "compatible systems" are + * commonly created that have very different performance + * characteristics from the systems they are compatible with, + * especially those whose vendors make both the compiler and the + * system. Default definitions have been given, but its strongly + * recommended that users never use these definitions for any + * reason (they do *NOT* deliver any serious guarantee of + * improved performance -- not in this file, nor any vendor's + * stdint.h). + * + * 12) The following macros: + * + * PRINTF_INTMAX_MODIFIER + * PRINTF_INT64_MODIFIER + * PRINTF_INT32_MODIFIER + * PRINTF_INT16_MODIFIER + * PRINTF_LEAST64_MODIFIER + * PRINTF_LEAST32_MODIFIER + * PRINTF_LEAST16_MODIFIER + * PRINTF_INTPTR_MODIFIER + * + * are strings which have been defined as the modifiers required + * for the "d", "u" and "x" printf formats to correctly output + * (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t, + * (u)least32_t, (u)least16_t and (u)intptr_t types respectively. + * PRINTF_INTPTR_MODIFIER is not defined for some systems which + * provide their own stdint.h. PRINTF_INT64_MODIFIER is not + * defined if INT64_MAX is not defined. These are an extension + * beyond what C99 specifies must be in stdint.h. + * + * In addition, the following macros are defined: + * + * PRINTF_INTMAX_HEX_WIDTH + * PRINTF_INT64_HEX_WIDTH + * PRINTF_INT32_HEX_WIDTH + * PRINTF_INT16_HEX_WIDTH + * PRINTF_INT8_HEX_WIDTH + * PRINTF_INTMAX_DEC_WIDTH + * PRINTF_INT64_DEC_WIDTH + * PRINTF_INT32_DEC_WIDTH + * PRINTF_INT16_DEC_WIDTH + * PRINTF_UINT8_DEC_WIDTH + * PRINTF_UINTMAX_DEC_WIDTH + * PRINTF_UINT64_DEC_WIDTH + * PRINTF_UINT32_DEC_WIDTH + * PRINTF_UINT16_DEC_WIDTH + * PRINTF_UINT8_DEC_WIDTH + * + * Which specifies the maximum number of characters required to + * print the number of that type in either hexadecimal or decimal. + * These are an extension beyond what C99 specifies must be in + * stdint.h. + * + * Compilers tested (all with 0 warnings at their highest respective + * settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32 + * bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio + * .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3 + * + * This file should be considered a work in progress. Suggestions for + * improvements, especially those which increase coverage are strongly + * encouraged. + * + * Acknowledgements + * + * The following people have made significant contributions to the + * development and testing of this file: + * + * Chris Howie + * John Steele Scott + * Dave Thorup + * John Dill + * Florian Wobbe + * Christopher Sean Morrison + * Mikkel Fahnoe Jorgensen + * + */ + +#include +#include +#include + +/* + * For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and + * do nothing else. On the Mac OS X version of gcc this is _STDINT_H_. + */ + +#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED) +#include +#define _PSTDINT_H_INCLUDED +# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__)) +# ifndef PRINTF_INT64_MODIFIER +# define PRINTF_INT64_MODIFIER "l" +# endif +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "" +# endif +# else +# ifndef PRINTF_INT64_MODIFIER +# define PRINTF_INT64_MODIFIER "ll" +# endif +# ifndef PRINTF_INT32_MODIFIER +# if (UINT_MAX == UINT32_MAX) +# define PRINTF_INT32_MODIFIER "" +# else +# define PRINTF_INT32_MODIFIER "l" +# endif +# endif +# endif +# ifndef PRINTF_INT16_MODIFIER +# define PRINTF_INT16_MODIFIER "h" +# endif +# ifndef PRINTF_INTMAX_MODIFIER +# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER +# endif +# ifndef PRINTF_INT64_HEX_WIDTH +# define PRINTF_INT64_HEX_WIDTH "16" +# endif +# ifndef PRINTF_UINT64_HEX_WIDTH +# define PRINTF_UINT64_HEX_WIDTH "16" +# endif +# ifndef PRINTF_INT32_HEX_WIDTH +# define PRINTF_INT32_HEX_WIDTH "8" +# endif +# ifndef PRINTF_UINT32_HEX_WIDTH +# define PRINTF_UINT32_HEX_WIDTH "8" +# endif +# ifndef PRINTF_INT16_HEX_WIDTH +# define PRINTF_INT16_HEX_WIDTH "4" +# endif +# ifndef PRINTF_UINT16_HEX_WIDTH +# define PRINTF_UINT16_HEX_WIDTH "4" +# endif +# ifndef PRINTF_INT8_HEX_WIDTH +# define PRINTF_INT8_HEX_WIDTH "2" +# endif +# ifndef PRINTF_UINT8_HEX_WIDTH +# define PRINTF_UINT8_HEX_WIDTH "2" +# endif +# ifndef PRINTF_INT64_DEC_WIDTH +# define PRINTF_INT64_DEC_WIDTH "19" +# endif +# ifndef PRINTF_UINT64_DEC_WIDTH +# define PRINTF_UINT64_DEC_WIDTH "20" +# endif +# ifndef PRINTF_INT32_DEC_WIDTH +# define PRINTF_INT32_DEC_WIDTH "10" +# endif +# ifndef PRINTF_UINT32_DEC_WIDTH +# define PRINTF_UINT32_DEC_WIDTH "10" +# endif +# ifndef PRINTF_INT16_DEC_WIDTH +# define PRINTF_INT16_DEC_WIDTH "5" +# endif +# ifndef PRINTF_UINT16_DEC_WIDTH +# define PRINTF_UINT16_DEC_WIDTH "5" +# endif +# ifndef PRINTF_INT8_DEC_WIDTH +# define PRINTF_INT8_DEC_WIDTH "3" +# endif +# ifndef PRINTF_UINT8_DEC_WIDTH +# define PRINTF_UINT8_DEC_WIDTH "3" +# endif +# ifndef PRINTF_INTMAX_HEX_WIDTH +# define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH +# endif +# ifndef PRINTF_UINTMAX_HEX_WIDTH +# define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH +# endif +# ifndef PRINTF_INTMAX_DEC_WIDTH +# define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH +# endif +# ifndef PRINTF_UINTMAX_DEC_WIDTH +# define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH +# endif + +/* + * Something really weird is going on with Open Watcom. Just pull some of + * these duplicated definitions from Open Watcom's stdint.h file for now. + */ + +# if defined (__WATCOMC__) && __WATCOMC__ >= 1250 +# if !defined (INT64_C) +# define INT64_C(x) (x + (INT64_MAX - INT64_MAX)) +# endif +# if !defined (UINT64_C) +# define UINT64_C(x) (x + (UINT64_MAX - UINT64_MAX)) +# endif +# if !defined (INT32_C) +# define INT32_C(x) (x + (INT32_MAX - INT32_MAX)) +# endif +# if !defined (UINT32_C) +# define UINT32_C(x) (x + (UINT32_MAX - UINT32_MAX)) +# endif +# if !defined (INT16_C) +# define INT16_C(x) (x) +# endif +# if !defined (UINT16_C) +# define UINT16_C(x) (x) +# endif +# if !defined (INT8_C) +# define INT8_C(x) (x) +# endif +# if !defined (UINT8_C) +# define UINT8_C(x) (x) +# endif +# if !defined (UINT64_MAX) +# define UINT64_MAX 18446744073709551615ULL +# endif +# if !defined (INT64_MAX) +# define INT64_MAX 9223372036854775807LL +# endif +# if !defined (UINT32_MAX) +# define UINT32_MAX 4294967295UL +# endif +# if !defined (INT32_MAX) +# define INT32_MAX 2147483647L +# endif +# if !defined (INTMAX_MAX) +# define INTMAX_MAX INT64_MAX +# endif +# if !defined (INTMAX_MIN) +# define INTMAX_MIN INT64_MIN +# endif +# endif +#endif + +/* + * I have no idea what is the truly correct thing to do on older Solaris. + * From some online discussions, this seems to be what is being + * recommended. For people who actually are developing on older Solaris, + * what I would like to know is, does this define all of the relevant + * macros of a complete stdint.h? Remember, in pstdint.h 64 bit is + * considered optional. + */ + +#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED) +#include +#define _PSTDINT_H_INCLUDED +#endif + +#ifndef _PSTDINT_H_INCLUDED +#define _PSTDINT_H_INCLUDED + +#ifndef SIZE_MAX +# define SIZE_MAX ((size_t)-1) +#endif + +/* + * Deduce the type assignments from limits.h under the assumption that + * integer sizes in bits are powers of 2, and follow the ANSI + * definitions. + */ + +#ifndef UINT8_MAX +# define UINT8_MAX 0xff +#endif +#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks) +# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S) + typedef unsigned char uint8_t; +# define UINT8_C(v) ((uint8_t) v) +# else +# error "Platform not supported" +# endif +#endif + +#ifndef INT8_MAX +# define INT8_MAX 0x7f +#endif +#ifndef INT8_MIN +# define INT8_MIN INT8_C(0x80) +#endif +#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks) +# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S) + typedef signed char int8_t; +# define INT8_C(v) ((int8_t) v) +# else +# error "Platform not supported" +# endif +#endif + +#ifndef UINT16_MAX +# define UINT16_MAX 0xffff +#endif +#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks) +#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S) + typedef unsigned int uint16_t; +# ifndef PRINTF_INT16_MODIFIER +# define PRINTF_INT16_MODIFIER "" +# endif +# define UINT16_C(v) ((uint16_t) (v)) +#elif (USHRT_MAX == UINT16_MAX) + typedef unsigned short uint16_t; +# define UINT16_C(v) ((uint16_t) (v)) +# ifndef PRINTF_INT16_MODIFIER +# define PRINTF_INT16_MODIFIER "h" +# endif +#else +#error "Platform not supported" +#endif +#endif + +#ifndef INT16_MAX +# define INT16_MAX 0x7fff +#endif +#ifndef INT16_MIN +# define INT16_MIN INT16_C(0x8000) +#endif +#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks) +#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S) + typedef signed int int16_t; +# define INT16_C(v) ((int16_t) (v)) +# ifndef PRINTF_INT16_MODIFIER +# define PRINTF_INT16_MODIFIER "" +# endif +#elif (SHRT_MAX == INT16_MAX) + typedef signed short int16_t; +# define INT16_C(v) ((int16_t) (v)) +# ifndef PRINTF_INT16_MODIFIER +# define PRINTF_INT16_MODIFIER "h" +# endif +#else +#error "Platform not supported" +#endif +#endif + +#ifndef UINT32_MAX +# define UINT32_MAX (0xffffffffUL) +#endif +#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks) +#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S) + typedef unsigned long uint32_t; +# define UINT32_C(v) v ## UL +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "l" +# endif +#elif (UINT_MAX == UINT32_MAX) + typedef unsigned int uint32_t; +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "" +# endif +# define UINT32_C(v) v ## U +#elif (USHRT_MAX == UINT32_MAX) + typedef unsigned short uint32_t; +# define UINT32_C(v) ((unsigned short) (v)) +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "" +# endif +#else +#error "Platform not supported" +#endif +#endif + +#ifndef INT32_MAX +# define INT32_MAX (0x7fffffffL) +#endif +#ifndef INT32_MIN +# define INT32_MIN INT32_C(0x80000000) +#endif +#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks) +#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S) + typedef signed long int32_t; +# define INT32_C(v) v ## L +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "l" +# endif +#elif (INT_MAX == INT32_MAX) + typedef signed int int32_t; +# define INT32_C(v) v +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "" +# endif +#elif (SHRT_MAX == INT32_MAX) + typedef signed short int32_t; +# define INT32_C(v) ((short) (v)) +# ifndef PRINTF_INT32_MODIFIER +# define PRINTF_INT32_MODIFIER "" +# endif +#else +#error "Platform not supported" +#endif +#endif + +/* + * The macro stdint_int64_defined is temporarily used to record + * whether or not 64 integer support is available. It must be + * defined for any 64 integer extensions for new platforms that are + * added. + */ + +#undef stdint_int64_defined +#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S) +# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S) +# define stdint_int64_defined + typedef long long int64_t; + typedef unsigned long long uint64_t; +# define UINT64_C(v) v ## ULL +# define INT64_C(v) v ## LL +# ifndef PRINTF_INT64_MODIFIER +# define PRINTF_INT64_MODIFIER "ll" +# endif +# endif +#endif + +#if !defined (stdint_int64_defined) +# if defined(__GNUC__) && !defined(vxWorks) +# define stdint_int64_defined + __extension__ typedef long long int64_t; + __extension__ typedef unsigned long long uint64_t; +# define UINT64_C(v) v ## ULL +# define INT64_C(v) v ## LL +# ifndef PRINTF_INT64_MODIFIER +# define PRINTF_INT64_MODIFIER "ll" +# endif +# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S) +# define stdint_int64_defined + typedef long long int64_t; + typedef unsigned long long uint64_t; +# define UINT64_C(v) v ## ULL +# define INT64_C(v) v ## LL +# ifndef PRINTF_INT64_MODIFIER +# define PRINTF_INT64_MODIFIER "ll" +# endif +# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC) +# define stdint_int64_defined + typedef __int64 int64_t; + typedef unsigned __int64 uint64_t; +# define UINT64_C(v) v ## UI64 +# define INT64_C(v) v ## I64 +# ifndef PRINTF_INT64_MODIFIER +# define PRINTF_INT64_MODIFIER "I64" +# endif +# endif +#endif + +#if !defined (LONG_LONG_MAX) && defined (INT64_C) +# define LONG_LONG_MAX INT64_C (9223372036854775807) +#endif +#ifndef ULONG_LONG_MAX +# define ULONG_LONG_MAX UINT64_C (18446744073709551615) +#endif + +#if !defined (INT64_MAX) && defined (INT64_C) +# define INT64_MAX INT64_C (9223372036854775807) +#endif +#if !defined (INT64_MIN) && defined (INT64_C) +# define INT64_MIN INT64_C (-9223372036854775808) +#endif +#if !defined (UINT64_MAX) && defined (INT64_C) +# define UINT64_MAX UINT64_C (18446744073709551615) +#endif + +/* + * Width of hexadecimal for number field. + */ + +#ifndef PRINTF_INT64_HEX_WIDTH +# define PRINTF_INT64_HEX_WIDTH "16" +#endif +#ifndef PRINTF_INT32_HEX_WIDTH +# define PRINTF_INT32_HEX_WIDTH "8" +#endif +#ifndef PRINTF_INT16_HEX_WIDTH +# define PRINTF_INT16_HEX_WIDTH "4" +#endif +#ifndef PRINTF_INT8_HEX_WIDTH +# define PRINTF_INT8_HEX_WIDTH "2" +#endif +#ifndef PRINTF_INT64_DEC_WIDTH +# define PRINTF_INT64_DEC_WIDTH "19" +#endif +#ifndef PRINTF_INT32_DEC_WIDTH +# define PRINTF_INT32_DEC_WIDTH "10" +#endif +#ifndef PRINTF_INT16_DEC_WIDTH +# define PRINTF_INT16_DEC_WIDTH "5" +#endif +#ifndef PRINTF_INT8_DEC_WIDTH +# define PRINTF_INT8_DEC_WIDTH "3" +#endif +#ifndef PRINTF_UINT64_DEC_WIDTH +# define PRINTF_UINT64_DEC_WIDTH "20" +#endif +#ifndef PRINTF_UINT32_DEC_WIDTH +# define PRINTF_UINT32_DEC_WIDTH "10" +#endif +#ifndef PRINTF_UINT16_DEC_WIDTH +# define PRINTF_UINT16_DEC_WIDTH "5" +#endif +#ifndef PRINTF_UINT8_DEC_WIDTH +# define PRINTF_UINT8_DEC_WIDTH "3" +#endif + +/* + * Ok, lets not worry about 128 bit integers for now. Moore's law says + * we don't need to worry about that until about 2040 at which point + * we'll have bigger things to worry about. + */ + +#ifdef stdint_int64_defined + typedef int64_t intmax_t; + typedef uint64_t uintmax_t; +# define INTMAX_MAX INT64_MAX +# define INTMAX_MIN INT64_MIN +# define UINTMAX_MAX UINT64_MAX +# define UINTMAX_C(v) UINT64_C(v) +# define INTMAX_C(v) INT64_C(v) +# ifndef PRINTF_INTMAX_MODIFIER +# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER +# endif +# ifndef PRINTF_INTMAX_HEX_WIDTH +# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH +# endif +# ifndef PRINTF_INTMAX_DEC_WIDTH +# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH +# endif +#else + typedef int32_t intmax_t; + typedef uint32_t uintmax_t; +# define INTMAX_MAX INT32_MAX +# define UINTMAX_MAX UINT32_MAX +# define UINTMAX_C(v) UINT32_C(v) +# define INTMAX_C(v) INT32_C(v) +# ifndef PRINTF_INTMAX_MODIFIER +# define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER +# endif +# ifndef PRINTF_INTMAX_HEX_WIDTH +# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH +# endif +# ifndef PRINTF_INTMAX_DEC_WIDTH +# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH +# endif +#endif + +/* + * Because this file currently only supports platforms which have + * precise powers of 2 as bit sizes for the default integers, the + * least definitions are all trivial. Its possible that a future + * version of this file could have different definitions. + */ + +#ifndef stdint_least_defined + typedef int8_t int_least8_t; + typedef uint8_t uint_least8_t; + typedef int16_t int_least16_t; + typedef uint16_t uint_least16_t; + typedef int32_t int_least32_t; + typedef uint32_t uint_least32_t; +# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER +# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER +# define UINT_LEAST8_MAX UINT8_MAX +# define INT_LEAST8_MAX INT8_MAX +# define UINT_LEAST16_MAX UINT16_MAX +# define INT_LEAST16_MAX INT16_MAX +# define UINT_LEAST32_MAX UINT32_MAX +# define INT_LEAST32_MAX INT32_MAX +# define INT_LEAST8_MIN INT8_MIN +# define INT_LEAST16_MIN INT16_MIN +# define INT_LEAST32_MIN INT32_MIN +# ifdef stdint_int64_defined + typedef int64_t int_least64_t; + typedef uint64_t uint_least64_t; +# define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER +# define UINT_LEAST64_MAX UINT64_MAX +# define INT_LEAST64_MAX INT64_MAX +# define INT_LEAST64_MIN INT64_MIN +# endif +#endif +#undef stdint_least_defined + +/* + * The ANSI C committee has defined *int*_fast*_t types as well. This, + * of course, defies rationality -- you can't know what will be fast + * just from the type itself. Even for a given architecture, compatible + * implementations might have different performance characteristics. + * Developers are warned to stay away from these types when using this + * or any other stdint.h. + */ + +typedef int_least8_t int_fast8_t; +typedef uint_least8_t uint_fast8_t; +typedef int_least16_t int_fast16_t; +typedef uint_least16_t uint_fast16_t; +typedef int_least32_t int_fast32_t; +typedef uint_least32_t uint_fast32_t; +#define UINT_FAST8_MAX UINT_LEAST8_MAX +#define INT_FAST8_MAX INT_LEAST8_MAX +#define UINT_FAST16_MAX UINT_LEAST16_MAX +#define INT_FAST16_MAX INT_LEAST16_MAX +#define UINT_FAST32_MAX UINT_LEAST32_MAX +#define INT_FAST32_MAX INT_LEAST32_MAX +#define INT_FAST8_MIN INT_LEAST8_MIN +#define INT_FAST16_MIN INT_LEAST16_MIN +#define INT_FAST32_MIN INT_LEAST32_MIN +#ifdef stdint_int64_defined + typedef int_least64_t int_fast64_t; + typedef uint_least64_t uint_fast64_t; +# define UINT_FAST64_MAX UINT_LEAST64_MAX +# define INT_FAST64_MAX INT_LEAST64_MAX +# define INT_FAST64_MIN INT_LEAST64_MIN +#endif + +#undef stdint_int64_defined + +/* + * Whatever piecemeal, per compiler thing we can do about the wchar_t + * type limits. + */ + +#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks) +# include +# ifndef WCHAR_MIN +# define WCHAR_MIN 0 +# endif +# ifndef WCHAR_MAX +# define WCHAR_MAX ((wchar_t)-1) +# endif +#endif + +/* + * Whatever piecemeal, per compiler/platform thing we can do about the + * (u)intptr_t types and limits. + */ + +#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T) +# define STDINT_H_UINTPTR_T_DEFINED +#endif + +#ifndef STDINT_H_UINTPTR_T_DEFINED +# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__) +# define stdint_intptr_bits 64 +# elif defined (__WATCOMC__) || defined (__TURBOC__) +# if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__) +# define stdint_intptr_bits 16 +# else +# define stdint_intptr_bits 32 +# endif +# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__) +# define stdint_intptr_bits 32 +# elif defined (__INTEL_COMPILER) +/* TODO -- what did Intel do about x86-64? */ +# else +/* #error "This platform might not be supported yet" */ +# endif + +# ifdef stdint_intptr_bits +# define stdint_intptr_glue3_i(a,b,c) a##b##c +# define stdint_intptr_glue3(a,b,c) stdint_intptr_glue3_i(a,b,c) +# ifndef PRINTF_INTPTR_MODIFIER +# define PRINTF_INTPTR_MODIFIER stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER) +# endif +# ifndef PTRDIFF_MAX +# define PTRDIFF_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX) +# endif +# ifndef PTRDIFF_MIN +# define PTRDIFF_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN) +# endif +# ifndef UINTPTR_MAX +# define UINTPTR_MAX stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX) +# endif +# ifndef INTPTR_MAX +# define INTPTR_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX) +# endif +# ifndef INTPTR_MIN +# define INTPTR_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN) +# endif +# ifndef INTPTR_C +# define INTPTR_C(x) stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x) +# endif +# ifndef UINTPTR_C +# define UINTPTR_C(x) stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x) +# endif + typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t; + typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t) intptr_t; +# else +/* TODO -- This following is likely wrong for some platforms, and does + nothing for the definition of uintptr_t. */ + typedef ptrdiff_t intptr_t; +# endif +# define STDINT_H_UINTPTR_T_DEFINED +#endif + +/* + * Assumes sig_atomic_t is signed and we have a 2s complement machine. + */ + +#ifndef SIG_ATOMIC_MAX +# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1) +#endif + +#endif + +#if defined (__TEST_PSTDINT_FOR_CORRECTNESS) + +/* + * Please compile with the maximum warning settings to make sure macros are + * not defined more than once. + */ + +#include +#include +#include + +#define glue3_aux(x,y,z) x ## y ## z +#define glue3(x,y,z) glue3_aux(x,y,z) + +#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0); +#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0); + +#define DECL(us,bits) glue3(DECL,us,) (bits) + +#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits) + +#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; } + +#define X_SIZE_MAX ((size_t)-1) + +int main () { + int err_n = 0; + int err_first = 0; + DECL(I,8) + DECL(U,8) + DECL(I,16) + DECL(U,16) + DECL(I,32) + DECL(U,32) +#ifdef INT64_MAX + DECL(I,64) + DECL(U,64) +#endif + intmax_t imax = INTMAX_C(0); + uintmax_t umax = UINTMAX_C(0); + char str0[256], str1[256]; + + sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647)); + if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0)); + if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH)); + sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295)); + if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0)); + if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH)); +#ifdef INT64_MAX + sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807)); + if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1)); + if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1))); + sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591)); + if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1)); + if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1))); +#endif + + sprintf (str0, "%d %x\n", 0, ~0); + + sprintf (str1, "%d %x\n", i8, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1)); + sprintf (str1, "%u %x\n", u8, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1)); + sprintf (str1, "%d %x\n", i16, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1)); + sprintf (str1, "%u %x\n", u16, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1)); + sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n", i32, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1)); + sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n", u32, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1)); +#ifdef INT64_MAX + sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n", i64, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1)); +#endif + sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n", imax, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1)); + sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n", umax, ~0); + if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1)); + + TESTUMAX(8); + TESTUMAX(16); + TESTUMAX(32); +#ifdef INT64_MAX + TESTUMAX(64); +#endif + +#define STR(v) #v +#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v)); + if (err_n) { + printf ("pstdint.h is not correct. Please use sizes below to correct it:\n"); + } + + Q(int) + Q(unsigned) + Q(long int) + Q(short int) + Q(int8_t) + Q(int16_t) + Q(int32_t) +#ifdef INT64_MAX + Q(int64_t) +#endif + +#if UINT_MAX < X_SIZE_MAX + printf ("UINT_MAX < X_SIZE_MAX\n"); +#else + printf ("UINT_MAX >= X_SIZE_MAX\n"); +#endif + printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX); + + return EXIT_SUCCESS; +} + +#endif Index: compat/stdlib.h ================================================================== --- compat/stdlib.h +++ compat/stdlib.h @@ -3,11 +3,11 @@ * * Declares facilities exported by the "stdlib" portion of the C library. * This file isn't complete in the ANSI-C sense; it only declares things * that are needed by Tcl. This file is needed even on many systems with * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare - * all the procedures needed here (such as strtod). + * all the procedures needed here (such as strtol/strtoul). * * Copyright (c) 1991 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of Index: compat/strstr.c ================================================================== --- compat/strstr.c +++ compat/strstr.c @@ -34,14 +34,14 @@ *---------------------------------------------------------------------- */ char * strstr( - register char *string, /* String to search. */ + char *string, /* String to search. */ char *substring) /* Substring to try to find in string. */ { - register char *a, *b; + char *a, *b; /* * First scan quickly through the two strings looking for a * single-character match. When it's found, then compare the rest of the * substring. Index: compat/strtol.c ================================================================== --- compat/strtol.c +++ compat/strtol.c @@ -43,19 +43,19 @@ * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { - register const char *p; + const char *p; long result; /* * Skip any leading blanks. */ p = string; - while (TclIsSpaceProc(*p)) { + while (isspace(UCHAR(*p))) { p += 1; } /* * Check for a sign. Index: compat/strtoul.c ================================================================== --- compat/strtoul.c +++ compat/strtoul.c @@ -60,23 +60,23 @@ * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { - register const char *p; - register unsigned long int result = 0; - register unsigned digit; + const char *p; + unsigned long int result = 0; + unsigned digit; int anyDigits = 0; int negative=0; int overflow=0; /* * Skip any leading blanks. */ p = string; - while (TclIsSpaceProc(*p)) { + while (isspace(UCHAR(*p))) { p += 1; } if (*p == '-') { negative = 1; p += 1; Index: compat/waitpid.c ================================================================== --- compat/waitpid.c +++ compat/waitpid.c @@ -68,11 +68,11 @@ int *statusPtr, /* Where to store wait status for the * process. */ int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { - register WaitInfo *waitPtr, *prevPtr; + WaitInfo *waitPtr, *prevPtr; pid_t result; WAIT_STATUS_TYPE status; if ((pid < -1) || (pid == 0)) { errno = EINVAL; @@ -98,11 +98,11 @@ if (prevPtr == NULL) { deadList = waitPtr->nextPtr; } else { prevPtr->nextPtr = waitPtr->nextPtr; } - Tcl_Free(waitPtr); + ckfree(waitPtr); return result; } /* * Wait for any process to stop or exit. If it's an acceptable one then @@ -154,15 +154,15 @@ if (waitPtr->pid == result) { waitPtr->status = status; goto waitAgain; } } - waitPtr = (WaitInfo *) Tcl_Alloc(sizeof(WaitInfo)); + waitPtr = (WaitInfo *) ckalloc(sizeof(WaitInfo)); waitPtr->pid = result; waitPtr->status = status; waitPtr->nextPtr = deadList; deadList = waitPtr; waitAgain: continue; } } Index: compat/zlib/contrib/minizip/crypt.h ================================================================== --- compat/zlib/contrib/minizip/crypt.h +++ compat/zlib/contrib/minizip/crypt.h @@ -41,10 +41,11 @@ static int decrypt_byte(unsigned long* pkeys, const z_crc_t* pcrc_32_tab) { unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an * unpredictable manner on 16-bit systems; not a problem * with any known compiler so far, though */ + (void)pcrc_32_tab; temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2; return (int)(((temp * (temp ^ 1)) >> 8) & 0xff); } @@ -55,11 +56,11 @@ { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { - register int keyshift = (int)((*(pkeys+1)) >> 24); + int keyshift = (int)((*(pkeys+1)) >> 24); (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); } return c; } Index: compat/zlib/contrib/minizip/ioapi.c ================================================================== --- compat/zlib/contrib/minizip/ioapi.c +++ compat/zlib/contrib/minizip/ioapi.c @@ -12,11 +12,15 @@ #if defined(_WIN32) && (!(defined(_CRT_SECURE_NO_WARNINGS))) #define _CRT_SECURE_NO_WARNINGS #endif -#if defined(__APPLE__) || defined(IOAPI_NO_64) +#if defined(_WIN32) +#define FOPEN_FUNC(filename, mode) fopen(filename, mode) +#define FTELLO_FUNC(stream) _ftelli64(stream) +#define FSEEKO_FUNC(stream, offset, origin) _fseeki64(stream, offset, origin) +#elif defined(__APPLE__) || defined(IOAPI_NO_64) // In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) ftello(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin) #else Index: compat/zlib/contrib/minizip/minizip.c ================================================================== --- compat/zlib/contrib/minizip/minizip.c +++ compat/zlib/contrib/minizip/minizip.c @@ -25,11 +25,15 @@ #ifndef _FILE_OFFSET_BIT #define _FILE_OFFSET_BIT 64 #endif #endif -#if defined(__APPLE__) || defined(IOAPI_NO_64) +#if defined(_WIN32) +#define FOPEN_FUNC(filename, mode) fopen(filename, mode) +#define FTELLO_FUNC(stream) _ftelli64(stream) +#define FSEEKO_FUNC(stream, offset, origin) _fseeki64(stream, offset, origin) +#elif defined(__APPLE__) || defined(IOAPI_NO_64) // In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions #define FOPEN_FUNC(filename, mode) fopen(filename, mode) #define FTELLO_FUNC(stream) ftello(stream) #define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin) #else @@ -68,12 +72,12 @@ #define WRITEBUFFERSIZE (16384) #define MAXFILENAME (256) #ifdef _WIN32 uLong filetime(f, tmzip, dt) - char *f; /* name of file to get info on */ - tm_zip *tmzip; /* return value: access, modific. and creation times */ + const char *f; /* name of file to get info on */ + tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { int ret = 0; { FILETIME ftLocal; @@ -92,11 +96,11 @@ return ret; } #else #if defined(unix) || defined(__APPLE__) uLong filetime(f, tmzip, dt) - char *f; /* name of file to get info on */ + const char *f; /* name of file to get info on */ tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { int ret=0; struct stat s; /* results of stat() */ @@ -134,12 +138,12 @@ return ret; } #else uLong filetime(f, tmzip, dt) - char *f; /* name of file to get info on */ - tm_zip *tmzip; /* return value: access, modific. and creation times */ + const char *f; /* name of file to get info on */ + tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { return 0; } #endif Index: doc/AddErrInfo.3 ================================================================== --- doc/AddErrInfo.3 +++ doc/AddErrInfo.3 @@ -7,11 +7,11 @@ '\" .TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options +Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options .SH SYNOPSIS .nf \fB#include \fR .sp Tcl_Obj * @@ -27,10 +27,12 @@ \fBTcl_AddObjErrorInfo\fR(\fIinterp, message, length\fR) .sp \fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR) .sp \fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR) +.sp +\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR) .sp \fBTcl_GetErrorLine\fR(\fIinterp\fR) .sp \fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR) .sp @@ -56,14 +58,14 @@ This byte array may contain embedded null bytes unless \fIlength\fR is negative. .AP Tcl_Obj *objPtr in A message to be appended to the \fB\-errorinfo\fR return option in the form of a Tcl_Obj value. -.AP size_t length in +.AP int length in The number of bytes to copy from \fImessage\fR when appending to the \fB\-errorinfo\fR return option. -If TCL_AUTO_LENGTH, all bytes up to the first null byte are used. +If negative, all bytes up to the first null byte are used. .AP Tcl_Obj *errorObjPtr in The \fB\-errorcode\fR return option will be set to this value. .AP char *element in String to record as one element of the \fB\-errorcode\fR return option. Last \fIelement\fR argument must be NULL. @@ -240,10 +242,16 @@ .PP The procedure \fBTcl_SetErrorCode\fR is also used to set the \fB\-errorcode\fR return option. However, it takes one or more strings to record instead of a value. Otherwise, it is similar to \fBTcl_SetObjErrorCode\fR in behavior. +.PP +\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that +instead of taking a variable number of arguments it takes an argument list. +Interfaces using argument lists have been found to be nonportable in practice. +This function is deprecated and will be removed in Tcl 9.0. + .PP The procedure \fBTcl_GetErrorLine\fR is used to read the integer value of the \fB\-errorline\fR return option without the overhead of a full call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR sets the \fB\-errorline\fR return option value. Index: doc/Alloc.3 ================================================================== --- doc/Alloc.3 +++ doc/Alloc.3 @@ -6,11 +6,11 @@ '\" .TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc \- allocate or free heap memory +Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory .SH SYNOPSIS .nf \fB#include \fR .sp char * @@ -17,18 +17,33 @@ \fBTcl_Alloc\fR(\fIsize\fR) .sp void \fBTcl_Free\fR(\fIptr\fR) .sp -void * +char * \fBTcl_Realloc\fR(\fIptr, size\fR) .sp -void * +char * \fBTcl_AttemptAlloc\fR(\fIsize\fR) .sp -void * +char * \fBTcl_AttemptRealloc\fR(\fIptr, size\fR) +.sp +char * +\fBckalloc\fR(\fIsize\fR) +.sp +void +\fBckfree\fR(\fIptr\fR) +.sp +char * +\fBckrealloc\fR(\fIptr, size\fR) +.sp +char * +\fBattemptckalloc\fR(\fIsize\fR) +.sp +char * +\fBattemptckrealloc\fR(\fIptr, size\fR) .SH ARGUMENTS .AS char *size .AP "unsigned int" size in Size in bytes of the memory block to allocate. .AP char *ptr in @@ -62,12 +77,16 @@ interpreter to \fBpanic\fR if the memory allocation fails. If the allocation fails, these functions will return NULL. Note that on some platforms, but not all, attempting to allocate a zero-sized block of memory will also cause these functions to return NULL. .PP -When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined, -the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR, -\fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented -as macros, redefined to be special debugging versions of these procedures. +The procedures \fBckalloc\fR, \fBckfree\fR, \fBckrealloc\fR, +\fBattemptckalloc\fR, and \fBattemptckrealloc\fR are implemented +as macros. Normally, they are synonyms for the corresponding +procedures documented on this page. When Tcl and all modules +calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however, +these macros are redefined to be special debugging versions +of these procedures. To support Tcl's memory debugging within a +module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG Index: doc/AllowExc.3 ================================================================== --- doc/AllowExc.3 +++ doc/AllowExc.3 @@ -28,11 +28,12 @@ terminates with a completion code other than \fBTCL_OK\fR, \fBTCL_ERROR\fR or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR return with an appropriate message. The particular script evaluation procedures of Tcl that act in the manner are \fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR, -\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR and \fBTcl_VarEval\fR. +\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and +\fBTcl_VarEvalVA\fR. .PP However, if \fBTcl_AllowExceptions\fR is invoked immediately before calling one of those a procedures, then arbitrary completion codes are permitted from the script, and they are returned without modification. Index: doc/AssocData.3 ================================================================== --- doc/AssocData.3 +++ doc/AssocData.3 @@ -11,11 +11,11 @@ Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters .SH SYNOPSIS .nf \fB#include \fR .sp -void * +ClientData \fBTcl_GetAssocData\fR(\fIinterp, key, delProcPtr\fR) .sp \fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR) .sp \fBTcl_DeleteAssocData\fR(\fIinterp, key\fR) @@ -29,11 +29,11 @@ .AP Tcl_InterpDeleteProc *delProc in Procedure to call when \fIinterp\fR is deleted. .AP Tcl_InterpDeleteProc **delProcPtr in Pointer to location in which to store address of current deletion procedure for association. Ignored if NULL. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value associated with the given key in this interpreter. This data is owned by the caller. .BE .SH DESCRIPTION @@ -62,11 +62,11 @@ is deleted. \fIDeleteProc\fR should have arguments and result that match the type \fBTcl_InterpDeleteProc\fR: .PP .CS typedef void \fBTcl_InterpDeleteProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP When \fIdeleteProc\fR is invoked the \fIclientData\fR and \fIinterp\fR arguments will be the same as the corresponding arguments passed to Index: doc/Async.3 ================================================================== --- doc/Async.3 +++ doc/Async.3 @@ -28,11 +28,11 @@ \fBTcl_AsyncReady\fR() .SH ARGUMENTS .AS Tcl_AsyncHandler clientData .AP Tcl_AsyncProc *proc in Procedure to invoke to handle an asynchronous event. -.AP void *clientData in +.AP ClientData clientData in One-word value to pass to \fIproc\fR. .AP Tcl_AsyncHandler async in Token for asynchronous event handler. .AP Tcl_Interp *interp in Tcl interpreter in which command was being evaluated when handler was @@ -82,11 +82,11 @@ \fIProc\fR should have arguments and result that match the type \fBTcl_AsyncProc\fR: .PP .CS typedef int \fBTcl_AsyncProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIcode\fR); .CE .PP The \fIclientData\fR will be the same as the \fIclientData\fR ADDED doc/Backslash.3 Index: doc/Backslash.3 ================================================================== --- /dev/null +++ doc/Backslash.3 @@ -0,0 +1,47 @@ +'\" +'\" Copyright (c) 1989-1993 The Regents of the University of California. +'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros +.BS +.SH NAME +Tcl_Backslash \- parse a backslash sequence +.SH SYNOPSIS +.nf +\fB#include \fR +.sp +char +\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) +.SH ARGUMENTS +.AS char *countPtr out +.AP char *src in +Pointer to a string starting with a backslash. +.AP int *countPtr out +If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled +in with number of characters in the backslash sequence, including +the backslash character. +.BE + +.SH DESCRIPTION +.PP +The use of \fBTcl_Backslash\fR is deprecated in favor of +\fBTcl_UtfBackslash\fR. +.PP +This is a utility procedure provided for backwards compatibility with +non-internationalized Tcl extensions. It parses a backslash sequence and +returns the low byte of the Unicode character corresponding to the sequence. +\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of +characters in the backslash sequence. +.PP +See the Tcl manual entry for information on the valid backslash sequences. +All of the sequences described in the Tcl manual entry are supported by +\fBTcl_Backslash\fR. +.SH "SEE ALSO" +Tcl(n), Tcl_UtfBackslash(3) + +.SH KEYWORDS +backslash, parse Index: doc/ByteArrObj.3 ================================================================== --- doc/ByteArrObj.3 +++ doc/ByteArrObj.3 @@ -27,12 +27,12 @@ .SH ARGUMENTS .AS "const unsigned char" *lengthPtr in/out .AP "const unsigned char" *bytes in The array of bytes used to initialize or set a byte-array value. May be NULL even if \fIlength\fR is non-zero. -.AP size_t length in -The length of the array of bytes. +.AP int length in +The length of the array of bytes. It must be >= 0. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to byte-array type. For \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to get the byte-array value; if \fIobjPtr\fR does not already point to a byte-array Index: doc/CallDel.3 ================================================================== --- doc/CallDel.3 +++ doc/CallDel.3 @@ -21,11 +21,11 @@ .AS Tcl_InterpDeleteProc clientData .AP Tcl_Interp *interp in Interpreter with which to associated callback. .AP Tcl_InterpDeleteProc *proc in Procedure to call when \fIinterp\fR is deleted. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP \fBTcl_CallWhenDeleted\fR arranges for \fIproc\fR to be called by @@ -36,11 +36,11 @@ \fIProc\fR should have arguments and result that match the type \fBTcl_InterpDeleteProc\fR: .PP .CS typedef void \fBTcl_InterpDeleteProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP The \fIclientData\fR and \fIinterp\fR parameters are copies of the \fIclientData\fR and \fIinterp\fR arguments given Index: doc/Cancel.3 ================================================================== --- doc/Cancel.3 +++ doc/Cancel.3 @@ -28,11 +28,11 @@ .AP int flags in ORed combination of flag bits that specify additional options. For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently supported. For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and \fBTCL_CANCEL_UNWIND\fR are currently supported. -.AP void *clientData in +.AP ClientData clientData in Currently reserved for future use. It should be set to NULL. .BE .SH DESCRIPTION .PP Index: doc/ChnlStack.3 ================================================================== --- doc/ChnlStack.3 +++ doc/ChnlStack.3 @@ -30,11 +30,11 @@ .AS Tcl_ChannelType clientData .AP Tcl_Interp *interp in Interpreter for error reporting. .AP "const Tcl_ChannelType" *typePtr in The new channel I/O procedures to use for \fIchannel\fR. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to channel I/O procedures. .AP int mask in Conditions under which \fIchannel\fR will be used: OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. This can be a subset of the operations currently allowed on \fIchannel\fR. Index: doc/Class.3 ================================================================== --- doc/Class.3 +++ doc/Class.3 @@ -39,26 +39,26 @@ \fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR) .sp int \fBTcl_ObjectDeleted\fR(\fIobject\fR) .sp -void * +ClientData \fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR) .sp \fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR) .sp -void * +ClientData \fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR) .sp \fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR) .sp Tcl_ObjectMapMethodNameProc \fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR) .sp \fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR) .SH ARGUMENTS -.AS void *metadata in/out +.AS ClientData metadata in/out .AP Tcl_Interp *interp in/out Interpreter providing the context for looking up or creating an object, and into whose result error messages will be written on failure. .AP Tcl_Obj *objPtr in The name of the object to look up. @@ -77,15 +77,17 @@ The number of elements in the \fIobjv\fR array. .AP "Tcl_Obj *const" *objv in The arguments to the command to create the instance of the class. .AP int skip in The number of arguments at the start of the argument array, \fIobjv\fR, that -are not arguments to any constructors. +are not arguments to any constructors. This allows the generation of correct +error messages even when complicated calling patterns are used (e.g., via the +\fBnext\fR command). .AP Tcl_ObjectMetadataType *metaTypePtr in The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or retrieved with \fBTcl_ClassGetMetadata\fR. -.AP void *metadata in +.AP ClientData metadata in An item of metadata to attach to the class, or NULL to remove the metadata associated with a particular \fImetaTypePtr\fR. .AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in A pointer to a function to call to adjust the mapping of objects and method names to implementations, or NULL when no such mapping is required. @@ -107,11 +109,13 @@ Every object has its own command and namespace associated with it. The command may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of the object (and hence the name of the command) with \fBTcl_GetObjectName\fR, and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR -is a shared reference. +is a shared reference. You can also get whether the object has been marked for +deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the +object has begun); this can be useful during the processing of methods. .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to @@ -119,10 +123,20 @@ (if any). The result of the function will be either a reference to the newly created object, or NULL if the creation failed (when an error message will be left in the interpreter result). In addition, objects may be copied by using \fBTcl_CopyObjectInstance\fR which creates a copy of an object without running any constructors. +.PP +Note that the lifetime management of objects is handled internally within +TclOO, and does not use \fBTcl_Preserve\fR. \fIIt is not safe to put a +Tcl_Object handle in a C structure with a lifespan different to the object;\fR +you should use the object's command name (as retrieved with +\fBTcl_GetObjectName\fR) instead. It is safe to use a Tcl_Object handle for +the lifespan of a call of a method on that object; handles do not become +invalid while there is an outstanding call on their object (even if the only +operation guaranteed to be safe on them is \fBTcl_ObjectDeleted\fR; the other +operations are only guaranteed to work on non-deleted objects). .SH "OBJECT AND CLASS METADATA" .PP Every object and every class may have arbitrary amounts of metadata attached to it, which the object or class attaches no meaning to beyond what is described in a Tcl_ObjectMetadataType structure instance. Metadata to be @@ -169,11 +183,11 @@ Functions matching this signature are used to delete metadata associated with a class or object. .PP .CS typedef void \fBTcl_ObjectMetadataDeleteProc\fR( - void *\fImetadata\fR); + ClientData \fImetadata\fR); .CE .PP The \fImetadata\fR argument gives the address of the metadata to be deleted. .SS "TCL_CLONEPROC FUNCTION SIGNATURE" @@ -182,12 +196,12 @@ associated with a class or object. .PP .CS typedef int \fBTcl_CloneProc\fR( Tcl_Interp *\fIinterp\fR, - void *\fIsrcMetadata\fR, - void **\fIdstMetadataPtr\fR); + ClientData \fIsrcMetadata\fR, + ClientData *\fIdstMetadataPtr\fR); .CE .PP The \fIinterp\fR argument gives a place to write an error message when the attempt to clone the object is to fail, in which case the clone procedure must also return TCL_ERROR; it should return TCL_OK otherwise. Index: doc/CrtChannel.3 ================================================================== --- doc/CrtChannel.3 +++ doc/CrtChannel.3 @@ -15,11 +15,11 @@ \fB#include \fR .sp Tcl_Channel \fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR) .sp -void * +ClientData \fBTcl_GetChannelInstanceData\fR(\fIchannel\fR) .sp const Tcl_ChannelType * \fBTcl_GetChannelType\fR(\fIchannel\fR) .sp @@ -126,11 +126,11 @@ The name of this channel, such as \fBfile3\fR; must not be in use by any other channel. Can be NULL, in which case the channel is created without a name. If the created channel is assigned to one of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR), the assigned channel name will be the name of the standard channel. -.AP void *instanceData in +.AP ClientData instanceData in Arbitrary one-word value to be associated with this channel. This value is passed to procedures in \fItypePtr\fR when they are invoked. .AP int mask in OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate whether a channel is readable and writable. @@ -137,11 +137,11 @@ .AP Tcl_Channel channel in The channel to operate on. .AP int direction in \fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR means the output handle is wanted. -.AP void **handlePtr out +.AP ClientData *handlePtr out Points to the location where the desired OS-specific handle should be stored. .AP int size in The size, in bytes, of buffers to allocate in this channel. .AP int mask in @@ -397,11 +397,11 @@ the generic layer to set blocking and nonblocking mode on the device. \fIBlockModeProc\fR should match the following prototype: .PP .CS typedef int \fBTcl_DriverBlockModeProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, int \fImode\fR); .CE .PP The \fIinstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. The \fImode\fR @@ -432,11 +432,11 @@ generic layer to clean up driver-related information when the channel is closed. \fICloseProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverCloseProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP The \fIinstanceData\fR argument is the same as the value provided to \fBTcl_CreateChannel\fR when the channel was created. The function should @@ -454,11 +454,11 @@ \fIclose2Proc\fR to the address of a function that matches the following prototype: .PP .CS typedef int \fBTcl_DriverClose2Proc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, Tcl_Interp *\fIinterp\fR, int \fIflags\fR); .CE .PP The \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed @@ -485,11 +485,11 @@ generic layer to read data from the file or device and store it in an internal buffer. \fIInputProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverInputProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, char *\fIbuf\fR, int \fIbufSize\fR, int *\fIerrorCodePtr\fR); .CE .PP @@ -529,11 +529,11 @@ generic layer to transfer data from an internal buffer to the output device. \fIOutputProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverOutputProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, const char *\fIbuf\fR, int \fItoWrite\fR, int *\fIerrorCodePtr\fR); .CE .PP @@ -568,11 +568,11 @@ operations will be applied. \fISeekProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverSeekProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, long \fIoffset\fR, int \fIseekMode\fR, int *\fIerrorCodePtr\fR); .CE .PP @@ -598,11 +598,11 @@ \fIwideSeekProc\fR is defined. \fIWideSeekProc\fR must match the following prototype: .PP .CS typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, Tcl_WideInt \fIoffset\fR, int \fIseekMode\fR, int *\fIerrorCodePtr\fR); .CE .PP @@ -620,11 +620,11 @@ the generic layer to set a channel type specific option on a channel. \fIsetOptionProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverSetOptionProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIoptionName\fR, const char *\fInewValue\fR); .CE .PP @@ -646,12 +646,12 @@ It should call \fBTcl_BadChannelOption\fR which itself returns \fBTCL_ERROR\fR if the \fIoptionName\fR is unrecognized. If \fInewValue\fR specifies a value for the option that is not supported or if a system call error occurs, -the function should leave an error message in the -\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The +the function should leave an error message in the result +of \fIinterp\fR if \fIinterp\fR is not NULL. The function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX error code. .PP This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns a pointer to the function. @@ -661,11 +661,11 @@ the generic layer to get the value of a channel type specific option on a channel. \fIgetOptionProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverGetOptionProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIoptionName\fR, Tcl_DString *\fIoptionValue\fR); .CE .PP @@ -699,11 +699,11 @@ notice events of interest on this channel. \fIWatchProc\fR should match the following prototype: .PP .CS typedef void \fBTcl_DriverWatchProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, int \fImask\fR); .CE .PP The \fIinstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. The \fImask\fR @@ -730,13 +730,13 @@ the generic layer to retrieve a device-specific handle from the channel. \fIGetHandleProc\fR should match the following prototype: .PP .CS typedef int \fBTcl_DriverGetHandleProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, int \fIdirection\fR, - void **\fIhandlePtr\fR); + ClientData *\fIhandlePtr\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. The \fIdirection\fR argument is either \fBTCL_READABLE\fR to retrieve the handle used @@ -759,11 +759,11 @@ It should be set to NULL. \fIFlushProc\fR should match the following prototype: .PP .CS typedef int \fBTcl_DriverFlushProc\fR( - void *\fIinstanceData\fR); + ClientData \fIinstanceData\fR); .CE .PP This value can be retrieved with \fBTcl_ChannelFlushProc\fR, which returns a pointer to the function. .SS HANDLERPROC @@ -774,11 +774,11 @@ that occur on the underlying (stacked) channel. \fIHandlerProc\fR should match the following prototype: .PP .CS typedef int \fBTcl_DriverHandlerProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, int \fIinterestMask\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. The \fIinterestMask\fR is an OR-ed @@ -803,11 +803,11 @@ might be maintaining using the calling thread as the associate. See \fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail. .PP .CS typedef void \fBTcl_DriverThreadActionProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, int \fIaction\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created. @@ -820,11 +820,11 @@ called by the generic layer when a channel is truncated to some length. It can be NULL. .PP .CS typedef int \fBTcl_DriverTruncateProc\fR( - void *\fIinstanceData\fR, + ClientData \fIinstanceData\fR, Tcl_WideInt \fIlength\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR when this channel was created, and Index: doc/CrtChnlHdlr.3 ================================================================== --- doc/CrtChnlHdlr.3 +++ doc/CrtChnlHdlr.3 @@ -30,11 +30,11 @@ \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. Specify a zero value to temporarily disable an existing handler. .AP Tcl_FileProc *proc in Procedure to invoke whenever the channel indicated by \fIchannel\fR meets the conditions specified by \fImask\fR. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP \fBTcl_CreateChannelHandler\fR arranges for \fIproc\fR to be called in the @@ -46,11 +46,11 @@ what it means for a channel to be readable or writable. \fIProc\fR must conform to the following prototype: .PP .CS typedef void \fBTcl_ChannelProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, int \fImask\fR); .CE .PP The \fIclientData\fR argument is the same as the value passed to \fBTcl_CreateChannelHandler\fR when the handler was created. Typically, Index: doc/CrtCloseHdlr.3 ================================================================== --- doc/CrtCloseHdlr.3 +++ doc/CrtCloseHdlr.3 @@ -24,11 +24,11 @@ .AS Tcl_CloseProc clientData .AP Tcl_Channel channel in The channel for which to create or delete a close callback. .AP Tcl_CloseProc *proc in The procedure to call as the callback. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP \fBTcl_CreateCloseHandler\fR arranges for \fIproc\fR to be called when @@ -36,11 +36,11 @@ \fBTcl_UnregisterChannel\fR, or using the Tcl \fBclose\fR command. \fIProc\fR should match the following prototype: .PP .CS typedef void \fBTcl_CloseProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR is the same as the value provided in the call to \fBTcl_CreateCloseHandler\fR. .PP Index: doc/CrtCommand.3 ================================================================== --- doc/CrtCommand.3 +++ doc/CrtCommand.3 @@ -23,11 +23,11 @@ .AP "const char" *cmdName in Name of command. .AP Tcl_CmdProc *proc in Implementation of new command: \fIproc\fR will be called whenever \fIcmdName\fR is invoked as a command. -.AP voie *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in Procedure to call before \fIcmdName\fR is deleted from the interpreter; allows for command-specific cleanup. If NULL, then no procedure is called before the command is deleted. @@ -73,11 +73,11 @@ \fIProc\fR should have arguments and result that match the type \fBTcl_CmdProc\fR: .PP .CS typedef int \fBTcl_CmdProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIargc\fR, const char *\fIargv\fR[]); .CE .PP @@ -129,15 +129,15 @@ with the command. \fIDeleteProc\fR should have arguments and result that match the type \fBTcl_CmdDeleteProc\fR: .PP .CS typedef void \fBTcl_CmdDeleteProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR argument passed to \fBTcl_CreateCommand\fR. .SH "SEE ALSO" Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult .SH KEYWORDS bind, command, create, delete, interpreter, namespace Index: doc/CrtFileHdlr.3 ================================================================== --- doc/CrtFileHdlr.3 +++ doc/CrtFileHdlr.3 @@ -27,11 +27,11 @@ and \fBTCL_EXCEPTION\fR. May be set to 0 to temporarily disable a handler. .AP Tcl_FileProc *proc in Procedure to invoke whenever the file or device indicated by \fIfile\fR meets the conditions specified by \fImask\fR. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP \fBTcl_CreateFileHandler\fR arranges for \fIproc\fR to be @@ -49,11 +49,11 @@ \fIProc\fR should have arguments and result that match the type \fBTcl_FileProc\fR: .PP .CS typedef void \fBTcl_FileProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, int \fImask\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR Index: doc/CrtInterp.3 ================================================================== --- doc/CrtInterp.3 +++ doc/CrtInterp.3 @@ -20,14 +20,12 @@ \fBTcl_DeleteInterp\fR(\fIinterp\fR) .sp int \fBTcl_InterpDeleted\fR(\fIinterp\fR) .sp -.VS 8.6 int \fBTcl_InterpActive\fR(\fIinterp\fR) -.VE 8.6 .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in Token for interpreter to be destroyed or queried. .BE @@ -68,18 +66,16 @@ between when only the memory the callback is responsible for is being deleted and when the whole interpreter is being deleted. In the former case the callback may recreate the data being deleted, but this would lead to an infinite loop if the interpreter were being deleted. .PP -.VS 8.6 \fBTcl_InterpActive\fR is useful for determining whether there is any execution of scripts ongoing in an interpreter, which is a useful piece of information when Tcl is embedded in a garbage-collected environment and it becomes necessary to determine whether the interpreter is a candidate for deletion. The function returns a true value if the interpreter has at least one active execution running inside it, and a false value otherwise. -.VE 8.6 .SH "INTERPRETERS AND MEMORY MANAGEMENT" .PP \fBTcl_DeleteInterp\fR can be called at any time on an interpreter that may be used by nested evaluations and C code in various extensions. Tcl implements a simple mechanism that allows callers to use interpreters @@ -136,15 +132,13 @@ .PP All uses of interpreters in Tcl and Tk have already been protected. Extension writers should ensure that their code also properly protects any additional interpreters used, as described above. .PP -.VS 8.6 Note that the protection mechanisms do not work well with conventional garbage collection systems. When in such a managed environment, \fBTcl_InterpActive\fR should be used to determine when an interpreter is a candidate for deletion due to inactivity. -.VE 8.6 .SH "SEE ALSO" Tcl_Preserve(3), Tcl_Release(3) .SH KEYWORDS command, create, delete, interpreter ADDED doc/CrtMathFnc.3 Index: doc/CrtMathFnc.3 ================================================================== --- /dev/null +++ doc/CrtMathFnc.3 @@ -0,0 +1,162 @@ +'\" +'\" Copyright (c) 1989-1993 The Regents of the University of California. +'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros +.BS +.SH NAME +Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions +.SH "NOTICE OF EVENTUAL DEPRECATION" +.PP +The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions +are rendered somewhat obsolete by the ability to create functions for +expressions by placing commands in the \fBtcl::mathfunc\fR namespace, +as described in the \fBmathfunc\fR manual page; the API described on +this page is not expected to be maintained indefinitely. +.SH SYNOPSIS +.nf +\fB#include \fR +.sp +void +\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) +.sp +int +\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, + clientDataPtr\fR) +.sp +Tcl_Obj * +\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) +.SH ARGUMENTS +.AS Tcl_ValueType *clientDataPtr out +.AP Tcl_Interp *interp in +Interpreter in which new function will be defined. +.AP "const char" *name in +Name for new function. +.AP int numArgs in +Number of arguments to new function; also gives size of \fIargTypes\fR array. +.AP Tcl_ValueType *argTypes in +Points to an array giving the permissible types for each argument to +function. +.AP Tcl_MathProc *proc in +Procedure that implements the function. +.AP ClientData clientData in +Arbitrary one-word value to pass to \fIproc\fR when it is invoked. +.AP int *numArgsPtr out +Points to a variable that will be set to contain the number of +arguments to the function. +.AP Tcl_ValueType **argTypesPtr out +Points to a variable that will be set to contain a pointer to an array +giving the permissible types for each argument to the function which +will need to be freed up using \fITcl_Free\fR. +.AP Tcl_MathProc **procPtr out +Points to a variable that will be set to contain a pointer to the +implementation code for the function (or NULL if the function is +implemented directly in bytecode). +.AP ClientData *clientDataPtr out +Points to a variable that will be set to contain the clientData +argument passed to \fITcl_CreateMathFunc\fR when the function was +created if the function is not implemented directly in bytecode. +.AP "const char" *pattern in +Pattern to match against function names so as to filter them (by +passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. +.BE +.SH DESCRIPTION +.PP +Tcl allows a number of mathematical functions to be used in +expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. +These functions are represented by commands in the namespace, +\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is +an obsolete way for applications to add additional functions +to those already provided by Tcl or to replace existing functions. +It should not be used by new applications, which should create +math functions using \fBTcl_CreateObjCommand\fR to create a command +in the \fBtcl::mathfunc\fR namespace. +.PP +In the \fBTcl_CreateMathFunc\fR interface, +\fIName\fR is the name of the function as it will appear in expressions. +If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR +namespace, then a new command is created in that namespace. +If \fIname\fR does exist, then the existing function is replaced. +\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. +Each entry in the \fIargTypes\fR array must be +one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, +or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an +integer, a double-precision floating value, a wide (64-bit) integer, +or any, respectively. +.PP +Whenever the function is invoked in an expression Tcl will invoke +\fIproc\fR. \fIProc\fR should have arguments and result that match +the type \fBTcl_MathProc\fR: +.PP +.CS +typedef int \fBTcl_MathProc\fR( + ClientData \fIclientData\fR, + Tcl_Interp *\fIinterp\fR, + Tcl_Value *\fIargs\fR, + Tcl_Value *\fIresultPtr\fR); +.CE +.PP +When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR +arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. +\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, +which describe the actual arguments to the function: +.PP +.CS +typedef struct Tcl_Value { + Tcl_ValueType \fItype\fR; + long \fIintValue\fR; + double \fIdoubleValue\fR; + Tcl_WideInt \fIwideValue\fR; +} \fBTcl_Value\fR; +.CE +.PP +The \fItype\fR field indicates the type of the argument and is +one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. +It will match the \fIargTypes\fR value specified for the function unless +the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts +the argument supplied in the expression to the type requested in +\fIargTypes\fR, if that is necessary. +Depending on the value of the \fItype\fR field, the \fIintValue\fR, +\fIdoubleValue\fR or \fIwideValue\fR +field will contain the actual value of the argument. +.PP +\fIProc\fR should compute its result and store it either as an integer +in \fIresultPtr->intValue\fR or as a floating value in +\fIresultPtr->doubleValue\fR. +It should set also \fIresultPtr->type\fR to one of +\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR +to indicate which value was set. +Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. +If an error occurs while executing the function, \fIproc\fR should +return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. +.PP +\fBTcl_GetMathFuncInfo\fR retrieves the values associated with +function \fIname\fR that were passed to a preceding +\fBTcl_CreateMathFunc\fR call. Normally, the return code is +\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR +is returned and an error message is placed in the interpreter's +result. +.PP +If an error did not occur, the array reference placed in the variable +pointed to by \fIargTypesPtr\fR is newly allocated, and should be +released by passing it to \fBTcl_Free\fR. Some functions (the +standard set implemented in the core, and those defined by placing +commands in the \fBtcl::mathfunc\fR namespace) do not have +argument type information; attempting to retrieve values for +them causes a NULL to be stored in the variable pointed to by +\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR +will not be modified. The variable pointed to by \fInumArgsPointer\fR +will contain -1, and no argument types will be stored in the variable +pointed to by \fIargTypesPointer\fR. +.PP +\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all +the math functions defined in the interpreter whose name matches +\fIpattern\fR. The returned value has a reference count of zero. +.SH "SEE ALSO" +expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) +.SH KEYWORDS +expression, mathematical function Index: doc/CrtObjCmd.3 ================================================================== --- doc/CrtObjCmd.3 +++ doc/CrtObjCmd.3 @@ -57,11 +57,11 @@ .AP char *cmdName in Name of command. .AP Tcl_ObjCmdProc *proc in Implementation of the new command: \fIproc\fR will be called whenever \fIcmdName\fR is invoked as a command. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in Procedure to call before \fIcmdName\fR is deleted from the interpreter; allows for command-specific cleanup. If NULL, then no procedure is called before the command is deleted. @@ -100,11 +100,11 @@ \fIproc\fR should have arguments and result that match the type \fBTcl_ObjCmdProc\fR: .PP .CS typedef int \fBTcl_ObjCmdProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); .CE .PP @@ -173,11 +173,11 @@ with the command. \fIDeleteProc\fR should have arguments and result that match the type \fBTcl_CmdDeleteProc\fR: .PP .CS typedef void \fBTcl_CmdDeleteProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR argument passed to \fBTcl_CreateObjCommand\fR. .PP @@ -215,15 +215,15 @@ .PP .CS typedef struct Tcl_CmdInfo { int \fIisNativeObjectProc\fR; Tcl_ObjCmdProc *\fIobjProc\fR; - void *\fIobjClientData\fR; + ClientData \fIobjClientData\fR; Tcl_CmdProc *\fIproc\fR; - void *\fIclientData\fR; + ClientData \fIclientData\fR; Tcl_CmdDeleteProc *\fIdeleteProc\fR; - void *\fIdeleteData\fR; + ClientData \fIdeleteData\fR; Tcl_Namespace *\fInamespacePtr\fR; } \fBTcl_CmdInfo\fR; .CE .PP The \fIisNativeObjectProc\fR field has the value 1 @@ -245,11 +245,11 @@ this is the procedure passed to it; otherwise, this is a compatibility procedure registered by \fBTcl_CreateObjCommand\fR that simply calls the command's value-based procedure after converting its string arguments to Tcl values. -The field \fIdeleteData\fR is the clientData value +The field \fIdeleteData\fR is the ClientData value to pass to \fIdeleteProc\fR; it is normally the same as \fIclientData\fR but may be set independently using the \fBTcl_SetCommandInfo\fR procedure. The field \fInamespacePtr\fR holds a pointer to the Tcl_Namespace that contains the command. @@ -259,11 +259,11 @@ from \fBTcl_CreateObjCommand\fR in place of the command name. If the \fItoken\fR parameter is NULL, it returns 0; otherwise, it returns 1 and fills in the structure designated by \fIinfoPtr\fR. .PP \fBTcl_SetCommandInfo\fR is used to modify the procedures and -clientData values associated with a command. +ClientData values associated with a command. Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR. \fIcmdName\fR may include \fB::\fR namespace qualifiers to identify a command in a particular namespace. If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0. Otherwise, it copies the information from \fI*infoPtr\fR to @@ -275,13 +275,13 @@ If the \fItoken\fR parameter is NULL, it returns 0. Otherwise, it copies the information from \fI*infoPtr\fR to Tcl's internal structure for the command and returns 1. .PP Note that \fBTcl_SetCommandInfo\fR and -\fBTcl_SetCommandInfoFromToken\fR both allow the clientData for a +\fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a command's deletion procedure to be given a different value than the -clientData for its command procedure. +ClientData for its command procedure. .PP Note that neither \fBTcl_SetCommandInfo\fR nor \fBTcl_SetCommandInfoFromToken\fR will change a command's namespace. Use \fBTcl_Eval\fR to call the \fBrename\fR command to do that. .PP Index: doc/CrtSlave.3 ================================================================== --- doc/CrtSlave.3 +++ doc/CrtSlave.3 @@ -117,11 +117,11 @@ facility from inside C programs. They enable managing multiple interpreters in a hierarchical relationship, and the management of aliases, commands that when invoked in one interpreter execute a command in another interpreter. The return value for those procedures that return an \fBint\fR is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned -then the \fBresult\fR field of the interpreter contains an error message. +then the interpreter's result contains an error message. .PP \fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR. It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which allows \fIinterp\fR to manipulate the new slave. If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl @@ -156,16 +156,16 @@ .PP \fBTcl_GetMaster\fR returns a pointer to the master interpreter of \fIinterp\fR. If \fIinterp\fR has no master (it is a top-level interpreter) then \fBNULL\fR is returned. .PP -\fBTcl_GetInterpPath\fR sets the \fIresult\fR field in \fIaskingInterp\fR -to the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR; +\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR +the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR; \fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation of the relative path succeeds, \fBTCL_OK\fR is returned, else -\fBTCL_ERROR\fR is returned and the \fIresult\fR field in -\fIaskingInterp\fR contains the error message. +\fBTCL_ERROR\fR is returned and an error message is stored as the +result of \fIaskingInterp\fR. .PP \fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in \fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR to be invoked in \fItargetInterp\fR. The arguments specified by the strings contained in \fIargv\fR are always prepended to any arguments supplied in the @@ -196,41 +196,41 @@ \fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from the set of hidden commands to the set of exposed commands, putting it under the name \fIcmdName\fR. \fIHiddenCmdName\fR must be the name of an existing hidden -command, or the operation will return \fBTCL_ERROR\fR and leave an error -message in the \fIresult\fR field in \fIinterp\fR. +command, or the operation will return \fBTCL_ERROR\fR and +leave an error message as the result of \fIinterp\fR. If an exposed command named \fIcmdName\fR already exists, -the operation returns \fBTCL_ERROR\fR and leaves an error message in the -value result of \fIinterp\fR. +the operation returns \fBTCL_ERROR\fR and leaves an error message as +the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. -After executing this command, attempts to use \fIcmdName\fR in a call to -\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will again succeed. +After executing this command, attempts to use \fIcmdName\fR in any +script evaluation mechanism will again succeed. .PP \fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of exposed commands to the set of hidden commands, under the name \fIhiddenCmdName\fR. \fICmdName\fR must be the name of an existing exposed command, or the operation will return \fBTCL_ERROR\fR and leave an error -message in the value result of \fIinterp\fR. +message as the result of \fIinterp\fR. Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and -leave an error message in the value result of \fIinterp\fR. +leave an error message as the result of \fIinterp\fR. The \fICmdName\fR will be looked up in the global namespace, and not relative to the current namespace, even if the current namespace is not the global one. If a hidden command whose name is \fIhiddenCmdName\fR already -exists, the operation also returns \fBTCL_ERROR\fR and the \fIresult\fR -field in \fIinterp\fR contains an error message. +exists, the operation also returns \fBTCL_ERROR\fR and an error +message is left as the result of \fIinterp\fR. If the operation succeeds, it returns \fBTCL_OK\fR. -After executing this command, attempts to use \fIcmdName\fR in a call to -\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will fail. +After executing this command, attempts to use \fIcmdName\fR in +any script evaluation mechanism will fail. .PP For a description of the Tcl interface to multiple interpreters, see \fIinterp(n)\fR. .SH "SEE ALSO" interp .SH KEYWORDS alias, command, exposed commands, hidden commands, interpreter, invoke, master, slave Index: doc/CrtTimerHdlr.3 ================================================================== --- doc/CrtTimerHdlr.3 +++ doc/CrtTimerHdlr.3 @@ -22,11 +22,11 @@ .AS Tcl_TimerToken milliseconds .AP int milliseconds in How many milliseconds to wait before invoking \fIproc\fR. .AP Tcl_TimerProc *proc in Procedure to invoke after \fImilliseconds\fR have elapsed. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .AP Tcl_TimerToken token in Token for previously created timer handler (the return value from some previous call to \fBTcl_CreateTimerHandler\fR). .BE @@ -49,11 +49,11 @@ \fIProc\fR should have arguments and return value that match the type \fBTcl_TimerProc\fR: .PP .CS typedef void \fBTcl_TimerProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTcl_CreateTimerHandler\fR when the callback Index: doc/CrtTrace.3 ================================================================== --- doc/CrtTrace.3 +++ doc/CrtTrace.3 @@ -39,11 +39,11 @@ Procedure to call for each command that is executed. See below for details of the calling sequence. .AP Tcl_CmdTraceProc *proc in Procedure to call for each command that is executed. See below for details on the calling sequence. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR. .AP Tcl_CmdObjTraceDeleteProc *deleteProc in Procedure to call when the trace is deleted. See below for details of the calling sequence. A NULL pointer is permissible and results in no callback when the trace is deleted. @@ -64,11 +64,11 @@ \fIobjProc\fR should have arguments and result that match the type, \fBTcl_CmdObjTraceProc\fR: .PP .CS typedef int \fBTcl_CmdObjTraceProc\fR( - \fBvoid *\fR \fIclientData\fR, + \fBClientData\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, int \fIlevel\fR, const char *\fIcommand\fR, \fBTcl_Command\fR \fIcommandToken\fR, int \fIobjc\fR, @@ -75,11 +75,11 @@ \fBTcl_Obj\fR *const \fIobjv\fR[]); .CE .PP The \fIclientData\fR and \fIinterp\fR parameters are copies of the corresponding arguments given to \fBTcl_CreateTrace\fR. -\fIclientData\fR typically points to an application-specific data +\fIClientData\fR typically points to an application-specific data structure that describes what to do when \fIobjProc\fR is invoked. The \fIlevel\fR parameter gives the nesting level of the command (1 for top-level commands passed to \fBTcl_Eval\fR by the application, 2 for the next-level commands passed to \fBTcl_Eval\fR as part of parsing or interpreting level-1 commands, and so on). The \fIcommand\fR parameter @@ -142,11 +142,11 @@ \fBTcl_CreateObjTrace\fR. The \fIdeleteProc\fR must match the type, \fBTcl_CmdObjTraceDeleteProc\fR: .PP .CS typedef void \fBTcl_CmdObjTraceDeleteProc\fR( - \fBvoid *\fR \fIclientData\fR); + \fBClientData\fR \fIclientData\fR); .CE .PP The \fIclientData\fR parameter will be the same as the \fIclientData\fR parameter that was originally passed to \fBTcl_CreateObjTrace\fR. @@ -158,16 +158,16 @@ that its \fIproc\fR parameter should have arguments and result that match the type \fBTcl_CmdTraceProc\fR: .PP .CS typedef void \fBTcl_CmdTraceProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIlevel\fR, char *\fIcommand\fR, Tcl_CmdProc *\fIcmdProc\fR, - void *\fIcmdClientData\fR, + ClientData \fIcmdClientData\fR, int \fIargc\fR, const char *\fIargv\fR[]); .CE .PP The parameters to the \fIproc\fR callback are similar to those of the Index: doc/DString.3 ================================================================== --- doc/DString.3 +++ doc/DString.3 @@ -7,11 +7,11 @@ '\" .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings +Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings .SH SYNOPSIS .nf \fB#include \fR .sp \fBTcl_DStringInit\fR(\fIdsPtr\fR) @@ -24,17 +24,19 @@ .sp \fBTcl_DStringStartSublist\fR(\fIdsPtr\fR) .sp \fBTcl_DStringEndSublist\fR(\fIdsPtr\fR) .sp -size_t +int \fBTcl_DStringLength\fR(\fIdsPtr\fR) .sp char * \fBTcl_DStringValue\fR(\fIdsPtr\fR) .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) +.sp +\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR) .sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) .sp @@ -45,14 +47,14 @@ Pointer to structure that is used to manage a dynamic string. .AP "const char" *bytes in Pointer to characters to append to dynamic string. .AP "const char" *element in Pointer to characters to append as list element to dynamic string. -.AP size_t length in -Number of bytes from \fIbytes\fR to add to dynamic string. If TCL_AUTO_LENGTH, +.AP int length in +Number of bytes from \fIbytes\fR to add to dynamic string. If -1, add all characters up to null terminating character. -.AP size_t newLength in +.AP int newLength in New length for dynamic string, not including null terminating character. .AP Tcl_Interp *interp in/out Interpreter whose result is to be set from or moved to the dynamic string. @@ -123,10 +125,14 @@ space except to provide a terminating null character; it is up to the caller to fill in the new space. \fBTcl_DStringSetLength\fR does not free up the string's storage space even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. +.PP +\fBTcl_DStringTrunc\fR changes the length of a dynamic string. +This procedure is now deprecated. \fBTcl_DStringSetLength\fR should +be used instead. .PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. .PP Index: doc/DoWhenIdle.3 ================================================================== --- doc/DoWhenIdle.3 +++ doc/DoWhenIdle.3 @@ -19,11 +19,11 @@ \fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR) .SH ARGUMENTS .AS Tcl_IdleProc clientData .AP Tcl_IdleProc *proc in Procedure to invoke. -.AP coid *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP \fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked @@ -41,11 +41,11 @@ \fIProc\fR should have arguments and result that match the type \fBTcl_IdleProc\fR: .PP .CS typedef void \fBTcl_IdleProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTcl_DoWhenIdle\fR. Typically, \fIclientData\fR points to a data structure containing application-specific information about Index: doc/DumpActiveMemory.3 ================================================================== --- doc/DumpActiveMemory.3 +++ doc/DumpActiveMemory.3 @@ -41,11 +41,11 @@ is not defined, these functions are all no-ops. .PP \fBTcl_DumpActiveMemory\fR will output a list of all currently allocated memory to the specified file. The information output for each allocated block of memory is: starting and ending addresses -(excluding guard zone), size, source file where \fBTcl_Alloc\fR was +(excluding guard zone), size, source file where \fBckalloc\fR was called to allocate the block and line number in that file. It is especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl interpreter has been deleted. .PP \fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the @@ -53,16 +53,16 @@ by \fBTcl_Main\fR. .PP \fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of all currently allocated blocks of memory. Normally validation of a block occurs when its freed, unless full validation is enabled, in -which case validation of all blocks occurs when \fBTcl_Alloc\fR and -\fBTcl_Free\fR are called. This function forces the validation to occur +which case validation of all blocks occurs when \fBckalloc\fR and +\fBckfree\fR are called. This function forces the validation to occur at any point. .SH "SEE ALSO" TCL_MEM_DEBUG, memory .SH KEYWORDS memory, debug Index: doc/Encoding.3 ================================================================== --- doc/Encoding.3 +++ doc/Encoding.3 @@ -6,11 +6,11 @@ '\" .TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings +Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include \fR .sp Tcl_Encoding @@ -60,10 +60,16 @@ Tcl_Obj * \fBTcl_GetEncodingSearchPath\fR() .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) +.sp +const char * +\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR) +.sp +void +\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR) .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in Interpreter to use for error reporting, or NULL if no error reporting is desired. @@ -81,11 +87,11 @@ specified encoding that are to be converted to UTF-8. For the \fBTcl_UtfToExternal\fR and \fBTcl_WinUtfToTChar\fR functions, an array of UTF-8 characters to be converted to the specified encoding. .AP "const TCHAR" *tsrc in An array of Windows TCHAR characters to convert to UTF-8. -.AP size_t srcLen in +.AP int srcLen in Length of \fIsrc\fR or \fItsrc\fR in bytes. If the length is negative, the encoding-specific length of the string is used. .AP Tcl_DString *dstPtr out Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted result will be stored. @@ -247,15 +253,21 @@ bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR is filled with the corresponding number of bytes that were stored in \fIdst\fR. The return values are the same as the return values for \fBTcl_ExternalToUtf\fR. .PP -\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are -Windows-only convenience -functions for converting between UTF-8 and Windows strings -based on the TCHAR type which is by convention -a Unicode character on Windows NT. +\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are Windows-only +convenience functions for converting between UTF-8 and Windows strings +based on the TCHAR type which is by convention a Unicode character on +Windows NT. Those functions are deprecated. You can use +\fBTcl_UtfToWCharDString\fR resp. \fBTcl_WCharToUtfDString\fR as replacement. +If you want compatibility with earlier Tcl releases than 8.7, use +\fBTcl_UtfToUniCharDString\fR resp. \fBTcl_UniCharToUtfDString\fR as +replacement, and make sure you compile your extension with -DTCL_UTF_MAX=3. +Beware: Those replacement functions don't initialize their Tcl_DString (you'll +have to do that yourself), and \fBTcl_UniCharToUtfDString\fR from Tcl 8.6 +doesn't accept -1 as length parameter. .PP \fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR. Given an \fIencoding\fR, the return value is the \fIname\fR argument that was used to create the encoding. The string returned by \fBTcl_GetEncodingName\fR is only guaranteed to persist until the @@ -279,11 +291,11 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned. .PP \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by -\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the +\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP \fBTcl_CreateEncoding\fR defines a new encoding and registers the C procedures that are called back to convert between the encoding and @@ -306,11 +318,11 @@ typedef struct Tcl_EncodingType { const char *\fIencodingName\fR; Tcl_EncodingConvertProc *\fItoUtfProc\fR; Tcl_EncodingConvertProc *\fIfromUtfProc\fR; Tcl_EncodingFreeProc *\fIfreeProc\fR; - void *\fIclientData\fR; + ClientData \fIclientData\fR; int \fInullSize\fR; } \fBTcl_EncodingType\fR; .CE .PP The \fIencodingName\fR provides a string name for the encoding, by @@ -337,11 +349,11 @@ The callback procedures \fItoUtfProc\fR and \fIfromUtfProc\fR should match the type \fBTcl_EncodingConvertProc\fR: .PP .CS typedef int \fBTcl_EncodingConvertProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, const char *\fIsrc\fR, int \fIsrcLen\fR, int \fIflags\fR, Tcl_EncodingState *\fIstatePtr\fR, char *\fIdst\fR, @@ -369,11 +381,11 @@ The callback procedure \fIfreeProc\fR, if non-NULL, should match the type \fBTcl_EncodingFreeProc\fR: .PP .CS typedef void \fBTcl_EncodingFreeProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP This \fIfreeProc\fR function is called when the encoding is deleted. The \fIclientData\fR parameter is the same as the \fIclientData\fR field specified to \fBTcl_CreateEncoding\fR when the encoding was created. @@ -394,10 +406,19 @@ causes \fBTCL_ERROR\fR to be returned. The elements of \fIsearchPath\fR are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. +.PP +\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR +are obsolete interfaces best replaced with calls to +\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR. +They are called to access and set the first element of the \fIsearchPath\fR +list. Since Tcl searches \fIsearchPath\fR for encoding data files in +list order, these routines establish the +.QW default +directory in which to find encoding data files. .SH "ENCODING FILES" Space would prohibit precompiling into Tcl every possible encoding algorithm, so many encodings are stored on disk as dynamically-loadable encoding files. This behavior also allows the user to create additional encoding files that can be loaded using the same mechanism. These Index: doc/Ensemble.3 ================================================================== --- doc/Ensemble.3 +++ doc/Ensemble.3 @@ -34,17 +34,15 @@ \fBTcl_GetEnsembleMappingDict\fR(\fIinterp, token, dictObjPtr\fR) .sp int \fBTcl_SetEnsembleMappingDict\fR(\fIinterp, token, dictObj\fR) .sp -.VS 8.6 int \fBTcl_GetEnsembleParameterList\fR(\fIinterp, token, listObjPtr\fR) .sp int \fBTcl_SetEnsembleParameterList\fR(\fIinterp, token, listObj\fR) -.VE 8.6 .sp int \fBTcl_GetEnsembleSubcommandList\fR(\fIinterp, token, listObjPtr\fR) .sp int @@ -161,11 +159,10 @@ even if it is unshared. All command names in prefixes set via \fBTcl_SetEnsembleMappingDict\fR must be fully qualified. .TP \fBformal pre-subcommand parameter list\fR (read-write) -.VS 8.6 A list of formal parameter names (the names only being used when generating error messages) that come at invocation of the ensemble between the name of the ensemble and the subcommand argument. NULL (the default) is equivalent to the empty list. May be read and written using \fBTcl_GetEnsembleParameterList\fR and \fBTcl_SetEnsembleParameterList\fR @@ -172,11 +169,10 @@ respectively. The result of both of those functions is a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an ensemble) and the dictionary obtained from \fBTcl_GetEnsembleParameterList\fR should always be treated as immutable even if it is unshared. -.VE 8.6 .TP \fBsubcommand list\fR (read-write) . A list of all the subcommand names for the ensemble, or NULL if this is to be derived from either the keys of the mapping dictionary (see Index: doc/Eval.3 ================================================================== --- doc/Eval.3 +++ doc/Eval.3 @@ -8,11 +8,11 @@ '\" .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include \fR .sp int @@ -36,10 +36,13 @@ int \fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) .sp int \fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR) +.sp +int +\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in Interpreter in which to execute the script. The interpreter's result is modified to hold the result or error message from the script. @@ -62,10 +65,13 @@ first null byte are used. .AP "const char" *script in Points to first byte of script to execute (null-terminated and UTF-8). .AP char *part in String forming part of a Tcl script. +.AP va_list argList in +An argument list which must have been initialized using +\fBva_start\fR, and cleared using \fBva_end\fR. .BE .SH DESCRIPTION .PP The procedures described here are invoked to execute Tcl scripts in @@ -120,14 +126,20 @@ might be a UTF-8 special code. The string is parsed and executed directly (using \fBTcl_EvalObjv\fR) instead of compiling it and executing the bytecodes. In situations where it is known that the script will never be executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR. \fBTcl_Eval\fR returns a completion code and result just like -\fBTcl_EvalObjEx\fR. +\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before +Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to +\fIinterp->result\fR (use is deprecated) where it can be accessed directly. + This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which +does not do the copy. .PP \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes -additional arguments \fInumBytes\fR and \fIflags\fR. +additional arguments \fInumBytes\fR and \fIflags\fR. For the +efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred +over \fBTcl_Eval\fR. .PP \fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures that are now deprecated. They are similar to \fBTcl_EvalEx\fR and \fBTcl_EvalObjEx\fR except that the script is evaluated in the global namespace and its variable context consists of global variables only @@ -136,13 +148,18 @@ .PP \fBTcl_VarEval\fR takes any number of string arguments of any length, concatenates them into a single string, then calls \fBTcl_Eval\fR to execute that string as a Tcl command. It returns the result of the command and also modifies -\fIinterp->result\fR in the same way as \fBTcl_Eval\fR. +the interpreter result in the same way as \fBTcl_Eval\fR. The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end of arguments. \fBTcl_VarEval\fR is now deprecated. +.PP +\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that +instead of taking a variable number of arguments it takes an argument +list. Interfaces using argument lists have been found to be nonportable +in practice. This function is deprecated and will be removed in Tcl 9.0. .SH "FLAG BITS" .PP Any ORed combination of the following values may be used for the \fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR: Index: doc/Exit.3 ================================================================== --- doc/Exit.3 +++ doc/Exit.3 @@ -40,11 +40,11 @@ usually means that an error occurred. .AP Tcl_ExitProc *proc in Procedure to invoke before exiting application, or (for \fBTcl_SetExitProc\fR) NULL to uninstall the current application exit procedure. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP @@ -62,11 +62,11 @@ \fBTcl_Exit\fR, the exit handlers will not be run. \fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never returns control to its caller. If an application exit handler has been installed (see \fBTcl_SetExitProc\fR), that handler is invoked with an argument -consisting of the exit status (cast to void *); the application +consisting of the exit status (cast to ClientData); the application exit handler should not return control to Tcl. .PP \fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not exit from the current process. It is useful for cleaning up when a process is finished using \fBTcl\fR but @@ -91,11 +91,11 @@ and freeing global memory. \fIProc\fR should match the type \fBTcl_ExitProc\fR: .PP .CS typedef void \fBTcl_ExitProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTcl_CreateExitHandler\fR or \fBTcl_CreateThreadExitHandler\fR when @@ -131,12 +131,13 @@ application handler was installed. If an application exit handler is installed, that exit handler takes over complete responsibility for finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an appropriate time. The argument passed to \fIproc\fR when it is invoked will be the exit status code (as passed to \fBTcl_Exit\fR) -cast to a void *value. +cast to a ClientData value. .PP -\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions. +\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions. Its symbol +entry in the stub table is deprecated and it will be removed in Tcl 9.0. .SH "SEE ALSO" exit(n) .SH KEYWORDS abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread Index: doc/FileSystem.3 ================================================================== --- doc/FileSystem.3 +++ doc/FileSystem.3 @@ -18,11 +18,11 @@ \fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR) .sp int \fBTcl_FSUnregister\fR(\fIfsPtr\fR) .sp -void * +ClientData \fBTcl_FSData\fR(\fIfsPtr\fR) .sp void \fBTcl_FSMountsChanged\fR(\fIfsPtr\fR) .sp @@ -61,14 +61,12 @@ .sp int \fBTcl_FSLoadFile\fR(\fIinterp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, loadHandlePtr, unloadProcPtr\fR) .sp -.VS 8.6 int \fBTcl_FSUnloadFile\fR(\fIinterp, loadHandle\fR) -.VE 8.6 .sp int \fBTcl_FSMatchInDirectory\fR(\fIinterp, resultPtr, pathPtr, pattern, types\fR) .sp Tcl_Obj * @@ -123,11 +121,11 @@ \fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR) .sp int \fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR) .sp -void * +ClientData \fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR) .sp Tcl_Obj * \fBTcl_FSGetTranslatedPath\fR(\fIinterp, pathPtr\fR) .sp @@ -144,11 +142,10 @@ \fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR) .sp Tcl_StatBuf * \fBTcl_AllocStatBuf\fR() .sp -.VS 8.6 Tcl_WideInt \fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR) .sp unsigned \fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR) @@ -183,11 +180,10 @@ Tcl_WideUInt \fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR) .sp int \fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR) -.VE 8.6 .SH ARGUMENTS .AS Tcl_GlobTypeData **srcPathPtr out .AP "const Tcl_Filesystem" *fsPtr in Points to a structure containing the addresses of procedures that can be called to perform the various filesystem operations. @@ -210,11 +206,11 @@ Only files or directories matching the type descriptions contained in this structure will be returned. This parameter may be NULL. .AP Tcl_Interp *interp in Interpreter to use either for results, evaluation, or reporting error messages. -.AP void *clientData in +.AP ClientData clientData in The native description of the path value to create. .AP Tcl_Obj *firstPtr in The first of two path values to compare. The value may be converted to \fBpath\fR type. .AP Tcl_Obj *secondPtr in @@ -247,11 +243,11 @@ Name of a procedure to look up in the file's symbol table .AP Tcl_PackageInitProc **proc1Ptr out Filled with the init function for this code. .AP Tcl_PackageInitProc **proc2Ptr out Filled with the safe-init function for this code. -.AP void **clientDataPtr out +.AP ClientData *clientDataPtr out Filled with the clientData value to pass to this code's unload function when it is called. .AP Tcl_LoadHandle *loadHandlePtr out Filled with an abstract token representing the loaded file. .AP Tcl_FSUnloadFileProc **unloadProcPtr out @@ -442,24 +438,20 @@ defined. The appropriate function for the filesystem to which \fIpathPtr\fR belongs will be called. If that filesystem does not implement this function (most virtual filesystems will not, because of OS limitations in dynamically loading binary code), Tcl will attempt to copy the file to a temporary directory and load that temporary file. -.VS 8.6 \fBTcl_FSUnloadFile\fR reverses the operation, asking for the library indicated by the \fIloadHandle\fR to be removed from the process. Note that, unlike with the \fBunload\fR command, this does not give the library any opportunity to clean up. -.VE 8.6 .PP Both the above functions return a standard Tcl completion code. If an error occurs, an error message is left in the \fIinterp\fR's result. .PP -.VS 8.6 The token provided via the variable indicated by \fIloadHandlePtr\fR may be used with \fBTcl_FindSymbol\fR. -.VE 8.6 .PP \fBTcl_FSMatchInDirectory\fR is used by the globbing code to search a directory for all files which match a given pattern. The appropriate function for the filesystem to which \fIpathPtr\fR belongs will be called. .PP @@ -722,11 +714,11 @@ better functions to use for most purposes. .PP \fBTcl_FSGetTranslatedStringPath\fR does the same as \fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL. The string returned is dynamically allocated and owned by the caller, -which must store it or call \fBTcl_Free\fR to ensure it is freed. Again, +which must store it or call \fBckfree\fR to ensure it is freed. Again, \fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually better functions to use for most purposes. .PP \fBTcl_FSNewNativePath\fR performs something like the reverse of the usual obj->path->nativerep conversions. If some code retrieves a path @@ -789,15 +781,14 @@ It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or \fBTCL_PATH_VOLUME_RELATIVE\fR .SS "PORTABLE STAT RESULT API" .PP \fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system heap (which -may be deallocated by being passed to \fBTcl_Free\fR). This allows extensions to +may be deallocated by being passed to \fBckfree\fR). This allows extensions to invoke \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR without being dependent on the size of the buffer. That in turn depends on the flags used to build Tcl. .PP -.VS 8.6 The portable fields of a \fITcl_StatBuf\fR may be read using the following functions, each of which returns the value of the corresponding field listed in the table below. Note that on some platforms there may be other fields in the \fITcl_StatBuf\fR as it is an alias for a suitable system structure, but only the portable ones are made available here. See your system documentation @@ -817,11 +808,10 @@ \fBTcl_GetChangeTimeFromStat\fR st_ctime \fBTcl_GetSizeFromStat\fR st_size \fBTcl_GetBlocksFromStat\fR st_blocks \fBTcl_GetBlockSizeFromStat\fR st_blksize .DE -.VE 8.6 .SH "THE VIRTUAL FILESYSTEM API" .PP A filesystem provides a \fBTcl_Filesystem\fR structure that contains pointers to functions that implement the various operations on a filesystem; these operations are invoked as needed by the generic @@ -839,11 +829,11 @@ .PP \fBTcl_FSUnregister\fR removes the given filesystem structure from the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If the filesystem is not currently registered, \fBTCL_ERROR\fR is returned. .PP -\fBTcl_FSData\fR will return the clientData associated with the given +\fBTcl_FSData\fR will return the ClientData associated with the given filesystem, if that filesystem is registered. Otherwise it will return NULL. .PP \fBTcl_FSMountsChanged\fR is used to inform the Tcl's core that the set of mount points for the given (already registered) filesystem @@ -1016,31 +1006,31 @@ Tcl's internal list of known filesystems. .PP .CS typedef int \fBTcl_FSPathInFilesystemProc\fR( Tcl_Obj *\fIpathPtr\fR, - void **\fIclientDataPtr\fR); + ClientData *\fIclientDataPtr\fR); .CE .SS DUPINTERNALREPPROC .PP This function makes a copy of a path's internal representation, and is called when Tcl needs to duplicate a path value. If NULL, Tcl will simply not copy the internal representation, which may then need to be regenerated later. .PP .CS -typedef void *\fBTcl_FSDupInternalRepProc\fR( - void *\fIclientData\fR); +typedef ClientData \fBTcl_FSDupInternalRepProc\fR( + ClientData \fIclientData\fR); .CE .SS FREEINTERNALREPPROC Free the internal representation. This must be implemented if internal representations need freeing (i.e.\ if some memory is allocated when an internal representation is generated), but may otherwise be NULL. .PP .CS typedef void \fBTcl_FSFreeInternalRepProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .SS INTERNALTONORMALIZEDPROC .PP Function to convert internal representation to a normalized path. Only required if the filesystem creates pure path values with no string/path @@ -1047,11 +1037,11 @@ representation. The return value is a Tcl value whose string representation is the normalized path. .PP .CS typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .SS CREATEINTERNALREPPROC .PP Function to take a path value, and calculate an internal representation for it, and store that native representation in the @@ -1058,11 +1048,11 @@ value. May be NULL if paths have no internal representation, or if the \fITcl_FSPathInFilesystemProc\fR for this filesystem always immediately creates an internal representation for paths it accepts. .PP .CS -typedef void *\fBTcl_FSCreateInternalRepProc\fR( +typedef ClientData \fBTcl_FSCreateInternalRepProc\fR( Tcl_Obj *\fIpathPtr\fR); .CE .SS NORMALIZEPATHPROC .PP Function to normalize a path. Should be implemented for all Index: doc/FindExec.3 ================================================================== --- doc/FindExec.3 +++ doc/FindExec.3 @@ -57,8 +57,9 @@ \fBTcl_FindExecutable\fR. This procedure call is the C API equivalent to the \fBinfo nameofexecutable\fR command. NULL is returned if the internal full path name has not been computed or unknown. .PP -\fBTcl_FindExecutable\fR can not be used in stub-enabled extensions. +\fBTcl_FindExecutable\fR can not be used in stub-enabled extensions. Its symbol +entry in the stub table is deprecated and it will be removed in Tcl 9.0. .SH KEYWORDS binary, executable file Index: doc/GetInt.3 ================================================================== --- doc/GetInt.3 +++ doc/GetInt.3 @@ -62,13 +62,16 @@ if the first such characters are .QW \fB0o\fR then \fIsrc\fR is expected to be in octal form; otherwise, if the first such characters are .QW \fB0b\fR +then \fIsrc\fR is expected to be in binary form; otherwise, +if the first such character is +.QW \fB0\fR then \fIsrc\fR -is expected to be in binary form; otherwise, \fIsrc\fR is -expected to be in decimal form. +is expected to be in octal form; otherwise, \fIsrc\fR +is expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a decimal point .QW \fB.\fR ; Index: doc/GetOpnFl.3 ================================================================== --- doc/GetOpnFl.3 +++ doc/GetOpnFl.3 @@ -26,11 +26,11 @@ Non-zero means the file will be used for writing, zero means it will be used for reading. .AP int checkUsage in If non-zero, then an error will be generated if the file was not opened for the access indicated by \fIwrite\fR. -.AP void **filePtr out +.AP ClientData *filePtr out Points to word in which to store pointer to FILE structure for the file given by \fIchanID\fR. .BE .SH DESCRIPTION Index: doc/GetTime.3 ================================================================== --- doc/GetTime.3 +++ doc/GetTime.3 @@ -25,17 +25,17 @@ .AP Tcl_GetTimeProc getProc in Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS. .AP Tcl_ScaleTimeProc scaleProc in Pointer to handler function for the conversion of time delays in the virtual domain to real-time. -.AP void *clientData in +.AP ClientData clientData in Value passed through to the two handler functions. .AP Tcl_GetTimeProc *getProcPtr out Pointer to place the currently registered get handler function into. .AP Tcl_ScaleTimeProc *scaleProcPtr out Pointer to place the currently registered scale handler function into. -.AP void **clientDataPtr out +.AP ClientData *clientDataPtr out Pointer to place the currently registered pass-through value into. .BE .SH DESCRIPTION .PP The \fBTcl_GetTime\fR function retrieves the current time as a @@ -81,14 +81,14 @@ The signatures of the handler functions are as follows: .PP .CS typedef void \fBTcl_GetTimeProc\fR( Tcl_Time *\fItimebuf\fR, - void *\fIclientData\fR); + ClientData \fIclientData\fR); typedef void \fBTcl_ScaleTimeProc\fR( Tcl_Time *\fItimebuf\fR, - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fItimebuf\fR fields contain the time to manipulate, and the \fIclientData\fR fields contain a pointer supplied at the time the handler functions were registered. Index: doc/Hash.3 ================================================================== --- doc/Hash.3 +++ doc/Hash.3 @@ -28,11 +28,11 @@ \fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR) .sp Tcl_HashEntry * \fBTcl_FindHashEntry\fR(\fItablePtr, key\fR) .sp -void * +ClientData \fBTcl_GetHashValue\fR(\fIentryPtr\fR) .sp \fBTcl_SetHashValue\fR(\fIentryPtr, value\fR) .sp void * @@ -64,12 +64,13 @@ .AP int *newPtr out The word at \fI*newPtr\fR is set to 1 if a new entry was created and 0 if there was already an entry for \fIkey\fR. .AP Tcl_HashEntry *entryPtr in Pointer to hash table entry. -.AP void *value in -New value to assign to hash table entry. +.AP ClientData value in +New value to assign to hash table entry. Need not have type +ClientData, but must fit in same space as ClientData. .AP Tcl_HashSearch *searchPtr in Pointer to record to use to keep track of progress in enumerating all the entries in a hash table. .BE .SH DESCRIPTION @@ -183,10 +184,15 @@ except that it does not create a new entry if the key doesn't exist; instead, it returns NULL as result. .PP \fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to read and write an entry's value, respectively. +Values are stored and retrieved as type +.QW ClientData , +which is +large enough to hold a pointer value. On almost all machines this is +large enough to hold an integer value too. .PP \fBTcl_GetHashKey\fR returns the key for a given hash table entry, either as a pointer to a string, a one-word .PQ "char *" key, or @@ -221,11 +227,11 @@ \fBTcl_HashStats\fR returns a dynamically-allocated string with overall information about a hash table, such as the number of entries it contains, the number of buckets in its hash array, and the utilization of the buckets. It is the caller's responsibility to free the result string -by passing it to \fBTcl_Free\fR. +by passing it to \fBckfree\fR. .PP The header file \fBtcl.h\fR defines the actual data structures used to implement hash tables. This is necessary so that clients can allocate Tcl_HashTable structures and so that macros can be used to read and write Index: doc/InitStubs.3 ================================================================== --- doc/InitStubs.3 +++ doc/InitStubs.3 @@ -61,13 +61,13 @@ .IP 2) 5 Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard -Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms, -the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the -library name is \fItclstub90.lib\fR. +Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms, +the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the +library name is \fItclstub86.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link with the Tk stubs libraries. See the \fBTk_InitStubs\fR page for more information. ADDED doc/InitSubSyst.3 Index: doc/InitSubSyst.3 ================================================================== --- /dev/null +++ doc/InitSubSyst.3 @@ -0,0 +1,31 @@ +'\" +'\" Copyright (c) 2018 Tcl Core Team +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH Tcl_InitSubsystems 3 8.7 Tcl "Tcl Library Procedures" +.BS +.SH NAME +Tcl_InitSubsystems \- initialize the Tcl library. +.SH SYNOPSIS +.nf +\fB#include \fR +.sp +void +\fBTcl_InitSubsystems\fR(\fIvoid\fR) +.SH DESCRIPTION +.PP +The \fBTcl_InitSubsystems\fR procedure initializes the Tcl +library. This procedure is typically invoked as the very +first thing in the application's main program. +.PP +\fBTcl_InitSubsystems\fR is very similar in use to +\fBTcl_FindExecutable\fR. It can be used when Tcl is +used as utility library, no other encodings than utf8, +iso8859-1 or unicode are used, and no interest exists in the +value of \fBinfo nameofexecutable\fR. The system encoding will not +be extracted from the environment, but falls back to iso8859-1. +.SH KEYWORDS +binary, executable file Index: doc/Interp.3 ================================================================== --- doc/Interp.3 +++ doc/Interp.3 @@ -3,119 +3,39 @@ '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures" +.TH Tcl_Interp 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_Interp \- client-visible fields of interpreter structures .SH SYNOPSIS .nf \fB#include \fR .sp typedef struct { - char *\fIresult\fR; - Tcl_FreeProc *\fIfreeProc\fR; - int \fIerrorLine\fR; + char *\fIresult\fR; /* NO LONGER AVAILABLE */ + Tcl_FreeProc *\fIfreeProc\fR; /* NO LONGER AVAILABLE */ + int \fIerrorLine\fR; /* NO LONGER AVAILABLE */ } \fBTcl_Interp\fR; typedef void \fBTcl_FreeProc\fR( char *\fIblockPtr\fR); .BE .SH DESCRIPTION .PP -The \fBTcl_CreateInterp\fR procedure returns a pointer to a Tcl_Interp +The \fBTcl_CreateInterp\fR procedure returns a pointer to a \fBTcl_Interp\fR structure. Callers of \fBTcl_CreateInterp\fR should use this pointer as an opaque token, suitable for nothing other than passing back to -other routines in the Tcl interface. Accessing fields directly through -the pointer as described below is no longer supported. The supported -public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR, -\fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead. -.PP -The \fIresult\fR and \fIfreeProc\fR fields are used to return -results or error messages from commands. -This information is returned by command procedures back to \fBTcl_Eval\fR, -and by \fBTcl_Eval\fR back to its callers. -The \fIresult\fR field points to the string that represents the -result or error message, and the \fIfreeProc\fR field tells how -to dispose of the storage for the string when it is not needed anymore. -The easiest way for command procedures to manipulate these -fields is to call procedures like \fBTcl_SetResult\fR -or \fBTcl_AppendResult\fR; they -will hide all the details of managing the fields. -The description below is for those procedures that manipulate the -fields directly. -.PP -Whenever a command procedure returns, it must ensure -that the \fIresult\fR field of its interpreter points to the string -being returned by the command. -The \fIresult\fR field must always point to a valid string. -If a command wishes to return no result then \fIinterp->result\fR -should point to an empty string. -Normally, results are assumed to be statically allocated, -which means that the contents will not change before the next time -\fBTcl_Eval\fR is called or some other command procedure is invoked. -In this case, the \fIfreeProc\fR field must be zero. -Alternatively, a command procedure may dynamically -allocate its return value (e.g. using \fBTcl_Alloc\fR) -and store a pointer to it in \fIinterp->result\fR. -In this case, the command procedure must also set \fIinterp->freeProc\fR -to the address of a procedure that can free the value, or \fBTCL_DYNAMIC\fR -if the storage was allocated directly by Tcl or by a call to -\fBTcl_Alloc\fR. -If \fIinterp->freeProc\fR is non-zero, then Tcl will call \fIfreeProc\fR -to free the space pointed to by \fIinterp->result\fR before it -invokes the next command. -If a client procedure overwrites \fIinterp->result\fR when -\fIinterp->freeProc\fR is non-zero, then it is responsible for calling -\fIfreeProc\fR to free the old \fIinterp->result\fR (the \fBTcl_FreeResult\fR -macro should be used for this purpose). -.PP -\fIFreeProc\fR should have arguments and result that match the -\fBTcl_FreeProc\fR declaration above: it receives a single -argument which is a pointer to the result value to free. -In most applications \fBTCL_DYNAMIC\fR is the only non-zero value ever -used for \fIfreeProc\fR. -However, an application may store a different procedure address -in \fIfreeProc\fR in order to use an alternate memory allocator -or in order to do other cleanup when the result memory is freed. -.PP -As part of processing each command, \fBTcl_Eval\fR initializes -\fIinterp->result\fR -and \fIinterp->freeProc\fR just before calling the command procedure for -the command. The \fIfreeProc\fR field will be initialized to zero, -and \fIinterp->result\fR will point to an empty string. Commands that -do not return any value can simply leave the fields alone. -Furthermore, the empty string pointed to by \fIresult\fR is actually -part of an array of approximately 200 characters. -If a command wishes to return a short string, it can simply copy -it to the area pointed to by \fIinterp->result\fR. Or, it can use -the sprintf procedure to generate a short result string at the location -pointed to by \fIinterp->result\fR. -.PP -It is a general convention in Tcl-based applications that the result -of an interpreter is normally in the initialized state described -in the previous paragraph. -Procedures that manipulate an interpreter's result (e.g. by -returning an error) will generally assume that the result -has been initialized when the procedure is called. -If such a procedure is to be called after the result has been -changed, then \fBTcl_ResetResult\fR should be called first to -reset the result to its initialized state. The direct use of -\fIinterp->result\fR is strongly deprecated (see \fBTcl_SetResult\fR). -.PP -The \fIerrorLine\fR -field is valid only after \fBTcl_Eval\fR returns -a \fBTCL_ERROR\fR return code. In this situation the \fIerrorLine\fR -field identifies the line number of the command being executed when -the error occurred. The line numbers are relative to the command -being executed: 1 means the first line of the command passed to -\fBTcl_Eval\fR, 2 means the second line, and so on. -The \fIerrorLine\fR field is typically used in conjunction with -\fBTcl_AddErrorInfo\fR to report information about where an error -occurred. -\fIErrorLine\fR should not normally be modified except by \fBTcl_Eval\fR. +other routines in the Tcl interface from the same thread that called +\fBTcl_CreateInterp\fR. The \fBTcl_Interp\fR struct no longer has any +supported client-visible fields. Supported public routines such as +\fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, +\fBTcl_GetErrorLine\fR must be used instead. +.PP +Any legacy programs and extensions trying to access the fields above +in their source code will need conversion to compile for Tcl 8.7 and later. .SH KEYWORDS -free, initialized, interpreter, malloc, result +interpreter, result Index: doc/Limit.3 ================================================================== --- doc/Limit.3 +++ doc/Limit.3 @@ -81,11 +81,11 @@ the limited interpreter will be permitted to continue to process after the handler returns. Many handlers may be attached to the same interpreter limit; their order of execution is not defined, and they must be identified by \fIhandlerProc\fR and \fIclientData\fR when they are deleted. -.AP void *clientData in +.AP ClientData clientData in Arbitrary pointer-sized word used to pass some context to the \fIhandlerProc\fR function. .AP Tcl_LimitHandlerDeleteProc *deleteProc in Function to call whenever a handler is deleted. May be NULL if the \fIclientData\fR requires no deletion. @@ -160,11 +160,11 @@ the function that will actually be called; it should have the following prototype: .PP .CS typedef void \fBTcl_LimitHandlerProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP The \fIclientData\fR argument to the handler will be whatever is passed to the \fIclientData\fR argument to \fBTcl_LimitAddHandler\fR, @@ -177,11 +177,11 @@ \fBTcl_Free\fR. Otherwise, it should refer to a function with the following prototype: .PP .CS typedef void \fBTcl_LimitHandlerDeleteProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP A limit handler may be deleted using \fBTcl_LimitRemoveHandler\fR; the handler removed will be the first one found (out of the handlers added with \fBTcl_LimitAddHandler\fR) with exactly matching \fItype\fR, Index: doc/LinkVar.3 ================================================================== --- doc/LinkVar.3 +++ doc/LinkVar.3 @@ -57,11 +57,11 @@ .VE "TIP 312" .sp All the above for both functions may be optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl variable read-only. -.AP size_t size in +.AP int size in .VS "TIP 312" The number of elements in the C array. Must be greater than zero. .VE "TIP 312" .BE .SH DESCRIPTION @@ -94,11 +94,11 @@ The C variable, or each element of the C array, is of type \fBint\fR. Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like the empty -string, '+', '-' or the hex/octal/binary prefix) are accepted +string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_UINT\fR . The C variable, or each element of the C array, is of type \fBunsigned int\fR. @@ -105,11 +105,11 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the platform's defined range for the \fBunsigned int\fR type; attempts to write non-integer values (or values outside the range) into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer -representations (like the empty string, '+', '-' or the hex/octal/binary +representations (like the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_CHAR\fR . The C variable, or each element of the C array, is of type \fBchar\fR. @@ -116,11 +116,11 @@ Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the \fBchar\fR datatype; attempts to write non-integer or out-of-range values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like the empty string, '+', '-' or the -hex/octal/binary prefix) are accepted as if they are valid too. +hex/octal/decimal/binary prefix) are accepted as if they are valid too. .RS .PP .VS "TIP 312" If using an array of these, consider using \fBTCL_LINK_CHARS\fR instead. .VE "TIP 312" @@ -139,11 +139,11 @@ Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetIntFromObj\fR and in the platform's defined range for the \fBunsigned char\fR type; attempts to write non-integer values (or values outside the range) into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer -representations (like the empty string, '+', '-' or the hex/octal/binary +representations (like the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .RS .PP .VS "TIP 312" If using an array of these, consider using \fBTCL_LINK_BYTES\fR instead. @@ -164,21 +164,21 @@ Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the \fBshort\fR datatype; attempts to write non-integer or out-of-range values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like the empty string, '+', '-' or the -hex/octal/binary prefix) are accepted as if they are valid too. +hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_USHORT\fR . The C variable, or each element of the C array, is of type \fBunsigned short\fR. Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetIntFromObj\fR and in the platform's defined range for the \fBunsigned short\fR type; attempts to write non-integer values (or values outside the range) into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer -representations (like the empty string, '+', '-' or the hex/octal/binary +representations (like the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_LONG\fR . The C variable, or each element of the C array, is of type \fBlong\fR. @@ -185,31 +185,31 @@ Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write non-integer or out-of-range values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like the empty string, '+', '-' or the -hex/octal/binary prefix) are accepted as if they are valid too. +hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_ULONG\fR . The C variable, or each element of the C array, is of type \fBunsigned long\fR. Any value written into the Tcl variable must have a proper unsigned integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the platform's defined range for the \fBunsigned long\fR type; attempts to write non-integer values (or values outside the range) into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer -representations (like the empty string, '+', '-' or the hex/octal/binary +representations (like the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_DOUBLE\fR . The C variable, or each element of the C array, is of type \fBdouble\fR. Any value written into the Tcl variable must have a proper real form acceptable to \fBTcl_GetDoubleFromObj\fR; attempts to write non-real values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer or real representations (like the -empty string, '.', '+', '-' or the hex/octal/binary prefix) are +empty string, '.', '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_FLOAT\fR . The C variable, or each element of the C array, is of type \fBfloat\fR. @@ -217,11 +217,11 @@ form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the range acceptable for a \fBfloat\fR; attempts to write non-real values (or values outside the range) into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer or real representations (like the empty string, '.', '+', '-' or -the hex/octal/binary prefix) are accepted as if they are valid too. +the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_WIDE_INT\fR . The C variable, or each element of the C array, is of type \fBTcl_WideInt\fR (which is an integer type @@ -228,11 +228,11 @@ at least 64-bits wide on all platforms that can support it.) Any value written into the Tcl variable must have a proper integer form acceptable to \fBTcl_GetWideIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like the empty -string, '+', '-' or the hex/octal/binary prefix) are accepted +string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_WIDE_UINT\fR . The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR @@ -242,11 +242,11 @@ integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be cast to unsigned); .\" FIXME! Use bignums instead. attempts to write non-integer values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like -the empty string, '+', '-' or the hex/octal/binary prefix) are accepted +the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP \fBTCL_LINK_BOOLEAN\fR . The C variable, or each element of the C array, is of type \fBint\fR. @@ -263,11 +263,11 @@ .TP \fBTCL_LINK_STRING\fR . The C variable is of type \fBchar *\fR. If its value is not NULL then it must be a pointer to a string -allocated with \fBTcl_Alloc\fR. +allocated with \fBTcl_Alloc\fR or \fBckalloc\fR. Whenever the Tcl variable is modified the current C string will be freed and new memory will be allocated to hold a copy of the variable's new value. If the C variable contains a NULL pointer then the Tcl variable will read as Index: doc/ListObj.3 ================================================================== --- doc/ListObj.3 +++ doc/ListObj.3 @@ -136,11 +136,13 @@ \fBTcl_NewListObj\fR and \fBTcl_SetListObj\fR create a new value or modify an existing value to hold the \fIobjc\fR elements of the array referenced by \fIobjv\fR where each element is a pointer to a Tcl value. If \fIobjc\fR is less than or equal to zero, -they return an empty value. +they return an empty value. If \fIobjv\fR is NULL, the resulting list +contains 0 elements, with reserved space in an internal representation +for \fIobjc\fR more elements (to avoid its reallocation later). The new value's string representation is left invalid. The two procedures increment the reference counts of the elements in \fIobjc\fR since the list value now refers to them. The new list value returned by \fBTcl_NewListObj\fR has reference count zero. Index: doc/Method.3 ================================================================== --- doc/Method.3 +++ doc/Method.3 @@ -59,11 +59,11 @@ \fBTcl_ObjectContextObject\fR(\fIcontext\fR) .sp int \fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR) .SH ARGUMENTS -.AS void *clientData in +.AS ClientData clientData in .AP Tcl_Interp *interp in/out The interpreter holding the object or class to create or update a method in. .AP Tcl_Object object in The object to create the method in. .AP Tcl_Class class in @@ -81,14 +81,14 @@ and \fBTCL_OO_METHOD_PRIVATE\fR for a private method. .VE TIP500 .AP Tcl_MethodType *methodTypePtr in A description of the type of the method to create, or the type of method to compare against. -.AP void *clientData in +.AP ClientData clientData in A piece of data that is passed to the implementation of the method without interpretation. -.AP void **clientDataPtr out +.AP ClientData *clientDataPtr out A pointer to a variable in which to write the \fIclientData\fR value supplied when the method was created. If NULL, the \fIclientData\fR value will not be retrieved. .AP Tcl_Method method in A reference to a method to query. @@ -211,11 +211,11 @@ .PP Functions matching this signature are called when the method is invoked. .PP .CS typedef int \fBTcl_MethodCallProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, Tcl_ObjectContext \fIobjectContext\fR, int \fIobjc\fR, Tcl_Obj *const *\fIobjv\fR); .CE @@ -232,11 +232,11 @@ Functions matching this signature are used when a method is deleted, whether through a new method being created or because the object or class is deleted. .PP .CS typedef void \fBTcl_MethodDeleteProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or \fBTcl_NewInstanceMethod\fR when the method was created. @@ -246,12 +246,12 @@ class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR). .PP .CS typedef int \fBTcl_CloneProc\fR( Tcl_Interp *\fIinterp\fR, - void *\fIoldClientData\fR, - void **\fInewClientDataPtr\fR); + ClientData \fIoldClientData\fR, + ClientData *\fInewClientDataPtr\fR); .CE .PP The \fIinterp\fR argument gives a place to write an error message when the attempt to clone the object is to fail, in which case the clone procedure must also return TCL_ERROR; it should return TCL_OK otherwise. Index: doc/NRE.3 ================================================================== --- doc/NRE.3 +++ doc/NRE.3 @@ -47,11 +47,11 @@ \fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR). .AP Tcl_ObjCmdProc *nreProc in Called instead of \fIproc\fR when a trampoline is already in use. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR and \fIobjProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in/out Called before \fIcmdName\fR is deleted from the interpreter, allowing for command-specific cleanup. May be NULL. @@ -70,14 +70,14 @@ .AP Tcl_Obj *resultPtr out Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if the return code is TCL_OK. .AP Tcl_NRPostProc *postProcPtr in A function to push. -.AP void *data0 in -.AP void *data1 in -.AP void *data2 in -.AP void *data3 in +.AP ClientData data0 in +.AP ClientData data1 in +.AP ClientData data2 in +.AP ClientData data3 in \fIdata0\fR through \fIdata3\fR are four one-word values that will be passed to the function designated by \fIpostProcPtr\fR when it is invoked. .BE .SH DESCRIPTION .PP @@ -128,11 +128,11 @@ \fBTcl_NRPostProc\fR is: .PP .CS typedef int \fBTcl_NRPostProc\fR( - \fBvoid *\fR \fIdata\fR[], + \fBClientData\fR \fIdata\fR[], \fBTcl_Interp\fR *\fIinterp\fR, int \fIresult\fR); .CE .PP \fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR. @@ -144,11 +144,11 @@ stack, to evalute a script: .PP .CS int \fITheCmdOldObjProc\fR( - void *clientData, + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int result; @@ -175,11 +175,11 @@ call \fITheCmdNRObjProc\fR: .PP .CS int \fITheCmdOldObjProc\fR( - void *clientData, + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR, @@ -188,11 +188,11 @@ .CE .PP .CS int \fITheCmdNRObjProc\fR - void *clientData, + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *objPtr; @@ -209,11 +209,11 @@ .CE .PP .CS int \fITheCmdNRPostProc\fR( - void *data[], + ClientData data[], Tcl_Interp *interp, int result) { /* \fIdata[0] .. data[3]\fR are the four words of data * passed to \fBTcl_NRAddCallback\fR */ Index: doc/Namespace.3 ================================================================== --- doc/Namespace.3 +++ doc/Namespace.3 @@ -55,11 +55,11 @@ .AP Tcl_Interp *interp in/out The interpreter in which the namespace exists and where name lookups are performed. Also where error result messages are written. .AP "const char" *name in The name of the namespace or command to be created or accessed. -.AP void *clientData in +.AP ClientData clientData in A context pointer by the creator of the namespace. Not interpreted by Tcl at all. .AP Tcl_NamespaceDeleteProc *deleteProc in A pointer to function to call when the namespace is deleted, or NULL if no such callback is to be performed. @@ -115,11 +115,11 @@ \fBTcl_CreateNamespace\fR creates a new namespace. The \fIdeleteProc\fR will have the following type signature: .PP .CS typedef void \fBTcl_NamespaceDeleteProc\fR( - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP \fBTcl_DeleteNamespace\fR deletes a namespace, calling the \fIdeleteProc\fR defined for the namespace (if any). .PP Index: doc/Notifier.3 ================================================================== --- doc/Notifier.3 +++ doc/Notifier.3 @@ -36,11 +36,11 @@ \fBTcl_GetCurrentThread\fR() .sp void \fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR) .sp -void * +ClientData \fBTcl_InitNotifier\fR() .sp void \fBTcl_FinalizeNotifier\fR(\fIclientData\fR) .sp @@ -76,11 +76,11 @@ Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR. .AP Tcl_EventCheckProc *checkProc in Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for events. Checks to see if any events have occurred and, if so, queues them. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or \fIdeleteProc\fR. .AP "const Tcl_Time" *timePtr in Indicates the maximum amount of time to wait for an event. This is specified as an interval (how long to wait), not an absolute @@ -87,11 +87,11 @@ time (when to wakeup). If the pointer passed to \fBTcl_WaitForEvent\fR is NULL, it means there is no maximum wait time: wait forever if necessary. .AP Tcl_Event *evPtr in An event to add to the event queue. The storage for the event must -have been allocated by the caller using \fBTcl_Alloc\fR. +have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR. .AP Tcl_QueuePosition position in Where to add the new event in the queue: \fBTCL_QUEUE_TAIL\fR, \fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR. .AP Tcl_ThreadId threadId in A unique identifier for a thread. @@ -130,26 +130,21 @@ higher-level software that they have occurred. The procedures \fBTcl_CreateEventSource\fR, \fBTcl_DeleteEventSource\fR, and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and \fBTcl_DeleteEvents\fR are used primarily by event sources. .IP [2] -The event queue: for non-threaded applications, -there is a single queue for the whole application, -containing events that have been detected but not yet serviced. Event -sources place events onto the queue so that they may be processed in -order at appropriate times during the event loop. The event queue -guarantees a fair discipline of event handling, so that no event -source can starve the others. It also allows events to be saved for -servicing at a future time. Threaded applications work in a -similar manner, except that there is a separate event queue for -each thread containing a Tcl interpreter. +The event queue: there is a single queue for each thread containing +a Tcl interpreter, containing events that have been detected but not +yet serviced. Event sources place events onto the queue so that they +may be processed in order at appropriate times during the event loop. +The event queue guarantees a fair discipline of event handling, so that +no event source can starve the others. It also allows events to be +saved for servicing at a future time. \fBTcl_QueueEvent\fR is used (primarily -by event sources) to add events to the event queue and +by event sources) to add events to the current thread's event queue and \fBTcl_DeleteEvents\fR is used to remove events from the queue without -processing them. In a threaded application, \fBTcl_QueueEvent\fR adds -an event to the current thread's queue, and \fBTcl_ThreadQueueEvent\fR -adds an event to a queue in a specific thread. +processing them. .IP [3] The event loop: in order to detect and process events, the application enters a loop that waits for events to occur, places them on the event queue, and then processes them. Most applications will do this by calling the procedure \fBTcl_DoOneEvent\fR, which is described in a @@ -228,11 +223,11 @@ the event source. \fISetupProc\fR should match the following prototype: .PP .CS typedef void \fBTcl_EventSetupProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, int \fIflags\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR argument to \fBTcl_CreateEventSource\fR; it is typically used to @@ -306,11 +301,11 @@ \fBTcl_CreateEventSource\fR. \fICheckProc\fR must match the following prototype: .PP .CS typedef void \fBTcl_EventCheckProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, int \fIflags\fR); .CE .PP The arguments to this procedure are the same as those for \fIsetupProc\fR. \fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited @@ -397,19 +392,15 @@ of window events. .PP When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the event from the event queue and free its storage. Note that the storage for an event must be allocated by -the event source (using \fBTcl_Alloc\fR) +the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR) before calling \fBTcl_QueueEvent\fR, but it will be freed by \fBTcl_ServiceEvent\fR, not by the event source. .PP -Threaded applications work in a -similar manner, except that there is a separate event queue for -each thread containing a Tcl interpreter. -Calling \fBTcl_QueueEvent\fR in a multithreaded application adds -an event to the current thread's queue. +Calling \fBTcl_QueueEvent\fR adds an event to the current thread's queue. To add an event to another thread's queue, use \fBTcl_ThreadQueueEvent\fR. \fBTcl_ThreadQueueEvent\fR accepts as an argument a Tcl_ThreadId argument, which uniquely identifies a thread in a Tcl application. To obtain the Tcl_ThreadId for the current thread, use the \fBTcl_GetCurrentThread\fR procedure. (A thread would then need to pass this identifier to other @@ -426,11 +417,11 @@ queue. \fIProc\fR should match the following prototype: .PP .CS typedef int \fBTcl_EventDeleteProc\fR( Tcl_Event *\fIevPtr\fR, - void *\fIclientData\fR); + ClientData \fIclientData\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR argument to \fBTcl_DeleteEvents\fR; it is typically used to point to private information managed by the event source. The \fIevPtr\fR will @@ -496,12 +487,11 @@ terminate. Under Windows this happens when a WM_QUIT message is received; under Unix it happens when \fBTcl_WaitForEvent\fR would have waited forever because there were no active event sources and the timeout was infinite. .PP -\fBTcl_AlertNotifier\fR is used in multithreaded applications to allow -any thread to +\fBTcl_AlertNotifier\fR is used to allow any thread to .QW "wake up" the notifier to alert it to new events on its queue. \fBTcl_AlertNotifier\fR requires as an argument the notifier handle returned by \fBTcl_InitNotifier\fR. .PP Index: doc/Object.3 ================================================================== --- doc/Object.3 +++ doc/Object.3 @@ -109,13 +109,13 @@ Each Tcl value is represented by a \fBTcl_Obj\fR structure which is defined as follows. .PP .CS typedef struct Tcl_Obj { - size_t \fIrefCount\fR; + int \fIrefCount\fR; char *\fIbytes\fR; - size_t \fIlength\fR; + int \fIlength\fR; const Tcl_ObjType *\fItypePtr\fR; union { long \fIlongValue\fR; double \fIdoubleValue\fR; void *\fIotherValuePtr\fR; Index: doc/ObjectType.3 ================================================================== --- doc/ObjectType.3 +++ doc/ObjectType.3 @@ -83,18 +83,16 @@ and leaves an error message in the result value for \fIinterp\fR unless \fIinterp\fR is NULL. Otherwise, it returns \fBTCL_OK\fR. Passing a NULL \fIinterp\fR allows this procedure to be used as a test whether the conversion can be done (and in fact was done). -.VS 8.5 .PP In many cases, the \fItypePtr->setFromAnyProc\fR routine will set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR, but that is no longer guaranteed. The \fIsetFromAnyProc\fR is free to set the internal representation for \fIobjPtr\fR to make use of another related Tcl_ObjType, if it sees fit. -.VE 8.5 .SH "THE TCL_OBJTYPE STRUCTURE" .PP Extension writers can define new value types by defining four procedures and initializing a Tcl_ObjType structure to describe the type. @@ -184,12 +182,12 @@ and to have no null bytes before that; this allows string representations to be treated as conventional null character-terminated C strings. These restrictions are easily met by using Tcl's internal UTF encoding for the string representation, same as one would do for other Tcl routines accepting string values as arguments. -Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR. -Note that \fIupdateStringProc\fRs must allocate +Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR +or \fBckalloc\fR. Note that \fIupdateStringProc\fRs must allocate enough storage for the string's bytes and the terminating null byte. .PP The \fIupdateStringProc\fR for Tcl's built-in double type, for example, calls Tcl_PrintDouble to write to a buffer of size TCL_DOUBLE_SPACE, then allocates and copies the string representation to just enough Index: doc/OpenFileChnl.3 ================================================================== --- doc/OpenFileChnl.3 +++ doc/OpenFileChnl.3 @@ -51,32 +51,32 @@ \fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR) .sp int \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR) .sp -size_t +int \fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR) .sp -size_t +int \fBTcl_Gets\fR(\fIchannel, lineRead\fR) .sp -size_t +int \fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR) .sp -size_t +int \fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR) .sp -size_t +int \fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR) .sp -size_t +int \fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp -size_t +int \fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR) .sp -size_t +int \fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp int \fBTcl_Eof\fR(\fIchannel\fR) .sp @@ -132,11 +132,11 @@ input of the invoking process; likewise for \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set, then the pipe can redirect stdio handles to override the stdio handles for which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set. If it is set, then such redirections cause an error. -.AP void *handle in +.AP ClientData handle in Operating system specific handle for I/O to a file. For Unix this is a file descriptor, for Windows it is a HANDLE. .AP int readOrWrite in OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate what operations are valid on \fIhandle\fR. @@ -152,20 +152,20 @@ A Tcl channel for input or output. Must have been the return value from a procedure such as \fBTcl_OpenFileChannel\fR. .AP Tcl_Obj *readObjPtr in/out A pointer to a Tcl value in which to store the characters read from the channel. -.AP size_t charsToRead in +.AP int charsToRead in The number of characters to read from the channel. If the channel's encoding is \fBbinary\fR, this is equivalent to the number of bytes to read from the channel. .AP int appendFlag in If non-zero, data read from the channel will be appended to the value. Otherwise, the data will replace the existing contents of the value. .AP char *readBuf out A buffer in which to store the bytes read from the channel. -.AP size_t bytesToRead in +.AP int bytesToRead in The number of bytes to read from the channel. The buffer \fIreadBuf\fR must be large enough to hold this many bytes. .AP Tcl_Obj *lineObjPtr in/out A pointer to a Tcl value in which to store the line read from the channel. The line read will be appended to the current value of the @@ -174,11 +174,11 @@ A pointer to a Tcl dynamic string in which to store the line read from the channel. Must have been initialized by the caller. The line read will be appended to any data already in the dynamic string. .AP "const char" *input in The input to add to a channel buffer. -.AP size_t inputLen in +.AP int inputLen in Length of the input .AP int addAtEnd in Flag indicating whether the input should be added to the end or beginning of the channel buffer. .AP Tcl_Obj *writeObjPtr in @@ -185,11 +185,11 @@ A pointer to a Tcl value whose contents will be output to the channel. .AP "const char" *charBuf in A buffer containing the characters to output to the channel. .AP "const char" *byteBuf in A buffer containing the bytes to output to the channel. -.AP size_t bytesToWrite in +.AP int bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. .AP Tcl_WideInt offset in How far to move the access point in the channel at which the next input or output operation will be applied, measured in bytes from the position @@ -275,11 +275,11 @@ .PP If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR returns NULL and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in -the interpreter's result if \fIinterp\fR is not NULL. +the interpreter's result. \fIinterp\fR cannot be NULL. .PP The newly created channel is not registered in the supplied interpreter; to register it, use \fBTcl_RegisterChannel\fR, described below. If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was previously closed, the act of creating the new channel also assigns it as a Index: doc/OpenTcp.3 ================================================================== --- doc/OpenTcp.3 +++ doc/OpenTcp.3 @@ -48,16 +48,16 @@ .AP int async in If nonzero, the client socket is connected asynchronously to the server. .AP "unsigned int" flags in ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional informations about the socket being created. -.AP void *sock in +.AP ClientData sock in Platform-specific handle for client TCP socket. .AP Tcl_TcpAcceptProc *proc in Pointer to a procedure to invoke each time a new connection is accepted via the socket. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION .PP These functions are convenience procedures for creating @@ -125,11 +125,11 @@ for the new connection and invokes \fIproc\fR with information about the channel. \fIProc\fR must match the following prototype: .PP .CS typedef void \fBTcl_TcpAcceptProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Channel \fIchannel\fR, char *\fIhostName\fR, int \fIport\fR); .CE .PP Index: doc/Panic.3 ================================================================== --- doc/Panic.3 +++ doc/Panic.3 @@ -5,18 +5,21 @@ .TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_Panic, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort +Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort .SH SYNOPSIS .nf \fB#include \fR .sp void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp +void +\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) +.sp void \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp void \fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) @@ -48,17 +51,17 @@ .PP In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted error message to the standard error file of the process, and then calls \fBabort\fR to terminate the process. \fBTcl_Panic\fR does not return. On Windows, when a debugger is running, the formatted error -message is sent to the debugger in stead. If the windows executable +message is sent to the debugger instead. If the windows executable does not have a stderr channel (e.g. \fBwish.exe\fR), then a system dialog box is used to display the panic message. .PP If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR and you want to implicitly use the stderr channel of your -application's C runtime (in stead of the stderr channel of the +application's C runtime (instead of the stderr channel of the C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR with \fBTcl_ConsolePanic\fR as its argument. On platforms which only have one C runtime (almost all platforms except Windows) \fBTcl_ConsolePanic\fR is equivalent to NULL. .PP @@ -81,16 +84,22 @@ .PP The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP +\fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. Its symbol +entry in the stub table is deprecated and it will be removed in Tcl 9.0. +.PP Although the primary callers of \fBTcl_Panic\fR are the procedures of the Tcl library, \fBTcl_Panic\fR is a public function and may be called by any extension or application that wishes to abort the process and have a panic message displayed the same way that panic messages from Tcl will be displayed. .PP -This function can not be used in stub-enabled extensions. +\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of +taking a variable number of arguments it takes an argument list. Interfaces +using argument lists have been found to be nonportable in practice. This +function is deprecated and will be removed in Tcl 9.0. .SH "SEE ALSO" abort(3), printf(3), exec(n), format(n) .SH KEYWORDS abort, fatal, error Index: doc/ParseArgs.3 ================================================================== --- doc/ParseArgs.3 +++ doc/ParseArgs.3 @@ -29,11 +29,11 @@ The array of arguments to be parsed. .AP Tcl_Obj ***remObjv out Pointer to a variable that will hold the array of unprocessed arguments. Should be NULL if no return of unprocessed arguments is required. If \fIobjcPtr\fR is updated to a non-zero value, the array returned through this -must be deallocated using \fBTcl_Free\fR. +must be deallocated using \fBckfree\fR. .BE .SH DESCRIPTION .PP The \fBTcl_ParseArgsObjv\fR function provides a system for parsing argument lists of the form @@ -82,11 +82,11 @@ int \fItype\fR; const char *\fIkeyStr\fR; void *\fIsrcPtr\fR; void *\fIdstPtr\fR; const char *\fIhelpStr\fR; - void *\fIclientData\fR; + ClientData \fIclientData\fR; } \fBTcl_ArgvInfo\fR; .CE .PP The \fIkeyStr\fR field contains the name of the option; by convention, this will normally begin with a @@ -101,11 +101,11 @@ \fItype\fR: .TP \fBTCL_ARGV_CONSTANT\fR . The argument does not take any following value argument. If this argument is -present, the \fIsrcPtr\fR field (casted to \fIint\fR) is copied to the variable +present, the (integer) value of the \fIsrcPtr\fR field is copied to the variable pointed to by the \fIdstPtr\fR field. The \fIclientData\fR field is ignored. .TP \fBTCL_ARGV_END\fR . This value marks the end of all option descriptors in the table. All other @@ -125,11 +125,11 @@ have the following signature: .RS .PP .CS typedef int (\fBTcl_ArgvFuncProc\fR)( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Obj *\fIobjPtr\fR, void *\fIdstPtr\fR); .CE .PP The result is a boolean value indicating whether to consume the following @@ -147,11 +147,11 @@ function will have the following signature: .RS .PP .CS typedef int (\fBTcl_ArgvGenFuncProc\fR)( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIobjc\fR, Tcl_Obj *const *\fIobjv\fR, void *\fIdstPtr\fR); .CE Index: doc/ParseCmd.3 ================================================================== --- doc/ParseCmd.3 +++ doc/ParseCmd.3 @@ -6,11 +6,11 @@ '\" .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include \fR .sp int @@ -31,20 +31,24 @@ const char * \fBTcl_ParseVar\fR(\fIinterp, start, termPtr\fR) .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp +Tcl_Obj * +\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) +.sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR and -\fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR +and \fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating -the script and also is used for error reporting; must not be NULL. +For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, +determines the context for evaluating the +script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in Number of bytes in string to parse, not including any terminating null character. If less than 0 then the script consists of all characters @@ -185,10 +189,20 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. +.PP +\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in +the return convention used: it returns the result in a new Tcl_Obj. +The reference count of the value returned as result has been +incremented, so the caller must +invoke \fBTcl_DecrRefCount\fR when it is finished with the value. +If an error or other exception occurs while evaluating the tokens +(such as a reference to a non-existent variable) then the return value +is NULL and an error message is left in \fIinterp\fR's result. The use +of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR return parse information in two data structures, Tcl_Parse and Tcl_Token: @@ -206,12 +220,12 @@ } \fBTcl_Parse\fR; typedef struct Tcl_Token { int \fItype\fR; const char *\fIstart\fR; - size_t \fIsize\fR; - size_t \fInumComponents\fR; + int \fIsize\fR; + int \fInumComponents\fR; } \fBTcl_Token\fR; .CE .PP The first five fields of a Tcl_Parse structure are filled in only by \fBTcl_ParseCommand\fR. @@ -286,11 +300,11 @@ The token describes a range of literal text that is part of a word. The \fInumComponents\fR field is always 0. .TP \fBTCL_TOKEN_BS\fR . -The token describes a backslash sequence such as \fB\en\fR or \fB\e0xa3\fR. +The token describes a backslash sequence such as \fB\en\fR or \fB\e0xA3\fR. The \fInumComponents\fR field is always 0. .TP \fBTCL_TOKEN_COMMAND\fR . The token describes a command whose result must be substituted into Index: doc/Preserve.3 ================================================================== --- doc/Preserve.3 +++ doc/Preserve.3 @@ -19,11 +19,11 @@ \fBTcl_Release\fR(\fIclientData\fR) .sp \fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR) .SH ARGUMENTS .AS Tcl_FreeProc clientData -.AP void *clientData in +.AP ClientData clientData in Token describing structure to be freed or reallocated. Usually a pointer to memory for structure. .AP Tcl_FreeProc *freeProc in Procedure to invoke to free \fIclientData\fR. .BE @@ -89,11 +89,11 @@ \fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical reasons, but the value is the same. .PP When the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR refers to storage allocated and returned by a prior call to -\fBTcl_Alloc\fR or another function of the Tcl library, +\fBTcl_Alloc\fR, \fBckalloc\fR, or another function of the Tcl library, then the \fIfreeProc\fR argument should be given the special value of \fBTCL_DYNAMIC\fR. .PP This mechanism can be used to solve the problem described above by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around Index: doc/PrintDbl.3 ================================================================== --- doc/PrintDbl.3 +++ doc/PrintDbl.3 @@ -16,11 +16,14 @@ .sp \fBTcl_PrintDouble\fR(\fIinterp, value, dst\fR) .SH ARGUMENTS .AS Tcl_Interp *interp out .AP Tcl_Interp *interp in -This argument is ignored. +Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter +controlled the conversion. As of Tcl 8.0, this argument is ignored and +the conversion is controlled by the \fBtcl_precision\fR variable +that is now shared by all interpreters. .AP double value in Floating-point value to be converted. .AP char *dst out Where to store the string representing \fIvalue\fR. Must have at least \fBTCL_DOUBLE_SPACE\fR characters of storage. @@ -36,11 +39,13 @@ .QW e so that it does not look like an integer. Where \fB%g\fR would generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds .QW .0 . .PP -The result will have the fewest digits needed to +If the \fBtcl_precision\fR value is non-zero, the result will have +precisely that many digits of significance. If the value is zero +(the default), the result will have the fewest digits needed to represent the number in such a way that \fBTcl_NewDoubleObj\fR will generate the same number when presented with the given string. IEEE semantics of rounding to even apply to the conversion. .SH KEYWORDS conversion, double-precision, floating-point, string Index: doc/RecEvalObj.3 ================================================================== --- doc/RecEvalObj.3 +++ doc/RecEvalObj.3 @@ -29,11 +29,11 @@ .BE .SH DESCRIPTION .PP \fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event -on the history list and then execute it using \fBTcl_EvalObjEx\fR. +on the history list and then execute it using \fBTcl_EvalObjEx\fR It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR, as well as a result value containing additional information (a result value or error message) that can be retrieved using \fBTcl_GetObjResult\fR. If you do not want the command recorded on the history list then Index: doc/RegExp.3 ================================================================== --- doc/RegExp.3 +++ doc/RegExp.3 @@ -62,11 +62,11 @@ If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. -.AP size_t index in +.AP int index in Specifies which range is desired: 0 means the range of the entire match, 1 or greater means the range that matched a parenthesized sub-expression. .AP "const char" **startPtr out The address of the first character in the range is stored here, or @@ -78,18 +78,18 @@ OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR, \fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR, \fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR, \fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and \fBTCL_REG_CANMATCH\fR. See below for more information. -.AP size_t offset in +.AP int offset in The character offset into the text where matching should begin. The value of the offset has no impact on \fB^\fR matches. This behavior is controlled by \fIeflags\fR. -.AP size_t nmatches in +.AP int nmatches in The number of matching subexpressions that should be remembered for later use. If this value is 0, then no subexpression match -information will be computed. If the value is TCL_INDEX_NONE, then +information will be computed. If the value is \-1, then all of the matching subexpressions will be remembered. Any other value will be taken as the maximum number of subexpressions to remember. .AP int eflags in OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and @@ -335,13 +335,13 @@ \fIinfoPtr\fR argument contains a pointer to a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpInfo { - size_t \fInsubs\fR; + int \fInsubs\fR; Tcl_RegExpIndices *\fImatches\fR; - size_t \fIextendStart\fR; + long \fIextendStart\fR; } \fBTcl_RegExpInfo\fR; .CE .PP The \fInsubs\fR field contains a count of the number of parenthesized subexpressions within the regular expression. If the \fBTCL_REG_NOSUB\fR @@ -353,12 +353,12 @@ appear in the pattern. Each element is a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpIndices { - size_t \fIstart\fR; - size_t \fIend\fR; + long \fIstart\fR; + long \fIend\fR; } \fBTcl_RegExpIndices\fR; .CE .PP The \fIstart\fR and \fIend\fR values are Unicode character indices relative to the offset location within \fIobjPtr\fR where matching began. Index: doc/SetRecLmt.3 ================================================================== --- doc/SetRecLmt.3 +++ doc/SetRecLmt.3 @@ -27,11 +27,11 @@ .SH DESCRIPTION .PP At any given time Tcl enforces a limit on the number of recursive calls that may be active for \fBTcl_Eval\fR and related procedures -such as \fBTcl_EvalEx\fR. +such as \fBTcl_GlobalEval\fR. Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with an error. By default the recursion limit is 1000. .PP \fBTcl_SetRecursionLimit\fR may be used to change the maximum Index: doc/SetResult.3 ================================================================== --- doc/SetResult.3 +++ doc/SetResult.3 @@ -3,15 +3,15 @@ '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures" +.TH Tcl_SetResult 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result +Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result .SH SYNOPSIS .nf \fB#include \fR .sp \fBTcl_SetObjResult\fR(\fIinterp, objPtr\fR) @@ -24,15 +24,15 @@ const char * \fBTcl_GetStringResult\fR(\fIinterp\fR) .sp \fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR) .sp +\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR) +.sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp -.VS 8.6 -\fBTcl_TransferResult\fR(\fIsourceInterp, result, targetInterp\fR) -.VE 8.6 +\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR) .sp \fBTcl_AppendElement\fR(\fIinterp, element\fR) .sp \fBTcl_FreeResult\fR(\fIinterp\fR) .SH ARGUMENTS @@ -53,22 +53,15 @@ \fBTCL_VOLATILE\fR. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. .AP Tcl_Interp *sourceInterp in -.VS 8.6 -Interpreter that the result and error information should be copied from. -.VE 8.6 +Interpreter that the result and return options should be transferred from. .AP Tcl_Interp *targetInterp in -.VS 8.6 -Interpreter that the result and error information should be copied to. -.VE 8.6 -.AP int result in -.VS 8.6 -If \fBTCL_OK\fR, only copy the result. If \fBTCL_ERROR\fR, copy the error -information as well. -.VE 8.6 +Interpreter that the result and return options should be transferred to. +.AP int code in +Return code value that controls transfer of return options. .BE .SH DESCRIPTION .PP The procedures described here are utilities for manipulating the result value in a Tcl interpreter. @@ -148,16 +141,23 @@ \fIinterp\fR so as to handle backward-compatibility with old-style extensions. Any number of \fIresult\fR arguments may be passed in a single call; the last argument in the list must be a NULL pointer. .PP -.VS 8.6 -\fBTcl_TransferResult\fR moves a result from one interpreter to another, -optionally (dependent on the \fIresult\fR parameter) including the error -information dictionary as well. The interpreters must be in the same thread. -The source interpreter will have its result reset by this operation. -.VE 8.6 +\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that +instead of taking a variable number of arguments it takes an argument list. +Interfaces using argument lists have been found to be nonportable in practice. +This function is deprecated and will be removed in Tcl 9.0. +.PP +\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR +to \fItargetInterp\fR. The two interpreters must have been created in the +same thread. If \fIsourceInterp\fR and \fItargetInterp\fR are the same, +nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result +from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result +in \fIsourceInterp\fR. It also moves the return options dictionary as +controlled by the return code value \fIcode\fR in the same manner +as \fBTcl_GetReturnOptions\fR. .SH "DEPRECATED INTERFACES" .SS "OLD STRING PROCEDURES" .PP Use of the following procedures is deprecated since they manipulate the Tcl result as a string. @@ -190,10 +190,18 @@ It frees up the memory associated with \fIinterp\fR's result. It also sets \fIinterp->freeProc\fR to zero, but does not change \fIinterp->result\fR or clear error state. \fBTcl_FreeResult\fR is most commonly used when a procedure is about to replace one result value with another. +.SS "DIRECT ACCESS TO INTERP->RESULT" +.PP +It used to be legal for programs to +directly read and write \fIinterp->result\fR +to manipulate the interpreter result. The Tcl headers no longer +permit this access. C code still doing this must +be updated to use supported routines \fBTcl_GetObjResult\fR, +\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how the Tcl system is to manage the storage for the \fIresult\fR argument. If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called @@ -230,8 +238,9 @@ .CE .PP When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to the value of \fIresult\fR passed to \fBTcl_SetResult\fR. .SH "SEE ALSO" -Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp +Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp, +Tcl_GetReturnOptions .SH KEYWORDS append, command, element, list, value, result, return value, interpreter Index: doc/SplitList.3 ================================================================== --- doc/SplitList.3 +++ doc/SplitList.3 @@ -18,20 +18,20 @@ \fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR) .sp char * \fBTcl_Merge\fR(\fIargc, argv\fR) .sp -size_t +int \fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR) .sp -size_t +int \fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR) .sp -size_t +int \fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR) .sp -size_t +int \fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr out .AP Tcl_Interp *interp out Interpreter to use for error reporting. If NULL, then no error message @@ -53,11 +53,11 @@ .AP "const char" *src in String that is to become an element of a list. .AP int *flagsPtr in Pointer to word to fill in with information about \fIsrc\fR. The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR. -.AP size_t length in +.AP int length in Number of bytes in string \fIsrc\fR. .AP char *dst in Place to copy converted list element. Must contain enough characters to hold converted string. .AP int flags in Index: doc/StaticPkg.3 ================================================================== --- doc/StaticPkg.3 +++ doc/StaticPkg.3 @@ -63,10 +63,11 @@ the event of an error it should set the interpreter's result to point to an error message. The result or error from the initialization procedure will be returned as the result of the \fBload\fR command that caused the initialization procedure to be invoked. .PP -This function can not be used in stub-enabled extensions. +\fBTcl_StaticPackage\fR can not be used in stub-enabled extensions. Its symbol +entry in the stub table is deprecated and it will be removed in Tcl 9.0. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" load(n), package(n), Tcl_PkgRequire(3) Index: doc/StringObj.3 ================================================================== --- doc/StringObj.3 +++ doc/StringObj.3 @@ -6,11 +6,11 @@ '\" .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings +Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings .SH SYNOPSIS .nf \fB#include \fR .sp Tcl_Obj * @@ -56,10 +56,13 @@ \fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR) .sp void \fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR) .sp +void +\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR) +.sp void \fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR) .sp Tcl_Obj * \fBTcl_Format\fR(\fIinterp, format, objc, objv\fR) @@ -85,33 +88,33 @@ .AS "const Tcl_UniChar" *appendObjPtr in/out .AP "const char" *bytes in Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters -unless \fInumChars\fR is TCL_AUTO_LENGTH. (Applications needing null bytes -should represent them as the two-byte sequence \fI\e700\e600\fR, use +unless \fInumChars\fR is negative. (Applications needing null bytes +should represent them as the two-byte sequence \fI\e300\e200\fR, use \fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if the string is a collection of uninterpreted bytes.) -.AP size_t length in +.AP int length in The number of bytes to copy from \fIbytes\fR when initializing, setting, or appending to a string value. -If TCL_AUTO_LENGTH, all bytes up to the first null are used. +If negative, all bytes up to the first null are used. .AP "const Tcl_UniChar" *unicode in Points to the first byte of an array of Unicode characters used to set or append to a string value. This byte array may contain embedded null characters unless \fInumChars\fR is negative. -.AP size_t numChars in +.AP int numChars in The number of Unicode characters to copy from \fIunicode\fR when initializing, setting, or appending to a string value. -If TCL_AUTO_LENGTH, all characters up to the first null character are used. -.AP size_t index in +If negative, all characters up to the first null character are used. +.AP int index in The index of the Unicode character to return. -.AP size_t first in +.AP int first in The index of the first Unicode character in the Unicode range to be returned as a new value. -.AP size_t last in +.AP int last in The index of the last Unicode character in the Unicode range to be returned as a new value. .AP Tcl_Obj *objPtr in/out Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in @@ -122,11 +125,11 @@ .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. -.AP size_t limit in +.AP int limit in Maximum number of bytes to be appended. .AP "const char" *ellipsis in Suffix to append when the limit leads to string truncation. If NULL is passed then the suffix .QW "..." @@ -135,11 +138,11 @@ Format control string including % conversion specifiers. .AP int objc in The number of elements to format or concatenate. .AP Tcl_Obj *objv[] in The array of values to format or concatenate. -.AP size_t newLength in +.AP int newLength in New length for the string value of \fIobjPtr\fR, not including the final null character. .BE .SH DESCRIPTION .PP @@ -241,10 +244,16 @@ except that it can be passed more than one value to append and each value must be a null-terminated string (i.e. none of the values may contain internal null characters). Any number of \fIstring\fR arguments may be provided, but the last argument must be a NULL pointer to indicate the end of the list. +.PP +\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR +except that instead of taking a variable number of arguments it takes an +argument list. Interfaces using argument lists have been found to be +nonportable in practice. This function is deprecated and will be removed +in Tcl 9.0. .PP \fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR except that it imposes a limit on how many bytes are appended. This can be handy when the string to be appended might be very large, but the value being constructed should not be allowed to grow Index: doc/TCL_MEM_DEBUG.3 ================================================================== --- doc/TCL_MEM_DEBUG.3 +++ doc/TCL_MEM_DEBUG.3 @@ -32,30 +32,30 @@ functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR, and the Tcl \fBmemory\fR command can be used to validate and examine memory usage. .SH "GUARD ZONES" .PP -When memory debugging is enabled, whenever a call to \fBTcl_Alloc\fR is +When memory debugging is enabled, whenever a call to \fBckalloc\fR is made, slightly more memory than requested is allocated so the memory debugging code can keep track of the allocated memory, and eight-byte .QW "guard zones" are placed in front of and behind the space that will be returned to the caller. (The sizes of the guard zones are defined by the C #define \fBLOW_GUARD_SIZE\fR and #define \fBHIGH_GUARD_SIZE\fR in the file \fIgeneric/tclCkalloc.c\fR \(em it can be extended if you suspect large overwrite problems, at some cost in performance.) A known pattern is written into the guard zones and, on -a call to \fBTcl_Free\fR, the guard zones of the space being freed are +a call to \fBckfree\fR, the guard zones of the space being freed are checked to see if either zone has been modified in any way. If one has been, the guard bytes and their new contents are identified, and a .QW "low guard failed" or .QW "high guard failed" message is issued. The .QW "guard failed" message includes the address of the memory packet and -the file name and line number of the code that called \fBTcl_Free\fR. +the file name and line number of the code that called \fBckfree\fR. This allows you to detect the common sorts of one-off problems, where not enough space was allocated to contain the data written, for example. .SH "DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS" .PP @@ -64,17 +64,17 @@ the memory command can help isolate difficult problems. If you suspect (or know) that corruption is occurring before the Tcl interpreter comes up far enough for you to issue commands, you can set \fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl. This will enable memory validation from the first call to -\fBTcl_Alloc\fR, again, at a large performance impact. +\fBckalloc\fR, again, at a large performance impact. .PP If you are desperate and validating memory on every call to -\fBTcl_Alloc\fR and \fBTcl_Free\fR is not enough, you can explicitly call +\fBckalloc\fR and \fBckfree\fR is not enough, you can explicitly call \fBTcl_ValidateAllMemory\fR directly at any point. It takes a \fIchar *\fR and an \fIint\fR which are normally the filename and line number of the caller, but they can actually be anything you want. Remember to remove the calls after you find the problem. .SH "SEE ALSO" -Tcl_Alloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory +ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory .SH KEYWORDS memory, debug Index: doc/TclZlib.3 ================================================================== --- doc/TclZlib.3 +++ doc/TclZlib.3 @@ -86,11 +86,11 @@ .AP "unsigned int" initValue in The initial value for the checksum algorithm. .AP "unsigned char" *bytes in An array of bytes to run the checksum algorithm over, or NULL to get the recommended initial value for the checksum algorithm. -.AP size_t length in +.AP int length in The number of bytes in the array. .AP int mode in What mode to operate the stream in. Should be either \fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or \fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream. @@ -105,13 +105,13 @@ if the currently compressed data must be made available for access using \fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put into a state where the decompressor can recover from on corruption, or \fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any trailer demanded by the format is written. -.AP size_t count in -The maximum number of bytes to get from the stream, or TCL_AUTO_LENGTH to get -all remaining bytes from the stream's buffers. +.AP int count in +The maximum number of bytes to get from the stream, or -1 to get all remaining +bytes from the stream's buffers. .AP Tcl_Obj *compDict in A byte array value that is the compression dictionary to use with the stream. Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this only ever be used with streams that were created with their \fIformat\fR set to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to Index: doc/Tcl_Main.3 ================================================================== --- doc/Tcl_Main.3 +++ doc/Tcl_Main.3 @@ -188,11 +188,11 @@ procedure (if any) returns. In non-interactive mode, after \fBTcl_Main\fR evaluates the startup script, and the main loop procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP -This function can not be used in stub-enabled extensions. +\fBTcl_Main\fR can not be used in stub-enabled extensions. .SH "SEE ALSO" tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3), exit(n), encoding(n) .SH KEYWORDS application-specific initialization, command-line arguments, main program Index: doc/Thread.3 ================================================================== --- doc/Thread.3 +++ doc/Thread.3 @@ -65,11 +65,11 @@ .AP Tcl_ThreadId id in Id of the thread waited upon. .AP Tcl_ThreadCreateProc *proc in This procedure will act as the \fBmain()\fR of the newly created thread. The specified \fIclientData\fR will be its sole argument. -.AP void *clientData in +.AP ClientData clientData in Arbitrary information. Passed as sole argument to the \fIproc\fR. .AP int stackSize in The size of the stack given to the new thread. .AP int flags in Bitmask containing flags allowing the caller to modify behavior of @@ -206,11 +206,11 @@ value and then finishes. .PP .CS static \fBTcl_ThreadCreateType\fR MyThreadImplFunc( - void *clientData) + ClientData clientData) { int i, limit = (int) clientData; for (i=0 ; i\fR .sp -void * +ClientData \fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR .sp int \fBTcl_TraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR .sp @@ -30,13 +30,13 @@ .AP int flags in OR'ed collection of the values \fBTCL_TRACE_RENAME\fR and \fBTCL_TRACE_DELETE\fR. .AP Tcl_CommandTraceProc *proc in Procedure to call when specified operations occur to \fIcmdName\fR. -.AP void *clientData in +.AP ClientData clientData in Arbitrary argument to pass to \fIproc\fR. -.AP void *prevClientData in +.AP ClientData prevClientData in If non-NULL, gives last value returned by \fBTcl_CommandTraceInfo\fR, so this call will return information about next trace. If NULL, this call will return information about first trace. .BE .SH DESCRIPTION @@ -63,20 +63,20 @@ \fIproc\fR will be invoked. It should have arguments and result that match the type \fBTcl_CommandTraceProc\fR: .PP .CS typedef void \fBTcl_CommandTraceProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIoldName\fR, const char *\fInewName\fR, int \fIflags\fR); .CE .PP The \fIclientData\fR and \fIinterp\fR parameters will have the same values as those passed to \fBTcl_TraceCommand\fR when the trace was -created. \fIclientData\fR typically points to an application-specific +created. \fIClientData\fR typically points to an application-specific data structure that describes what to do when \fIproc\fR is invoked. \fIOldName\fR gives the name of the command being renamed, and \fInewName\fR gives the name that the command is being renamed to (or NULL when the command is being deleted.) \fIFlags\fR is an OR'ed combination of bits potentially providing Index: doc/TraceVar.3 ================================================================== --- doc/TraceVar.3 +++ doc/TraceVar.3 @@ -3,11 +3,11 @@ '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures" +.TH Tcl_TraceVar 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable .SH SYNOPSIS @@ -22,17 +22,17 @@ .sp \fBTcl_UntraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR .sp \fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR .sp -void * +ClientData \fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR .sp -void * +ClientData \fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR .SH ARGUMENTS -.AS void *prevClientData +.AS Tcl_VarTraceProc prevClientData .AP Tcl_Interp *interp in Interpreter containing variable. .AP "const char" *varName in Name of variable. May refer to a scalar variable, to an array variable with no index, or to an array variable @@ -44,19 +44,19 @@ \fBTCL_TRACE_RESULT_DYNAMIC\fR and \fBTCL_TRACE_RESULT_OBJECT\fR. Not all flags are used by all procedures. See below for more information. .AP Tcl_VarTraceProc *proc in Procedure to invoke whenever one of the traced operations occurs. -.AP void *clientData in +.AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .AP "const char" *name1 in Name of scalar or array variable (without array index). .AP "const char" *name2 in For a trace on an element of an array, gives the index of the element. For traces on scalar variables or on whole arrays, is NULL. -.AP void *prevClientData in +.AP ClientData prevClientData in If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or \fBTcl_VarTraceInfo2\fR, so this call will return information about next trace. If NULL, this call will return information about first trace. .BE @@ -93,11 +93,11 @@ .TP \fBTCL_TRACE_UNSETS\fR Invoke \fIproc\fR whenever the variable is unset. A variable may be unset either explicitly by an \fBunset\fR command, or implicitly when a procedure returns (its local variables are -automatically unset) or when the interpreter is deleted (all +automatically unset) or when the interpreter or namespace is deleted (all variables are automatically unset). .TP \fBTCL_TRACE_ARRAY\fR Invoke \fIproc\fR whenever the array command is invoked. This gives the trace procedure a chance to update the array before @@ -105,11 +105,11 @@ before an array set, but that will trigger write traces. .TP \fBTCL_TRACE_RESULT_DYNAMIC\fR The result of invoking the \fIproc\fR is a dynamically allocated string that will be released by the Tcl library via a call to -\fBTcl_Free\fR. Must not be specified at the same time as +\fBckfree\fR. Must not be specified at the same time as \fBTCL_TRACE_RESULT_OBJECT\fR. .TP \fBTCL_TRACE_RESULT_OBJECT\fR The result of invoking the \fIproc\fR is a Tcl_Obj* (cast to a char*) with a reference count of at least one. The ownership of that @@ -122,21 +122,21 @@ It should have arguments and result that match the type \fBTcl_VarTraceProc\fR: .PP .CS typedef char *\fBTcl_VarTraceProc\fR( - void *\fIclientData\fR, + ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, char *\fIname1\fR, char *\fIname2\fR, int \fIflags\fR); .CE .PP The \fIclientData\fR and \fIinterp\fR parameters will have the same values as those passed to \fBTcl_TraceVar\fR when the trace was created. -\fIclientData\fR typically points to an application-specific +\fIClientData\fR typically points to an application-specific data structure that describes what to do when \fIproc\fR is invoked. \fIName1\fR and \fIname2\fR give the name of the traced variable in the normal two-part form (see the description of \fBTcl_TraceVar2\fR below for details). @@ -158,14 +158,10 @@ attempts to access the variable. The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about to be destroyed; this information may be useful to \fIproc\fR so that it can clean up its own internal data structures (see the section \fBTCL_TRACE_DESTROYED\fR below for more details). -Lastly, the bit \fBTCL_INTERP_DESTROYED\fR will be set if the entire -interpreter is being destroyed. -When this bit is set, \fIproc\fR must be especially careful in -the things it does (see the section \fBTCL_INTERP_DESTROYED\fR below). The trace procedure's return value should normally be NULL; see \fBERROR RETURNS\fR below for information on other possibilities. .PP \fBTcl_UntraceVar\fR may be used to remove a trace. If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR @@ -310,11 +306,11 @@ error occurred. The return value must be a pointer to a static character string containing an error message, unless (\fIexactly\fR one of) the \fBTCL_TRACE_RESULT_DYNAMIC\fR and \fBTCL_TRACE_RESULT_OBJECT\fR flags is set, which specify that the result is -either a dynamic string (to be released with \fBTcl_Free\fR) or a +either a dynamic string (to be released with \fBckfree\fR) or a Tcl_Obj* (cast to char* and to be released with \fBTcl_DecrRefCount\fR) containing the error message. If a trace procedure returns an error, no further traces are invoked for the access and the traced access aborts with the given message. @@ -328,10 +324,19 @@ write tracing. During unset traces, the return value is ignored and all relevant trace procedures will always be invoked. .SH "RESTRICTIONS" .PP +Because operations on variables may take place as part of the deletion +of the interp that contains them, \fIproc\fR must be careful about checking +what the \fIinterp\fR parameter can be used to do. +The routine \fBTcl_InterpDeleted\fR is an important tool for this. +When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able +to invoke any scripts in \fIinterp\fR. You may encounter old code using +a deprecated flag value \fBTCL_INTERP_DESTROYED\fR to signal this +condition, but any supported code should be converted to stop using it. +.PP A trace procedure can be called at any time, even when there are partially formed results stored in the interpreter. If the trace procedure does anything that could damage this result (such as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR and related routines to save and restore the original state of @@ -352,29 +357,13 @@ of the deletion. Traces on a variable are always removed whenever the variable is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for a whole-array trace invoked when only a single element of an array is unset. -.SH "TCL_INTERP_DESTROYED" -.PP -When an interpreter is destroyed, unset traces are called for -all of its variables. -The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR -argument passed to the trace procedures. -Trace procedures must be extremely careful in what they do if -the \fBTCL_INTERP_DESTROYED\fR bit is set. -It is not safe for the procedures to invoke any Tcl procedures -on the interpreter, since its state is partially deleted. -All that trace procedures should do under these circumstances is -to clean up and free their own internal data structures. .SH BUGS .PP -Tcl does not do any error checking to prevent trace procedures -from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR -set. -.PP Array traces are not yet integrated with the Tcl \fBinfo exists\fR command, nor is there Tcl-level access to array traces. .SH "SEE ALSO" trace(n) .SH KEYWORDS clientData, trace, variable Index: doc/Utf.3 ================================================================== --- doc/Utf.3 +++ doc/Utf.3 @@ -6,11 +6,11 @@ '\" .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings +Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include \fR .sp typedef ... \fBTcl_UniChar\fR; @@ -19,33 +19,51 @@ \fBTcl_UniCharToUtf\fR(\fIch, buf\fR) .sp int \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp +int +\fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR) +.sp +int +\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR) +.sp char * \fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR) .sp +char * +\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR) +.sp +char * +\fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR) +.sp Tcl_UniChar * \fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR) .sp +unsigned short * +\fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR) +.sp +wchar_t * +\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR) +.sp int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int -\fBTcl_UniCharNcmp\fR(\fIucs, uct, uniLength\fR) +\fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR) .sp int -\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, uniLength\fR) +\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, numChars\fR) .sp int \fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR) .sp int -\fBTcl_UtfNcmp\fR(\fIcs, ct, length\fR) +\fBTcl_UtfNcmp\fR(\fIcs, ct, numChars\fR) .sp int -\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR) +\fBTcl_UtfNcasecmp\fR(\fIcs, ct, numChars\fR) .sp int \fBTcl_UtfCharComplete\fR(\fIsrc, length\fR) .sp int @@ -67,21 +85,25 @@ \fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR) .sp const char * \fBTcl_UtfAtIndex\fR(\fIsrc, index\fR) .sp -size_t +int \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out .AP char *buf out Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most -\fBTCL_UTF_MAX\fR bytes are stored in the buffer. +4 bytes are stored in the buffer. .AP int ch in The Unicode character to be converted or examined. .AP Tcl_UniChar *chPtr out Filled with the Tcl_UniChar represented by the head of the UTF-8 string. +.AP unsigned short *uPtr out +Filled with the utf-16 represented by the head of the UTF-8 string. +.AP wchar_t *wPtr out +Filled with the wchar_t represented by the head of the UTF-8 string. .AP "const char" *src in Pointer to a UTF-8 string. .AP "const char" *cs in Pointer to a UTF-8 string. .AP "const char" *ct in @@ -92,42 +114,53 @@ A null-terminated Unicode string. .AP "const Tcl_UniChar" *uct in A null-terminated Unicode string. .AP "const Tcl_UniChar" *uniPattern in A null-terminated Unicode string. -.AP size_t length in +.AP "const unsigned short" *uStr in +A null-terminated UTF-16 string. +.AP "const wchar_t" *wStr in +A null-terminated wchar_t string. +.AP "const unsigned short" *utf16s in +A null-terminated utf-16 string. +.AP "const unsigned short" *utf16t in +A null-terminated utf-16 string. +.AP "const unsigned short" *utf16Pattern in +A null-terminated utf-16 string. +.AP int length in The length of the UTF-8 string in bytes (not UTF-8 characters). If -TCL_AUTO_LENGTH, all bytes up to the first null byte are used. -.AP size_t uniLength in +negative, all bytes up to the first null byte are used. +.AP int uniLength in The length of the Unicode string in characters. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. +.AP "unsigned long" numChars in +The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. -.AP size_t index in +.AP int index in The index of a character (not byte) in the UTF-8 string. .AP int *readPtr out If non-NULL, filled with the number of bytes in the backslash sequence, including the backslash character. .AP char *dst out Buffer in which the bytes represented by the backslash sequence are stored. -At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer. +At most 4 bytes are stored in the buffer. .AP int nocase in Specifies whether the match should be done case-sensitive (0) or case-insensitive (1). .BE .SH DESCRIPTION .PP -These routines convert between UTF-8 strings and Unicode characters. An -Unicode character represented as an unsigned, fixed-size -quantity. A UTF-8 character is a Unicode character represented as -a varying-length sequence of up to \fBTCL_UTF_MAX\fR bytes. A multibyte UTF-8 -sequence consists of a lead byte followed by some number of trail bytes. +These routines convert between UTF-8 strings and Unicode/Utf-16 characters. +A UTF-8 character is a Unicode character represented as a varying-length +sequence of up to \fB4\fR bytes. A multibyte UTF-8 sequence +consists of a lead byte followed by some number of trail bytes. .PP -\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to -represent one Unicode character in the UTF-8 representation. +\fBTCL_UTF_MAX\fR is the maximum number of bytes that \fBTcl_UtfToUniChar\fR +can consume in a single call. .PP \fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string in starting at \fIbuf\fR. The return value is the number of bytes stored in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then the return value will be 1 and a single byte in the range 0xF0 - 0xF4 @@ -143,16 +176,15 @@ is known to be null-terminated, this will not happen. If the input is a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR and returns 1. If the input is otherwise not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first -byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and -0x00ff and return 1. +byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and +0x00FF and return 1. .PP \fBTcl_UniCharToUtfDString\fR converts the given Unicode string to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR. -You must specify \fIuniLength\fR, the length of the given Unicode string. The return value is a pointer to the UTF-8 representation of the Unicode string. Storage for the return value is appended to the end of the \fBTcl_DString\fR. .PP \fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode, @@ -171,11 +203,11 @@ the number of Unicode characters (not bytes) in that string. .PP \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accept two null-terminated Unicode strings and the number of characters -to compare. Both strings are assumed to be at least \fIuniLength\fR characters +to compare. Both strings are assumed to be at least \fInumChars\fR characters long. \fBTcl_UniCharNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal to, or less than the second string respectively. \fBTcl_UniCharNcasecmp\fR is the Unicode case insensitive version. @@ -185,11 +217,11 @@ a Unicode pattern, and a boolean value specifying whether the match should be case sensitive and returns whether the string matches the pattern. .PP \fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It accepts two null-terminated UTF-8 strings and the number of characters -to compare. (Both strings are assumed to be at least \fIlength\fR +to compare. (Both strings are assumed to be at least \fInumChars\fR characters long.) \fBTcl_UtfNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal to, or less than the second string respectively. @@ -225,34 +257,52 @@ \fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the string. The caller must not ask for the next character after the last character in the string if the string is not terminated by a null character. .PP -Given \fIsrc\fR, a pointer to some location in a UTF-8 string (or to a -null byte immediately following such a string), \fBTcl_UtfPrev\fR -returns a pointer to the closest preceding byte that starts a UTF-8 -character. -This function will not back up to a position before \fIstart\fR, -the start of the UTF-8 string. If \fIsrc\fR was already at \fIstart\fR, the -return value will be \fIstart\fR. +\fBTcl_UtfPrev\fR is used to step backward through but not beyond the +UTF-8 string that begins at \fIstart\fR. If the UTF-8 string is made +up entirely of complete and well-formed characters, and \fIsrc\fR points +to the lead byte of one of those characters (or to the location one byte +past the end of the string), then repeated calls of \fBTcl_UtfPrev\fR will +return pointers to the lead bytes of each character in the string, one +character at a time, terminating when it returns \fIstart\fR. +.PP +When the conditions of completeness and well-formedness may not be satisfied, +a more precise description of the function of \fBTcl_UtfPrev\fR is necessary. +It always returns a pointer greater than or equal to \fIstart\fR; that is, +always a pointer to a location in the string. It always returns a pointer to +a byte that begins a character when scanning for characters beginning +from \fIstart\fR. When \fIsrc\fR is greater than \fIstart\fR, it +always returns a pointer less than \fIsrc\fR and greater than or +equal to (\fIsrc\fR - \fBTCL_UTF_MAX\fR). The character that begins +at the returned pointer is the first one that either includes the +byte \fIsrc[-1]\fR, or might include it if the right trail bytes are +present at \fIsrc\fR and greater. \fBTcl_UtfPrev\fR never reads the +byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte +\fIsrc[-\fBTCL_UTF_MAX\fI-1]\fR. .PP \fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the -Pascal Ord() function. It returns the Tcl_UniChar represented at the +Pascal Ord() function. It returns the Unicode character represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR -characters. +characters. If a negative \fIindex\fR is given or \fIindex\fR points +to the second half of a surrogate pair, it returns -1. .PP \fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. This is equivalent to calling -\fBTcl_UtfNext\fR \fIindex\fR times. If \fIindex\fR is TCL_INDEX_NONE, -the return pointer points to the first character in the source string. +\fBTcl_UtfToUniChar\fR \fIindex\fR times, except if that would return +a pointer to the second byte of a valid 4-byte UTF-8 sequence, in which +case, \fBTcl_UtfToUniChar\fR will be called once more to find the end +of the sequence. If a negative \fIindex\fR is given, the returned pointer +points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl commands. It parses a backslash sequence and stores the properly formed UTF-8 character represented by the backslash sequence in the output -buffer \fIdst\fR. At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer. +buffer \fIdst\fR. At most 4 bytes are stored in the buffer. \fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number of bytes in the backslash sequence, including the backslash character. The return value is the number of bytes stored in the output buffer. .PP See the \fBTcl\fR manual entry for information on the valid backslash Index: doc/binary.n ================================================================== --- doc/binary.n +++ doc/binary.n @@ -71,11 +71,13 @@ .PP During decoding, the following options are supported: .TP \fB\-strict\fR . -Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them. +Instructs the decoder to throw an error if it encounters any characters +that are not strictly part of the encoding itself. Otherwise it ignores them. +RFC 2045 calls for base64 decoders to be non-strict. .RE .TP \fBhex\fR . The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal @@ -85,11 +87,12 @@ No options are supported during encoding. During decoding, the following options are supported: .TP \fB\-strict\fR . -Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them. +Instructs the decoder to throw an error if it encounters whitespace characters. +Otherwise it ignores them. .RE .TP \fBuuencode\fR . The \fBuuencode\fR binary encoding used to be common for transfer of data @@ -100,27 +103,31 @@ During encoding, the following options are supported (though changing them may produce files that other implementations of decoders cannot process): .TP \fB\-maxlen \fIlength\fR . -Indicates that the output should be split into lines of no more than -\fIlength\fR characters. By default, lines are split every 61 characters, and -this must be in the range 3 to 85 due to limitations in the encoding. +Indicates the maximum number of characters to produce for each encoded line. +The valid range is 5 to 85. Line lengths outside that range cannot be +accommodated by the encoding format. The default value is 61. .TP \fB\-wrapchar \fIcharacter\fR . -Indicates that, when lines are split because of the \fB\-maxlen\fR option, -\fIcharacter\fR should be used to separate lines. By default, this is a -newline character, -.QW \en . +Indicates the character(s) to use to mark the end of each encoded line. +Acceptable values are a sequence of zero or more characters from the +set { \\x09 (TAB), \\x0B (VT), \\x0C (FF), \\x0D (CR) } followed +by zero or one newline \\x0A (LF). Any other values are rejected because +they would generate encoded text that could not be decoded. The default value +is a single newline. .PP During decoding, the following options are supported: .TP \fB\-strict\fR . -Instructs the decoder to throw an error if it encounters unexpected whitespace -characters. Otherwise it ignores them. +Instructs the decoder to throw an error if it encounters anything +outside of the standard encoding format. Without this option, the +decoder tolerates some deviations, mostly to forgive reflows of lines +between the encoder and decoder. .PP Note that neither the encoder nor the decoder handle the header and footer of the uuencode format. .RE .SH "BINARY FORMAT" ADDED doc/case.n Index: doc/case.n ================================================================== --- /dev/null +++ doc/case.n @@ -0,0 +1,60 @@ +'\" +'\" Copyright (c) 1993 The Regents of the University of California. +'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH case n 7.0 Tcl "Tcl Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +case \- Evaluate one of several scripts, depending on a given value +.SH SYNOPSIS +\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...? +.sp +\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?} +.BE + +.SH DESCRIPTION +.PP +\fINote: the \fBcase\fI command is obsolete and is supported only +for backward compatibility. At some point in the future it may be +removed entirely. You should use the \fBswitch\fI command instead.\fR +.PP +The \fBcase\fR command matches \fIstring\fR against each of +the \fIpatList\fR arguments in order. +Each \fIpatList\fR argument is a list of one or +more patterns. If any of these patterns matches \fIstring\fR then +\fBcase\fR evaluates the following \fIbody\fR argument +by passing it recursively to the Tcl interpreter and returns the result +of that evaluation. +Each \fIpatList\fR argument consists of a single +pattern or list of patterns. Each pattern may contain any of the wild-cards +described under \fBstring match\fR. If a \fIpatList\fR +argument is \fBdefault\fR, the corresponding body will be evaluated +if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument +matches \fIstring\fR and no default is given, then the \fBcase\fR +command returns an empty string. +.PP +Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments. +The first uses a separate argument for each of the patterns and commands; +this form is convenient if substitutions are desired on some of the +patterns or commands. +The second form places all of the patterns and commands together into +a single argument; the argument must have proper list structure, with +the elements of the list being the patterns and commands. +The second form makes it easy to construct multi-line case commands, +since the braces around the whole list make it unnecessary to include a +backslash at the end of each line. +Since the \fIpatList\fR arguments are in braces in the second form, +no command or variable substitutions are performed on them; this makes +the behavior of the second form different than the first form in some +cases. + +.SH "SEE ALSO" +switch(n) + +.SH KEYWORDS +case, match, regular expression Index: doc/catch.n ================================================================== --- doc/catch.n +++ doc/catch.n @@ -54,22 +54,19 @@ .PP When the return code from evaluation of \fIscript\fR is \fBTCL_ERROR\fR, four additional entries are defined in the dictionary of return options stored in \fIoptionsVarName\fR: \fB\-errorinfo\fR, \fB\-errorcode\fR, \fB\-errorline\fR, and -.VS 8.6 \fB\-errorstack\fR. -.VE 8.6 The value of the \fB\-errorinfo\fR entry is a formatted stack trace containing more information about the context in which the error happened. The formatted stack trace is meant to be read by a person. The value of the \fB\-errorcode\fR entry is additional information about the error stored as a list. The \fB\-errorcode\fR value is meant to be further processed by programs, and may not be particularly readable by people. The value of the \fB\-errorline\fR entry is an integer indicating which line of \fIscript\fR was being evaluated when the error occurred. -.VS 8.6 The value of the \fB\-errorstack\fR entry is an even-sized list made of token-parameter pairs accumulated while unwinding the stack. The token may be .QW \fBCALL\fR , in which case the parameter is a list made of the proc name and arguments at @@ -85,18 +82,15 @@ it contains the true (substituted) values passed to the functions, instead of the static text of the calling sites, and .IP [3] it is coarser-grained, with only one element per stack frame (like procs; no separate elements for \fBforeach\fR constructs for example). -.VE 8.6 .PP The values of the \fB\-errorinfo\fR and \fB\-errorcode\fR entries of the most recent error are also available as values of the global variables \fB::errorInfo\fR and \fB::errorCode\fR respectively. -.VS 8.6 The value of the \fB\-errorstack\fR entry surfaces as \fBinfo errorstack\fR. -.VE 8.6 .PP Tcl packages may provide commands that set other entries in the dictionary of return options, and the \fBreturn\fR command may be used by scripts to set return options in addition to those defined above. Index: doc/cd.n ================================================================== --- doc/cd.n +++ doc/cd.n @@ -20,11 +20,11 @@ home directory (as specified in the HOME environment variable) if \fIdirName\fR is not given. Returns an empty string. Note that the current working directory is a per-process resource; the \fBcd\fR command changes the working directory for all interpreters -and (in a threaded environment) all threads. +and all threads. .SH EXAMPLES .PP Change to the home directory of the user \fBfred\fR: .PP .CS Index: doc/chan.n ================================================================== --- doc/chan.n +++ doc/chan.n @@ -33,21 +33,19 @@ .TP \fBchan close \fIchannelId\fR ?\fIdirection\fR? . Close and destroy the channel called \fIchannelId\fR. Note that this deletes all existing file-events registered on the channel. -.VS 8.6 If the \fIdirection\fR argument (which must be \fBread\fR or \fBwrite\fR or any unique abbreviation of them) is present, the channel will only be half-closed, so that it can go from being read-write to write-only or read-only respectively. If a read-only channel is closed for reading, it is the same as if the channel is fully closed, and respectively similar for write-only channels. Without the \fIdirection\fR argument, the channel is closed for both reading and writing (but only if those directions are currently open). It is an error to close a read-only channel for writing, or a write-only channel for reading. -.VE 8.6 .RS .PP As part of closing the channel, all buffered output is flushed to the channel's output device (only if the channel is ceasing to be writable), any buffered input is discarded (only if the channel is ceasing to be readable), @@ -81,16 +79,14 @@ The command returns an empty string, and may generate an error if an error occurs while flushing output. If a command in a command pipeline created with \fBopen\fR returns an error, \fBchan close\fR generates an error (similar to the \fBexec\fR command.) .PP -.VS 8.6 Note that half-closes of sockets and command pipelines can have important side effects because they result in a shutdown() or close() of the underlying system resource, which can change how other processes or systems respond to the Tcl program. -.VE 8.6 .RE .TP \fBchan configure \fIchannelId\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... . Query or set the configuration options of the channel named @@ -538,11 +534,10 @@ a potential denial-of-service attack where a hostile user crafts an extremely long line that exceeds the available memory to buffer it). Returns -1 if the channel was not opened for the mode in question. .TP \fBchan pipe\fR -.VS 8.6 Creates a standalone pipe whose read- and write-side channels are returned as a 2-element list, the first element being the read side and the second the write side. Can be useful e.g. to redirect separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do this, spawn with "2>@" or @@ -559,20 +554,17 @@ differences, but the details of what exactly gets written when are not. This is most likely to show up when using pipelines for testing; care should be taken to ensure that deadlocks do not occur and that potential short reads are allowed for. .RE -.VE 8.6 .TP \fBchan pop \fIchannelId\fR -.VS 8.6 Removes the topmost transformation from the channel \fIchannelId\fR, if there is any. If there are no transformations added to \fIchannelId\fR, this is equivalent to \fBchan close\fR of that channel. The result is normally the empty string, but can be an error in some situations (i.e. where the underlying system stream is closed and that results in an error). -.VE 8.6 .TP \fBchan postevent \fIchannelId eventSpec\fR . This subcommand is used by command handlers specified with \fBchan create\fR. It notifies the channel represented by the handle @@ -607,20 +599,18 @@ a trusted interpreter. \fBChan event\fR handlers are \fIalways\fR executed in the interpreter that set them up. .RE .TP \fBchan push \fIchannelId cmdPrefix\fR -.VS 8.6 Adds a new transformation on top of the channel \fIchannelId\fR. The \fIcmdPrefix\fR argument describes a list of one or more words which represent a handler that will be used to implement the transformation. The command prefix must provide the API described in the \fBtranschan\fR manual page. The result of this subcommand is a handle to the transformation. Note that it is important to make sure that the transformation is capable of supporting the channel mode that it is used with or this can make the channel neither readable nor writable. -.VE 8.6 .TP \fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR . Writes \fIstring\fR to the channel named \fIchannelId\fR followed by a newline character. A trailing newline character is written unless the Index: doc/close.n ================================================================== --- doc/close.n +++ doc/close.n @@ -47,20 +47,17 @@ \fBclose\fR, the cleanup actions described above occur. See the \fBinterp\fR command for a description of channel sharing. .PP Channels are automatically closed when an interpreter is destroyed and when the process exits. -.VS 8.6 From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT, which when set and not equal to "0" restores the previous behavior. -.VE 8.6 .PP The command returns an empty string, and may generate an error if an error occurs while flushing output. If a command in a command pipeline created with \fBopen\fR returns an error, \fBclose\fR generates an error (similar to the \fBexec\fR command.) .PP -.VS 8.6 The two-argument form is a .QW "half-close" : given a bidirectional channel like a socket or command pipeline and a (possibly abbreviated) direction, it closes only the sub-stream going in that direction. This means a shutdown() on a @@ -78,11 +75,10 @@ shoulders of the last close or half-close, which is thus allowed to report an abnormal exit error. .PP Currently only sockets and command pipelines support half-close. A future extension will allow reflected and stacked channels to do so. -.VE 8.6 .SH EXAMPLE .PP This illustrates how you can use Tcl to ensure that files get closed even when errors happen by combining \fBcatch\fR, \fBclose\fR and \fBreturn\fR: Index: doc/coroutine.n ================================================================== --- doc/coroutine.n +++ doc/coroutine.n @@ -7,11 +7,11 @@ .TH coroutine n 8.6 Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -coroutine, yield, yieldto \- Create and produce values from coroutines +coroutine, yield, yieldto, coroinject, coroprobe \- Create and produce values from coroutines .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? \fByieldto\fR \fIcommand\fR ?\fIarg...\fR? Index: doc/dde.n ================================================================== --- doc/dde.n +++ doc/dde.n @@ -15,15 +15,13 @@ .sp \fBpackage require dde 1.4\fR .sp \fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR? .sp -.VS 8.6 \fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR .sp \fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR -.VE 8.6 .sp \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR .sp \fBdde services \fIservice topic\fR .sp @@ -80,17 +78,15 @@ Typically, the application treats the \fIdata\fR field as a script, and the script is run in the application. The \fB\-async\fR option requests asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. -.VS 8.6 Without the \fB\-binary\fR option all data will be sent in unicode. For dde clients which don't implement the CF_UNICODE clipboard format, this will automatically be translated to the system encoding. You can use the \fB\-binary\fR option in combination with the result of \fBencoding convertto\fR to send data in any other encoding. -.VE 8.6 .TP \fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR . \fBdde poke\fR passes the \fIdata\fR to the server indicated by \fIservice\fR using the \fItopic\fR and \fIitem\fR specified. Typically, @@ -97,17 +93,15 @@ \fIservice\fR is the name of an application. \fItopic\fR is application specific but can be a command to the server or the name of a file to work on. The \fIitem\fR is also application specific and is often not used, but it must always be non-null. The \fIdata\fR field is given to the remote application. -.VS 8.6 Without the \fB\-binary\fR option all data will be sent in unicode. For dde clients which don't implement the CF_UNICODE clipboard format, this will automatically be translated to the system encoding. You can use the \fB\-binary\fR option in combination with the result of \fBencoding convertto\fR to send data in any other encoding. -.VE 8.6 .TP \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR . \fBdde request\fR is typically used to get the value of something; the value of a cell in Microsoft Excel or the text of a selection in Index: doc/define.n ================================================================== --- doc/define.n +++ doc/define.n @@ -586,11 +586,11 @@ for reading from slots is via \fBinfo class\fR and \fBinfo object\fR). .VE TIP516 .SH EXAMPLES This example demonstrates how to use both forms of the \fBoo::define\fR and \fBoo::objdefine\fR commands (they work in the same way), as well as -illustrating four of their subcommands. +illustrating four of the subcommands of them. .PP .CS oo::class create c c create o \fBoo::define\fR c \fBmethod\fR foo {} { Index: doc/dict.n ================================================================== --- doc/dict.n +++ doc/dict.n @@ -52,14 +52,12 @@ contains just those key/value pairs that match the specified filter type (which may be abbreviated.) Supported filter types are: .RS .TP \fBdict filter \fIdictionaryValue \fBkey\fR ?\fIglobPattern ...\fR? -.VS 8.6 The key rule only matches those key/value pairs whose keys match any of the given patterns (in the style of \fBstring match\fR.) -.VE 8.6 .TP \fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR . The script rule tests for matching by assigning the key to the \fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating @@ -72,14 +70,12 @@ dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false result. The key/value pairs are tested in the order in which the keys were inserted into the dictionary. .TP \fBdict filter \fIdictionaryValue \fBvalue \fR?\fIglobPattern ...\fR? -.VS 8.6 The value rule only matches those key/value pairs whose values match any of the given patterns (in the style of \fBstring match\fR.) -.VE 8.6 .RE .TP \fBdict for {\fIkeyVariable valueVariable\fB} \fIdictionaryValue body\fR . This command takes three arguments, the first a two-element list of Index: doc/exec.n ================================================================== --- doc/exec.n +++ doc/exec.n @@ -336,11 +336,10 @@ # Some other error; regenerate it to let caller handle return -options $options -level 0 $results } } .CE -.VS 8.6 .PP This is more easily written using the \fBtry\fR command, as that makes it simpler to trap specific types of errors. This is done using code like this: .PP @@ -350,11 +349,10 @@ set status 0 } trap CHILDSTATUS {results options} { set status [lindex [dict get $options -errorcode] 2] } .CE -.VE 8.6 .SS "WORKING WITH QUOTED ARGUMENTS" .PP When translating a command from a Unix shell invocation, care should be taken over the fact that single quote characters have no special significance to Tcl. Thus: Index: doc/expr.n ================================================================== --- doc/expr.n +++ doc/expr.n @@ -15,11 +15,11 @@ .SH SYNOPSIS \fBexpr \fIarg \fR?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP -Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates +The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates that expression, returning its value. The operators permitted in an expression include a subset of the operators permitted in C expressions. For those operators common to both Tcl and C, Tcl applies the same meaning and precedence as the corresponding C operators. @@ -44,24 +44,10 @@ .SS OPERANDS .PP An expression consists of a combination of operands, operators, parentheses and commas, possibly with whitespace between any of these elements, which is ignored. -An integer operand may be specified in decimal (the normal case, the optional -first two characters are \fB0d\fR), binary -(the first two characters are \fB0b\fR), octal -(the first two characters are \fB0o\fR), or hexadecimal -(the first two characters are \fB0x\fR) form. -A floating-point number may be specified in any of several -common decimal formats, and may use the decimal point \fB.\fR, -\fBe\fR or \fBE\fR for scientific notation, and -the sign characters \fB+\fR and \fB\-\fR. The -following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16. -The strings \fBInf\fR -and \fBNaN\fR, in any combination of case, are also recognized as floating point -values. An operand that doesn't have a numeric interpretation must be quoted -with either braces or with double quotes. .PP An operand may be specified in any of the following ways: .IP [1] As a numeric value, either integer or floating-point. .IP [2] @@ -99,10 +85,53 @@ \fBexpr\fR 3.1 + $a \fI6.1\fR \fBexpr\fR 2 + "$a.$b" \fI5.6\fR \fBexpr\fR 4*[llength "6 2"] \fI8\fR \fBexpr\fR {{word one} < "word $a"} \fI0\fR .CE +.PP +\fBInteger value\fR +.PP +An integer operand may be specified in decimal (the normal case, the optional +first two characters are \fB0d\fR), binary +(the first two characters are \fB0b\fR), octal +(the first two characters are \fB0o\fR), or hexadecimal +(the first two characters are \fB0x\fR) form. For +compatibility with older Tcl releases, an operand that begins with \fB0\fR is +interpreted as an octal integer even if the second character is not \fBo\fR. +.PP +\fBFloating-point value\fR +.PP +A floating-point number may be specified in any of several +common decimal formats, and may use the decimal point \fB.\fR, +\fBe\fR or \fBE\fR for scientific notation, and +the sign characters \fB+\fR and \fB\-\fR. The +following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16. +The strings \fBInf\fR +and \fBNaN\fR, in any combination of case, are also recognized as floating point +values. An operand that doesn't have a numeric interpretation must be quoted +with either braces or with double quotes. +.PP +\fBBoolean value\fR +.PP +A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR, +or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR. +.PP +\fBDigit Separator\fR +.PP +Digits in any numeric value may be separated with one or more underscore +characters, "\fB_\fR", to improve readability. These separators may only +appear between digits. The separator may not appear at the start of a +numeric value, between the leading 0 and radix specifier, or at the +end of a numeric value. Here are some examples: +.PP +.CS +.ta 9c +\fBexpr\fR 100_000_000 \fI100000000\fR +\fBexpr\fR 0xffff_ffff \fI4294967295\fR +\fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR +.CE +.PP .SS OPERATORS .PP For operators having both a numeric mode and a string mode, the numeric mode is chosen when all operands have a numeric interpretation. The integer interpretation of an operand is preferred over the floating-point @@ -470,15 +499,15 @@ .CE .SH "SEE ALSO" array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n), string(n), Tcl(n), while(n) .SH KEYWORDS -arithmetic, boolean, compare, expression, fuzzy comparison +arithmetic, boolean, compare, expression, fuzzy comparison, integer value .SH COPYRIGHT .nf Copyright \(co 1993 The Regents of the University of California. Copyright \(co 1994-2000 Sun Microsystems Incorporated. Copyright \(co 2005 by Kevin B. Kenny . All rights reserved. .fi '\" Local Variables: '\" mode: nroff '\" End: Index: doc/file.n ================================================================== --- doc/file.n +++ doc/file.n @@ -463,11 +463,10 @@ .RE .VE "8.7, TIP 431" .TP \fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR? '\" TIP #210 -.VS 8.6 Creates a temporary file and returns a read-write channel opened on that file. If the \fInameVar\fR is given, it specifies a variable that the name of the temporary file will be written into; if absent, Tcl will attempt to arrange for the temporary file to be deleted once it is no longer required. If the \fItemplate\fR is present, it specifies parts of the template of the filename @@ -478,11 +477,10 @@ .PP Note that temporary files are \fIonly\fR ever created on the native filesystem. As such, they can be relied upon to be used with operating-system native APIs and external programs that require a filename. .RE -.VE 8.6 .TP \fBfile type \fIname\fR . Returns a string giving the type of file \fIname\fR, which will be one of \fBfile\fR, \fBdirectory\fR, \fBcharacterSpecial\fR, \fBblockSpecial\fR, Index: doc/interp.n ================================================================== --- doc/interp.n +++ doc/interp.n @@ -152,11 +152,10 @@ present, it is a list of words (of minimum length one) that describes what to set the interpreter's background exception handler to. See the \fBBACKGROUND EXCEPTION HANDLING\fR section for more details. .TP \fBinterp\fR \fBcancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR? -.VS 8.6 Cancels the script being evaluated in the interpreter identified by \fIpath\fR. Without the \fB\-unwind\fR switch the evaluation stack for the interpreter is unwound until an enclosing catch command is found or there are no further invocations of the interpreter left on the call stack. With the \fB\-unwind\fR switch the evaluation stack for the @@ -165,11 +164,10 @@ call stack. The \fB\-\|\-\fR switch can be used to mark the end of switches; it may be needed if \fIpath\fR is an unusual value such as \fB\-safe\fR. If \fIresult\fR is present, it will be used as the error message string; otherwise, a default error message string will be used. -.VE 8.6 .TP \fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? . Creates a slave interpreter identified by \fIpath\fR and a new command, called a \fIslave command\fR. The name of the slave command is the last Index: doc/lappend.n ================================================================== --- doc/lappend.n +++ doc/lappend.n @@ -47,12 +47,13 @@ 1 2 % \fBlappend\fR var 3 4 5 1 2 3 4 5 .CE .SH "SEE ALSO" -list(n), lindex(n), linsert(n), llength(n), lset(n), -lsort(n), lrange(n) +list(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS append, element, list, variable .\" Local variables: .\" mode: nroff .\" fill-column: 78 Index: doc/lassign.n ================================================================== --- doc/lassign.n +++ doc/lassign.n @@ -50,11 +50,13 @@ .PP .CS set ::argv [\fBlassign\fR $::argv argumentToReadOff] .CE .SH "SEE ALSO" -lindex(n), list(n), lrange(n), lset(n), set(n) +list(n), lappend(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS assign, element, list, multiple, set, variable '\"Local Variables: '\"mode: nroff '\"End: Index: doc/library.n ================================================================== --- doc/library.n +++ doc/library.n @@ -297,22 +297,17 @@ .TP \fBtcl_nonwordchars\fR This variable contains a regular expression that is used by routines like \fBtcl_endOfWord\fR to identify whether a character is part of a word or not. If the pattern matches a character, the character is -considered to be a non-word character. On Windows platforms, spaces, -tabs, and newlines are considered non-word characters. Under Unix, -everything but numbers, letters and underscores are considered -non-word characters. +considered to be a non-word character. The default is "\\W". .TP \fBtcl_wordchars\fR This variable contains a regular expression that is used by routines like \fBtcl_endOfWord\fR to identify whether a character is part of a word or not. If the pattern matches a character, the character is -considered to be a word character. On Windows platforms, words are -comprised of any character that is not a space, tab, or newline. Under -Unix, words are comprised of numbers, letters or underscores. +considered to be a word character. The default is "\\w". .SH "SEE ALSO" env(n), info(n), re_syntax(n) .SH KEYWORDS auto-exec, auto-load, library, unknown, word, whitespace '\"Local Variables: Index: doc/lindex.n ================================================================== --- doc/lindex.n +++ doc/lindex.n @@ -113,12 +113,13 @@ set idx 3 \fBlindex\fR {a b c d e f} $idx+2 \fI\(-> f\fR .CE .SH "SEE ALSO" -list(n), lappend(n), linsert(n), llength(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n), +list(n), lappend(n), lassign(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, index, list '\"Local Variables: '\"mode: nroff Index: doc/linsert.n ================================================================== --- doc/linsert.n +++ doc/linsert.n @@ -43,12 +43,13 @@ set newList [\fBlinsert\fR $midList end-1 lazy] # The old lists still exist though... set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy] .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), llength(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n), +list(n), lappend(n), lassign(n), lindex(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, insert, list '\" Local Variables: '\" mode: nroff Index: doc/list.n ================================================================== --- doc/list.n +++ doc/list.n @@ -44,13 +44,13 @@ .PP .CS \fBa b c d e f {g h}\fR .CE .SH "SEE ALSO" -lappend(n), lindex(n), linsert(n), llength(n), lrange(n), -lrepeat(n), -lreplace(n), lsearch(n), lset(n), lsort(n) +lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, quoting '\"Local Variables: '\"mode: nroff '\"End: Index: doc/llength.n ================================================================== --- doc/llength.n +++ doc/llength.n @@ -47,12 +47,13 @@ .CS % set var { }; puts "[string length $var],[\fBllength\fR $var]" 1,0 .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), lsearch(n), -lset(n), lsort(n), lrange(n), lreplace(n) +list(n), lappend(n), lassign(n), lindex(n), linsert(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, length '\" Local Variables: '\" mode: nroff '\" fill-column: 78 Index: doc/lmap.n ================================================================== --- doc/lmap.n +++ doc/lmap.n @@ -75,11 +75,14 @@ [isGood $x] ? $x : [break] }}] # The value of prefix is "8 7 6 5 4" .CE .SH "SEE ALSO" -break(n), continue(n), for(n), foreach(n), while(n) +break(n), continue(n), for(n), foreach(n), while(n), +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS foreach, iteration, list, loop, map '\" Local Variables: '\" mode: nroff '\" End: Index: doc/load.n ================================================================== --- doc/load.n +++ doc/load.n @@ -152,11 +152,11 @@ The following is a minimal extension: .PP .CS #include #include -static int fooCmd(void *clientData, +static int fooCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { printf("called with %d arguments\en", objc); return TCL_OK; } int Foo_Init(Tcl_Interp *interp) { Index: doc/lpop.n ================================================================== --- doc/lpop.n +++ doc/lpop.n @@ -84,12 +84,13 @@ .CS \fBlpop\fR x 1 1 0 \fI\(-> {{a b} {c d}} {{e f} h}\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lsort(n), lrange(n), lreplace(n), lset(n) +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, index, list, remove, pop, stack, queue '\"Local Variables: '\"mode: nroff Index: doc/lrange.n ================================================================== --- doc/lrange.n +++ doc/lrange.n @@ -69,12 +69,13 @@ elements to % \fBlrange\fR $var 1 1 {elements to} .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lremove(n), lreplace(n), lsort(n), +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, list, range, sublist '\" Local Variables: '\" mode: nroff Index: doc/lremove.n ================================================================== --- doc/lremove.n +++ doc/lremove.n @@ -44,11 +44,13 @@ .CS % \fBlremove\fR {a b c d e} 2 end-2 a b d e .CE .SH "SEE ALSO" -list(n), lrange(n), lsearch(n), lsearch(n) +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, remove .\" Local variables: .\" mode: nroff .\" fill-column: 78 Index: doc/lrepeat.n ================================================================== --- doc/lrepeat.n +++ doc/lrepeat.n @@ -30,11 +30,13 @@ \fI\(-> a b c a b c a b c\fR \fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c \fI\(-> {a a} b c {a a} b c {a a} b c\fR .CE .SH "SEE ALSO" -list(n), lappend(n), linsert(n), llength(n), lset(n) +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, index, list '\" Local Variables: '\" mode: nroff '\" fill-column: 78 Index: doc/lreplace.n ================================================================== --- doc/lreplace.n +++ doc/lreplace.n @@ -93,12 +93,13 @@ % set var [\fBlreplace\fR $var 12345 end+2 f g h i] a b c d e f g h i .CE .VE TIP505 .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lrange(n), lremove(n), lsort(n), +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), +lreverse(n), lsearch(n), lset(n), lsort(n), string(n) .SH KEYWORDS element, list, replace .\" Local variables: .\" mode: nroff Index: doc/lreverse.n ================================================================== --- doc/lreverse.n +++ doc/lreverse.n @@ -23,12 +23,13 @@ \fI\(-> c b a a\fR \fBlreverse\fR {a b {c d} e f} \fI\(-> f e {c d} b a\fR .CE .SH "SEE ALSO" -list(n), lsearch(n), lsort(n) - +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lsearch(n), lset(n), lsort(n) .SH KEYWORDS element, list, reverse '\" Local Variables: '\" mode: nroff '\" End: Index: doc/lsearch.n ================================================================== --- doc/lsearch.n +++ doc/lsearch.n @@ -132,19 +132,17 @@ . The list elements are sorted in increasing order. This option is only meaningful when used with \fB\-sorted\fR. .TP \fB\-bisect\fR -.VS 8.6 Inexact search when the list elements are in sorted order. For an increasing list the last index where the element is less than or equal to the pattern is returned. For a decreasing list the last index where the element is greater than or equal to the pattern is returned. If the pattern is before the first element or the list is empty, -1 is returned. This option implies \fB\-sorted\fR and cannot be used with either \fB\-all\fR or \fB\-not\fR. -.VE 8.6 .SS "NESTED LIST OPTIONS" .PP These options are used to search lists of lists. They may be used with any other options. .TP @@ -227,14 +225,16 @@ .CS \fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc* \fI\(-> {a abc b bcd}\fR .CE .SH "SEE ALSO" -foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), -lset(n), lsort(n), lrange(n), lreplace(n), +foreach(n), +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lset(n), lsort(n), string(n) .SH KEYWORDS binary search, linear search, list, match, pattern, regular expression, search, string '\" Local Variables: '\" mode: nroff '\" End: Index: doc/lset.n ================================================================== --- doc/lset.n +++ doc/lset.n @@ -134,12 +134,13 @@ \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR \fBlset\fR x {1 1 0} j \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lsort(n), lrange(n), lreplace(n), +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lsort(n) string(n) .SH KEYWORDS element, index, list, replace, set '\"Local Variables: '\"mode: nroff Index: doc/lsort.n ================================================================== --- doc/lsort.n +++ doc/lsort.n @@ -219,11 +219,10 @@ {a 5} {b 4} { c 3} {d 2} {e 1} \fI%\fR \fBlsort\fR -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}} {e 1} {d 2} { c 3} {b 4} {a 5} .CE .PP -.VS 8.6 Sorting a dictionary: .PP .CS \fI%\fR set d [dict create c d a b h i f g c e] c e a b h i f g @@ -237,11 +236,10 @@ \fI%\fR # Note the first index value is relative to the group \fI%\fR \fBlsort\fR \-stride 3 \-index {0 1} \e {{Bob Smith} 25 Audi {Jane Doe} 40 Ford} {{Jane Doe} 40 Ford {Bob Smith} 25 Audi} .CE -.VE 8.6 .PP Stripping duplicate values using sorting: .PP .CS \fI%\fR \fBlsort\fR -unique {a b c a b c a b c} @@ -264,12 +262,13 @@ \fI%\fR \fBlsort\fR -command compare \e {{3 apple} {0x2 carrot} {1 dingo} {2 banana}} {1 dingo} {2 banana} {0x2 carrot} {3 apple} .CE .SH "SEE ALSO" -list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), -lset(n), lrange(n), lreplace(n) +list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n), +lreverse(n), lsearch(n), lset(n) .SH KEYWORDS element, list, order, sort '\" Local Variables: '\" mode: nroff '\" End: Index: doc/mathfunc.n ================================================================== --- doc/mathfunc.n +++ doc/mathfunc.n @@ -122,11 +122,14 @@ .DE .PP In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define -new commands in the \fBtcl::mathfunc\fR namespace. +new commands in the \fBtcl::mathfunc\fR namespace. In addition, an +obsolete interface named \fBTcl_CreateMathFunc\fR() is available to +extensions that are written in C. The latter interface is not recommended +for new implementations. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR . Returns the absolute value of \fIarg\fR. \fIArg\fR may be either Index: doc/memory.n ================================================================== --- doc/memory.n +++ doc/memory.n @@ -23,22 +23,22 @@ . Write a list of all currently allocated memory to the specified \fIfile\fR. .TP \fBmemory break_on_malloc\fR \fIcount\fR . -After the \fIcount\fR allocations have been performed, \fBTcl_Alloc\fR +After the \fIcount\fR allocations have been performed, \fBckalloc\fR outputs a message to this effect and that it is now attempting to enter the C debugger. Tcl will then issue a \fISIGINT\fR signal against itself. If you are running Tcl under a C debugger, it should then enter the debugger command mode. .TP \fBmemory info\fR . Returns a report containing the total allocations and frees since Tcl began, the current packets allocated (the current -number of calls to \fBTcl_Alloc\fR not met by a corresponding call -to \fBTcl_Free\fR), the current bytes allocated, and the maximum number +number of calls to \fBckalloc\fR not met by a corresponding call +to \fBckfree\fR), the current bytes allocated, and the maximum number of packets and bytes allocated. .TP \fBmemory init \fR[\fBon\fR|\fBoff\fR] . Turn on or off the pre-initialization of all allocated memory @@ -57,38 +57,38 @@ during the finalization of Tcl's memory subsystem. Useful for checking that memory is properly cleaned up during process exit. .TP \fBmemory tag\fR \fIstring\fR . -Each packet of memory allocated by \fBTcl_Alloc\fR can have associated +Each packet of memory allocated by \fBckalloc\fR can have associated with it a string-valued tag. In the lists of allocated memory generated by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet is printed along with other information about the packet. The \fBmemory tag\fR command sets the tag value for subsequent calls -to \fBTcl_Alloc\fR to be \fIstring\fR. +to \fBckalloc\fR to be \fIstring\fR. .TP \fBmemory trace \fR[\fBon\fR|\fBoff\fR] . Turns memory tracing on or off. When memory tracing is on, every call -to \fBTcl_Alloc\fR causes a line of trace information to be written to -\fIstderr\fR, consisting of the word \fITcl_Alloc\fR, followed by the +to \fBckalloc\fR causes a line of trace information to be written to +\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the address returned, the amount of memory allocated, and the C filename and line number of the code performing the allocation. For example: .RS .PP .CS -Tcl_Alloc 40e478 98 tclProc.c 1406 +ckalloc 40e478 98 tclProc.c 1406 .CE .PP -Calls to \fBTcl_Free\fR are traced in the same manner. +Calls to \fBckfree\fR are traced in the same manner. .RE .TP \fBmemory trace_on_at_malloc\fR \fIcount\fR . -Enable memory tracing after \fIcount\fR \fBTcl_Alloc\fRs have been performed. +Enable memory tracing after \fIcount\fR \fBckalloc\fRs have been performed. For example, if you enter \fBmemory trace_on_at_malloc 100\fR, -after the 100th call to \fBTcl_Alloc\fR, memory trace information will begin +after the 100th call to \fBckalloc\fR, memory trace information will begin being displayed for all allocations and frees. Since there can be a lot of memory activity before a problem occurs, judicious use of this option can reduce the slowdown caused by tracing (and the amount of trace information produced), if you can identify a number of allocations that occur before the problem sets in. The current number of memory allocations that have @@ -95,21 +95,21 @@ occurred since Tcl started is printed on a guard zone failure. .TP \fBmemory validate \fR[\fBon\fR|\fBoff\fR] . Turns memory validation on or off. When memory validation is enabled, -on every call to \fBTcl_Alloc\fR or \fBTcl_Free\fR, the guard zones are +on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are checked for every piece of memory currently in existence that was -allocated by \fBTcl_Alloc\fR. This has a large performance impact and +allocated by \fBckalloc\fR. This has a large performance impact and should only be used when overwrite problems are strongly suspected. The advantage of enabling memory validation is that a guard zone -overwrite can be detected on the first call to \fBTcl_Alloc\fR or -\fBTcl_Free\fR after the overwrite occurred, rather than when the +overwrite can be detected on the first call to \fBckalloc\fR or +\fBckfree\fR after the overwrite occurred, rather than when the specific memory with the overwritten guard zone(s) is freed, which may occur long after the overwrite occurred. .SH "SEE ALSO" -Tcl_Alloc, Tcl_Free, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG +ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG .SH KEYWORDS memory, debug '\"Local Variables: '\"mode: nroff '\"End: Index: doc/my.n ================================================================== --- doc/my.n +++ doc/my.n @@ -21,11 +21,11 @@ .SH DESCRIPTION .PP The \fBmy\fR command is used to allow methods of objects to invoke methods of the object (or its class), .VS TIP478 -and he \fBmyclass\fR command is used to allow methods of objects to invoke +and the \fBmyclass\fR command is used to allow methods of objects to invoke methods of the current class of the object \fIas an object\fR. .VE TIP478 In particular, the set of valid values for \fImethodName\fR is the set of all methods supported by an object and its superclasses, including those that are not exported Index: doc/namespace.n ================================================================== --- doc/namespace.n +++ doc/namespace.n @@ -786,16 +786,14 @@ name. Note that when this option is non-empty and the \fB\-subcommands\fR option is empty, the ensemble subcommand names will be exactly those words that have mappings in the dictionary. .TP \fB\-parameters\fR -.VS 8.6 This option gives a list of named arguments (the names being used during generation of error messages) that are passed by the caller of the ensemble between the name of the ensemble and the subcommand argument. By default, it is the empty list. -.VE 8.6 .TP \fB\-prefixes\fR . This option (which is enabled by default) controls whether the ensemble command recognizes unambiguous prefixes of its subcommands. @@ -941,11 +939,10 @@ .PP .CS namespace forget {*}[namespace import] .CE .PP -.VS 8.6 Create an ensemble for simple working with numbers, using the \fB\-parameters\fR option to allow the operator to be put between the first and second arguments. .PP .CS @@ -957,13 +954,12 @@ } # In use, the ensemble works like this: puts [do 1 plus [do 9 minus 7]] .CE -.VE 8.6 .SH "SEE ALSO" interp(n), upvar(n), variable(n) .SH KEYWORDS command, ensemble, exported, internal, variable '\" Local Variables: '\" mode: nroff '\" End: Index: doc/re_syntax.n ================================================================== --- doc/re_syntax.n +++ doc/re_syntax.n @@ -373,11 +373,11 @@ hexadecimal digits are reached, or an overflow would occur in the maximum value of \fBU+\fI10ffff\fR. .TP \fB\ev\fR . -vertical tab, as in C +vertical tab, as in C are all available. .TP \fB\ex\fIhh\fR . (where \fIhh\fR is one or two hexadecimal digits) the character whose hexadecimal value is \fB0x\fIhh\fR. Index: doc/registry.n ================================================================== --- doc/registry.n +++ doc/registry.n @@ -42,17 +42,15 @@ \fBHKEY_CLASSES_ROOT\fR, \fBHKEY_CURRENT_USER\fR, \fBHKEY_CURRENT_CONFIG\fR, \fBHKEY_PERFORMANCE_DATA\fR, or \fBHKEY_DYN_DATA\fR. The \fIkeypath\fR can be one or more registry key names separated by backslash (\fB\e\fR) characters. .PP -.VS 8.6 The optional \fI\-mode\fR argument indicates which registry to work with; when it is \fB\-32bit\fR the 32-bit registry will be used, and when it is \fB\-64bit\fR the 64-bit registry will be used. If this argument is omitted, the system's default registry will be the subject of the requested operation. -.VE 8.6 .PP \fIOption\fR indicates what to do with the registry key name. Any unique abbreviation for \fIoption\fR is acceptable. The valid options are: .TP Index: doc/return.n ================================================================== --- doc/return.n +++ doc/return.n @@ -135,11 +135,10 @@ the value of \fB\-errorinfo\fR in a return options dictionary captured by the \fBcatch\fR command (or from the copy of that information stored in the global variable \fBerrorInfo\fR). .TP \fB\-errorstack \fIlist\fR -.VS 8.6 The \fB\-errorstack\fR option receives special treatment only when the value of the \fB\-code\fR option is \fBTCL_ERROR\fR. Then \fIlist\fR is the initial error stack, recording actual argument values passed to each proc level. The error stack will also be reachable through \fBinfo errorstack\fR. If no \fB\-errorstack\fR option is provided to \fBreturn\fR when @@ -150,11 +149,10 @@ there will be no information about the context of the error within the procedure. Typically the \fIlist\fR value is supplied from the value of \fB\-errorstack\fR in a return options dictionary captured by the \fBcatch\fR command (or from the copy of that information from \fBinfo errorstack\fR). -.VE 8.6 .TP \fB\-level \fIlevel\fR . The \fB\-level\fR and \fB\-code\fR options work together to set the return code to be returned by one of the commands currently being evaluated. Index: doc/scan.n ================================================================== --- doc/scan.n +++ doc/scan.n @@ -222,14 +222,16 @@ .CS set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP -Parse a \fIHH:MM\fR time string: +Parse a \fIHH:MM\fR time string, noting that this avoids problems with +octal numbers by forcing interpretation as decimals (if we did not +care, we would use the \fB%i\fR conversion instead): .PP .CS -set string "08:08" +set string "08:08" ;# *Not* octal! if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} { error "not a valid time string" } # We have to understand numeric ranges ourselves... if {$minutes < 0 || $minutes > 59} { Index: doc/source.n ================================================================== --- doc/source.n +++ doc/source.n @@ -41,11 +41,11 @@ or .QW \eu001a , which will be safely substituted by the Tcl interpreter into .QW ^Z . .PP -A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, unicode). +A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, utf-16, ucs-2). .PP The \fB\-encoding\fR option is used to specify the encoding of the data stored in \fIfileName\fR. When the \fB\-encoding\fR option is omitted, the system encoding is assumed. .SH EXAMPLE Index: doc/string.n ================================================================== --- doc/string.n +++ doc/string.n @@ -360,25 +360,25 @@ \fBstring trim \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any leading or trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character -for which \fBstring is space\fR returns 1, and "\0"). +for which \fBstring is space\fR returns 1, and "\e0"). .TP \fBstring trimleft \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any leading characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character -for which \fBstring is space\fR returns 1, and "\0"). +for which \fBstring is space\fR returns 1, and "\e0"). .TP \fBstring trimright \fIstring\fR ?\fIchars\fR? . Returns a value equal to \fIstring\fR except that any trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character -for which \fBstring is space\fR returns 1, and "\0"). +for which \fBstring is space\fR returns 1, and "\e0"). .SS "OBSOLETE SUBCOMMANDS" .PP These subcommands are currently supported, but are likely to go away in a future release as their functionality is either virtually never used or highly misleading. @@ -503,10 +503,10 @@ } .CE .SH "SEE ALSO" expr(n), list(n) .SH KEYWORDS -case conversion, compare, index, match, pattern, string, word, equal, +case conversion, compare, index, integer value, match, pattern, string, word, equal, ctype, character, reverse .\" Local Variables: .\" mode: nroff .\" End: Index: doc/tclvars.n ================================================================== --- doc/tclvars.n +++ doc/tclvars.n @@ -8,11 +8,11 @@ .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl +argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl .BE .SH DESCRIPTION .PP The following global variables are created and managed automatically by the Tcl library. Except where noted below, these variables should @@ -320,15 +320,13 @@ . The version number for the operating system running on this machine. On UNIX machines, this is the value returned by \fBuname -r\fR. .TP \fBpathSeparator\fR -.VS 8.6 '\" Defined by TIP #315 The character that should be used to \fBsplit\fR PATH-like environment variables into their corresponding list of directory names. -.VE 8.6 .TP \fBplatform\fR . Either \fBwindows\fR, or \fBunix\fR. This identifies the general operating environment of the machine. @@ -353,10 +351,74 @@ \fBwordSize\fR . This gives the size of the native-machine word in bytes (strictly, it is same as the result of evaluating \fIsizeof(long)\fR in C.) .RE +.TP +\fBtcl_precision\fR +. +This variable controls the number of digits to generate +when converting floating-point values to strings. It defaults +to 0. \fIApplications should not change this value;\fR it is +provided for compatibility with legacy code. +.PP +.RS +The default value of 0 is special, meaning that Tcl should +convert numbers using as few digits as possible while still +distinguishing any floating point number from its nearest +neighbours. It differs from using an arbitrarily high value +for \fItcl_precision\fR in that an inexact number like \fI1.4\fR +will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR +even though the latter is nearer to the exact value of the +binary number. +.RE +.PP +.RS +If \fBtcl_precision\fR is not zero, then when Tcl converts a floating +point number, it creates a decimal representation of at most +\fBtcl_precision\fR significant digits; the result may be shorter if +the shorter result represents the original number exactly. If no +result of at most \fBtcl_precision\fR digits is an exact representation +of the original number, the one that is closest to the original +number is chosen. +If the original number lies precisely between two equally accurate +decimal representations, then the one with an even value for the least +significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then +0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to +0.688, not 0.687. Any string of trailing zeroes that remains is trimmed. +.RE +.PP +.RS +a \fBtcl_precision\fR value of 17 digits is +.QW perfect +for IEEE floating-point in that it allows +double-precision values to be converted to strings and back to +binary with no loss of information. For this reason, you will often +see it as a value in legacy code that must run on Tcl versions before +8.5. It is no longer recommended; as noted above, a zero value is the +preferred method. +.RE +.PP +.RS +All interpreters in a thread share a single \fBtcl_precision\fR value: +changing it in one interpreter will affect all other interpreters as +well. Safe interpreters are not allowed to modify the +variable. +.RE +.PP +.RS +Valid values for \fBtcl_precision\fR range from 0 to 17. +.RE +.TP +\fBtcl_rcFileName\fR +. +This variable is used during initialization to indicate the name of a +user-specific startup file. If it is set by application-specific +initialization, then the Tcl startup code will check for the existence +of this file and \fBsource\fR it if it exists. For example, for \fBwish\fR +the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR +for Windows. .TP \fBtcl_traceCompile\fR . The value of this variable can be set to control how much tracing information Index: doc/zipfs.3 ================================================================== --- doc/zipfs.3 +++ doc/zipfs.3 @@ -81,11 +81,11 @@ present working directory or in the standard Tcl install location. (For example, the Tcl 8.7.2 release would be searched for in a file \fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only. .PP On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since -it uses WCHAR in stead of char. As a result, it requires your application to +it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the \fB-DUNICODE\fR compiler flag). .PP The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR when the function is successful). The function \fImay\fR modify the variables Index: generic/regc_lex.c ================================================================== --- generic/regc_lex.c +++ generic/regc_lex.c @@ -257,19 +257,19 @@ CHR(':'), CHR(']') }; #define PUNCT_CONN \ CHR('_'), \ - 0x203f /* UNDERTIE */, \ + 0x203F /* UNDERTIE */, \ 0x2040 /* CHARACTER TIE */,\ 0x2054 /* INVERTED UNDERTIE */,\ - 0xfe33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \ - 0xfe34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \ - 0xfe4d /* DASHED LOW LINE */, \ - 0xfe4e /* CENTRELINE LOW LINE */, \ - 0xfe4f /* WAVY LOW LINE */, \ - 0xff3f /* FULLWIDTH LOW LINE */ + 0xFE33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \ + 0xFE34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \ + 0xFE4D /* DASHED LOW LINE */, \ + 0xFE4E /* CENTRELINE LOW LINE */, \ + 0xFE4F /* WAVY LOW LINE */, \ + 0xFF3F /* FULLWIDTH LOW LINE */ static const chr backw[] = { /* \w */ CHR('['), CHR('['), CHR(':'), CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'), CHR(':'), CHR(']'), PUNCT_CONN, CHR(']') @@ -903,22 +903,20 @@ * Oops, doesn't look like it's a backref after all... */ v->now = save; - /* - * And fall through into octal number. - */ + /* FALLTHRU */ case CHR('0'): NOTE(REG_UUNPORT); v->now--; /* put first digit back */ c = (uchr) lexdigits(v, 8, 1, 3); if (ISERR()) { FAILW(REG_EESCAPE); } - if (c > 0xff) { + if (c > 0xFF) { /* out of range, so we handled one digit too much */ v->now--; c >>= 3; } RETV(PLAIN, c); @@ -948,11 +946,11 @@ int d; const uchr ub = (uchr) base; n = 0; for (len = 0; len < maxlen && !ATEOS(); len++) { - if (n > 0x10fff) { + if (n > 0x10FFF) { /* Stop when continuing would otherwise overflow */ break; } c = *v->now++; switch (c) { Index: generic/regc_locale.c ================================================================== --- generic/regc_locale.c +++ generic/regc_locale.c @@ -132,153 +132,156 @@ /* * Unicode: alphabetic characters. */ static const crange alphaRangeTable[] = { - {0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6}, - {0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374}, - {0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5}, - {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588}, - {0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3}, - {0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea}, - {0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4}, - {0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980}, - {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, - {0x9df, 0x9e1}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, - {0xa59, 0xa5c}, {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, - {0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, - {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, - {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, - {0xbae, 0xbb9}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, - {0xc2a, 0xc39}, {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, - {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, - {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61}, - {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, - {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe86, 0xe8a}, - {0xe8c, 0xea3}, {0xea7, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf}, - {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a}, - {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081}, - {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d}, - {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, - {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, - {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, - {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c}, - {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, - {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, - {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1878}, - {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, - {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, - {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, - {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, - {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, - {0x1ce9, 0x1cec}, {0x1cee, 0x1cf3}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, - {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, - {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, - {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, - {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, - {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, - {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, - {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, - {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, - {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, - {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, - {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, - {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef}, {0xa000, 0xa48c}, - {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, - {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, - {0xa78b, 0xa7bf}, {0xa7c2, 0xa7c6}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, - {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, - {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, - {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, - {0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, - {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, - {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, - {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab67}, - {0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, - {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, - {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, - {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, - {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, - {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, - {0xffda, 0xffdc} + {0x41, 0x5A}, {0x61, 0x7A}, {0xC0, 0xD6}, {0xD8, 0xF6}, + {0xF8, 0x2C1}, {0x2C6, 0x2D1}, {0x2E0, 0x2E4}, {0x370, 0x374}, + {0x37A, 0x37D}, {0x388, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x3F5}, + {0x3F7, 0x481}, {0x48A, 0x52F}, {0x531, 0x556}, {0x560, 0x588}, + {0x5D0, 0x5EA}, {0x5EF, 0x5F2}, {0x620, 0x64A}, {0x671, 0x6D3}, + {0x6FA, 0x6FC}, {0x712, 0x72F}, {0x74D, 0x7A5}, {0x7CA, 0x7EA}, + {0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86A}, {0x8A0, 0x8B4}, + {0x8B6, 0x8C7}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980}, + {0x985, 0x98C}, {0x993, 0x9A8}, {0x9AA, 0x9B0}, {0x9B6, 0x9B9}, + {0x9DF, 0x9E1}, {0xA05, 0xA0A}, {0xA13, 0xA28}, {0xA2A, 0xA30}, + {0xA59, 0xA5C}, {0xA72, 0xA74}, {0xA85, 0xA8D}, {0xA8F, 0xA91}, + {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9}, {0xB05, 0xB0C}, + {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, {0xB5F, 0xB61}, + {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, {0xBA8, 0xBAA}, + {0xBAE, 0xBB9}, {0xC05, 0xC0C}, {0xC0E, 0xC10}, {0xC12, 0xC28}, + {0xC2A, 0xC39}, {0xC58, 0xC5A}, {0xC85, 0xC8C}, {0xC8E, 0xC90}, + {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9}, {0xD04, 0xD0C}, + {0xD0E, 0xD10}, {0xD12, 0xD3A}, {0xD54, 0xD56}, {0xD5F, 0xD61}, + {0xD7A, 0xD7F}, {0xD85, 0xD96}, {0xD9A, 0xDB1}, {0xDB3, 0xDBB}, + {0xDC0, 0xDC6}, {0xE01, 0xE30}, {0xE40, 0xE46}, {0xE86, 0xE8A}, + {0xE8C, 0xEA3}, {0xEA7, 0xEB0}, {0xEC0, 0xEC4}, {0xEDC, 0xEDF}, + {0xF40, 0xF47}, {0xF49, 0xF6C}, {0xF88, 0xF8C}, {0x1000, 0x102A}, + {0x1050, 0x1055}, {0x105A, 0x105D}, {0x106E, 0x1070}, {0x1075, 0x1081}, + {0x10A0, 0x10C5}, {0x10D0, 0x10FA}, {0x10FC, 0x1248}, {0x124A, 0x124D}, + {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D}, + {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5}, + {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A}, + {0x1380, 0x138F}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD}, {0x1401, 0x166C}, + {0x166F, 0x167F}, {0x1681, 0x169A}, {0x16A0, 0x16EA}, {0x16F1, 0x16F8}, + {0x1700, 0x170C}, {0x170E, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, + {0x1760, 0x176C}, {0x176E, 0x1770}, {0x1780, 0x17B3}, {0x1820, 0x1878}, + {0x1880, 0x1884}, {0x1887, 0x18A8}, {0x18B0, 0x18F5}, {0x1900, 0x191E}, + {0x1950, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9}, + {0x1A00, 0x1A16}, {0x1A20, 0x1A54}, {0x1B05, 0x1B33}, {0x1B45, 0x1B4B}, + {0x1B83, 0x1BA0}, {0x1BBA, 0x1BE5}, {0x1C00, 0x1C23}, {0x1C4D, 0x1C4F}, + {0x1C5A, 0x1C7D}, {0x1C80, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF}, + {0x1CE9, 0x1CEC}, {0x1CEE, 0x1CF3}, {0x1D00, 0x1DBF}, {0x1E00, 0x1F15}, + {0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57}, + {0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FBC}, {0x1FC2, 0x1FC4}, + {0x1FC6, 0x1FCC}, {0x1FD0, 0x1FD3}, {0x1FD6, 0x1FDB}, {0x1FE0, 0x1FEC}, + {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFC}, {0x2090, 0x209C}, {0x210A, 0x2113}, + {0x2119, 0x211D}, {0x212A, 0x212D}, {0x212F, 0x2139}, {0x213C, 0x213F}, + {0x2145, 0x2149}, {0x2C00, 0x2C2E}, {0x2C30, 0x2C5E}, {0x2C60, 0x2CE4}, + {0x2CEB, 0x2CEE}, {0x2D00, 0x2D25}, {0x2D30, 0x2D67}, {0x2D80, 0x2D96}, + {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, + {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, + {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309D, 0x309F}, {0x30A1, 0x30FA}, + {0x30FC, 0x30FF}, {0x3105, 0x312F}, {0x3131, 0x318E}, {0x31A0, 0x31BF}, + {0x31F0, 0x31FF}, {0x3400, 0x4DBF}, {0x4E00, 0x9FFC}, {0xA000, 0xA48C}, + {0xA4D0, 0xA4FD}, {0xA500, 0xA60C}, {0xA610, 0xA61F}, {0xA640, 0xA66E}, + {0xA67F, 0xA69D}, {0xA6A0, 0xA6E5}, {0xA717, 0xA71F}, {0xA722, 0xA788}, + {0xA78B, 0xA7BF}, {0xA7C2, 0xA7CA}, {0xA7F5, 0xA801}, {0xA803, 0xA805}, + {0xA807, 0xA80A}, {0xA80C, 0xA822}, {0xA840, 0xA873}, {0xA882, 0xA8B3}, + {0xA8F2, 0xA8F7}, {0xA90A, 0xA925}, {0xA930, 0xA946}, {0xA960, 0xA97C}, + {0xA984, 0xA9B2}, {0xA9E0, 0xA9E4}, {0xA9E6, 0xA9EF}, {0xA9FA, 0xA9FE}, + {0xAA00, 0xAA28}, {0xAA40, 0xAA42}, {0xAA44, 0xAA4B}, {0xAA60, 0xAA76}, + {0xAA7E, 0xAAAF}, {0xAAB9, 0xAABD}, {0xAADB, 0xAADD}, {0xAAE0, 0xAAEA}, + {0xAAF2, 0xAAF4}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, {0xAB11, 0xAB16}, + {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB5A}, {0xAB5C, 0xAB69}, + {0xAB70, 0xABE2}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, {0xD7CB, 0xD7FB}, + {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, + {0xFB1F, 0xFB28}, {0xFB2A, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBB1}, + {0xFBD3, 0xFD3D}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7}, {0xFDF0, 0xFDFB}, + {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF21, 0xFF3A}, {0xFF41, 0xFF5A}, + {0xFF66, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, + {0xFFDA, 0xFFDC} #if CHRBITS > 16 - ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d}, - {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0}, - {0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375}, - {0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, - {0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563}, + ,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D}, + {0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10280, 0x1029C}, {0x102A0, 0x102D0}, + {0x10300, 0x1031F}, {0x1032D, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375}, + {0x10380, 0x1039D}, {0x103A0, 0x103C3}, {0x103C8, 0x103CF}, {0x10400, 0x1049D}, + {0x104B0, 0x104D3}, {0x104D8, 0x104FB}, {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805}, - {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e}, - {0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7}, - {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c}, - {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, - {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, - {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c}, - {0x10f30, 0x10f45}, {0x10fe0, 0x10ff6}, {0x11003, 0x11037}, {0x11083, 0x110af}, - {0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, - {0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, - {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, - {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, - {0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, - {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, - {0x11700, 0x1171a}, {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x119a0, 0x119a7}, - {0x119aa, 0x119d0}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a89}, {0x11ac0, 0x11af8}, - {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, - {0x11d0b, 0x11d30}, {0x11d60, 0x11d65}, {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, - {0x12000, 0x12399}, {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, - {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, - {0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, - {0x16f00, 0x16f4a}, {0x16f93, 0x16f9f}, {0x17000, 0x187f7}, {0x18800, 0x18af2}, - {0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb}, - {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, - {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, - {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, - {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, - {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da}, - {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e}, - {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2}, - {0x1d7c4, 0x1d7cb}, {0x1e100, 0x1e12c}, {0x1e137, 0x1e13d}, {0x1e2c0, 0x1e2eb}, - {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, - {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, - {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, - {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, - {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, - {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d} + {0x1080A, 0x10835}, {0x1083F, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089E}, + {0x108E0, 0x108F2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109B7}, + {0x10A10, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35}, {0x10A60, 0x10A7C}, + {0x10A80, 0x10A9C}, {0x10AC0, 0x10AC7}, {0x10AC9, 0x10AE4}, {0x10B00, 0x10B35}, + {0x10B40, 0x10B55}, {0x10B60, 0x10B72}, {0x10B80, 0x10B91}, {0x10C00, 0x10C48}, + {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10D00, 0x10D23}, {0x10E80, 0x10EA9}, + {0x10F00, 0x10F1C}, {0x10F30, 0x10F45}, {0x10FB0, 0x10FC4}, {0x10FE0, 0x10FF6}, + {0x11003, 0x11037}, {0x11083, 0x110AF}, {0x110D0, 0x110E8}, {0x11103, 0x11126}, + {0x11150, 0x11172}, {0x11183, 0x111B2}, {0x111C1, 0x111C4}, {0x11200, 0x11211}, + {0x11213, 0x1122B}, {0x11280, 0x11286}, {0x1128A, 0x1128D}, {0x1128F, 0x1129D}, + {0x1129F, 0x112A8}, {0x112B0, 0x112DE}, {0x11305, 0x1130C}, {0x11313, 0x11328}, + {0x1132A, 0x11330}, {0x11335, 0x11339}, {0x1135D, 0x11361}, {0x11400, 0x11434}, + {0x11447, 0x1144A}, {0x1145F, 0x11461}, {0x11480, 0x114AF}, {0x11580, 0x115AE}, + {0x115D8, 0x115DB}, {0x11600, 0x1162F}, {0x11680, 0x116AA}, {0x11700, 0x1171A}, + {0x11800, 0x1182B}, {0x118A0, 0x118DF}, {0x118FF, 0x11906}, {0x1190C, 0x11913}, + {0x11918, 0x1192F}, {0x119A0, 0x119A7}, {0x119AA, 0x119D0}, {0x11A0B, 0x11A32}, + {0x11A5C, 0x11A89}, {0x11AC0, 0x11AF8}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C2E}, + {0x11C72, 0x11C8F}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D30}, {0x11D60, 0x11D65}, + {0x11D6A, 0x11D89}, {0x11EE0, 0x11EF2}, {0x12000, 0x12399}, {0x12480, 0x12543}, + {0x13000, 0x1342E}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E}, + {0x16AD0, 0x16AED}, {0x16B00, 0x16B2F}, {0x16B40, 0x16B43}, {0x16B63, 0x16B77}, + {0x16B7D, 0x16B8F}, {0x16E40, 0x16E7F}, {0x16F00, 0x16F4A}, {0x16F93, 0x16F9F}, + {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, {0x1B000, 0x1B11E}, + {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A}, + {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, {0x1D400, 0x1D454}, + {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, + {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, + {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, + {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D6C0}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6FA}, + {0x1D6FC, 0x1D714}, {0x1D716, 0x1D734}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D76E}, + {0x1D770, 0x1D788}, {0x1D78A, 0x1D7A8}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7CB}, + {0x1E100, 0x1E12C}, {0x1E137, 0x1E13D}, {0x1E2C0, 0x1E2EB}, {0x1E800, 0x1E8C4}, + {0x1E900, 0x1E943}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32}, + {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72}, + {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B}, + {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x20000, 0x2A6DD}, + {0x2A700, 0x2B734}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, + {0x2F800, 0x2FA1D}, {0x30000, 0x3134A} #endif }; #define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange)) static const chr alphaCharTable[] = { - 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386, - 0x38c, 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, - 0x6ff, 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, - 0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd, - 0x9f0, 0x9f1, 0x9fc, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, - 0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, - 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, - 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, - 0xc3d, 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, - 0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, - 0xea5, 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, - 0x1066, 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, - 0x1aa7, 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1cfa, 0x1f59, 0x1f5b, 0x1f5d, - 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, - 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, - 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, - 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, - 0xfb40, 0xfb41, 0xfb43, 0xfb44 + 0xAA, 0xB5, 0xBA, 0x2EC, 0x2EE, 0x376, 0x377, 0x37F, 0x386, + 0x38C, 0x559, 0x66E, 0x66F, 0x6D5, 0x6E5, 0x6E6, 0x6EE, 0x6EF, + 0x6FF, 0x710, 0x7B1, 0x7F4, 0x7F5, 0x7FA, 0x81A, 0x824, 0x828, + 0x93D, 0x950, 0x98F, 0x990, 0x9B2, 0x9BD, 0x9CE, 0x9DC, 0x9DD, + 0x9F0, 0x9F1, 0x9FC, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36, + 0xA38, 0xA39, 0xA5E, 0xAB2, 0xAB3, 0xABD, 0xAD0, 0xAE0, 0xAE1, + 0xAF9, 0xB0F, 0xB10, 0xB32, 0xB33, 0xB3D, 0xB5C, 0xB5D, 0xB71, + 0xB83, 0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0, + 0xC3D, 0xC60, 0xC61, 0xC80, 0xCBD, 0xCDE, 0xCE0, 0xCE1, 0xCF1, + 0xCF2, 0xD3D, 0xD4E, 0xDBD, 0xE32, 0xE33, 0xE81, 0xE82, 0xE84, + 0xEA5, 0xEB2, 0xEB3, 0xEBD, 0xEC6, 0xF00, 0x103F, 0x1061, 0x1065, + 0x1066, 0x108E, 0x10C7, 0x10CD, 0x1258, 0x12C0, 0x17D7, 0x17DC, 0x18AA, + 0x1AA7, 0x1BAE, 0x1BAF, 0x1CF5, 0x1CF6, 0x1CFA, 0x1F59, 0x1F5B, 0x1F5D, + 0x1FBE, 0x2071, 0x207F, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, + 0x214E, 0x2183, 0x2184, 0x2CF2, 0x2CF3, 0x2D27, 0x2D2D, 0x2D6F, 0x2E2F, + 0x3005, 0x3006, 0x303B, 0x303C, 0xA62A, 0xA62B, 0xA8FB, 0xA8FD, 0xA8FE, + 0xA9CF, 0xAA7A, 0xAAB1, 0xAAB5, 0xAAB6, 0xAAC0, 0xAAC2, 0xFB1D, 0xFB3E, + 0xFB40, 0xFB41, 0xFB43, 0xFB44 #if CHRBITS > 16 - ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be, - 0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, - 0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x1145f, 0x114c4, 0x114c5, 0x114c7, - 0x11644, 0x116b8, 0x118ff, 0x119e1, 0x119e3, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, - 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, - 0x16fe1, 0x16fe3, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, - 0x1e14e, 0x1e94b, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, - 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, - 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e + ,0x1003C, 0x1003D, 0x10808, 0x10837, 0x10838, 0x1083C, 0x108F4, 0x108F5, 0x109BE, + 0x109BF, 0x10A00, 0x10EB0, 0x10EB1, 0x10F27, 0x11144, 0x11147, 0x11176, 0x111DA, + 0x111DC, 0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x1133D, 0x11350, 0x114C4, + 0x114C5, 0x114C7, 0x11644, 0x116B8, 0x11909, 0x11915, 0x11916, 0x1193F, 0x11941, + 0x119E1, 0x119E3, 0x11A00, 0x11A3A, 0x11A50, 0x11A9D, 0x11C40, 0x11D08, 0x11D09, + 0x11D46, 0x11D67, 0x11D68, 0x11D98, 0x11FB0, 0x16F50, 0x16FE0, 0x16FE1, 0x16FE3, + 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E14E, 0x1E94B, + 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42, 0x1EE47, 0x1EE49, + 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B, 0x1EE5D, 0x1EE5F, + 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E #endif }; #define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr)) @@ -285,25 +288,25 @@ /* * Unicode: control characters. */ static const crange controlRangeTable[] = { - {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f}, - {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff}, - {0xfff9, 0xfffb} + {0x0, 0x1F}, {0x7F, 0x9F}, {0x600, 0x605}, {0x200B, 0x200F}, + {0x202A, 0x202E}, {0x2060, 0x2064}, {0x2066, 0x206F}, {0xE000, 0xF8FF}, + {0xFFF9, 0xFFFB} #if CHRBITS > 16 - ,{0x13430, 0x13438}, {0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, - {0xf0000, 0xffffd}, {0x100000, 0x10fffd} + ,{0x13430, 0x13438}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F}, + {0xF0000, 0xFFFFD}, {0x100000, 0x10FFFD} #endif }; #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) static const chr controlCharTable[] = { - 0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff + 0xAD, 0x61C, 0x6DD, 0x70F, 0x8E2, 0x180E, 0xFEFF #if CHRBITS > 16 - ,0x110bd, 0x110cd, 0xe0001 + ,0x110BD, 0x110CD, 0xE0001 #endif }; #define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr)) @@ -310,27 +313,27 @@ /* * Unicode: decimal digit characters. */ static const crange digitRangeTable[] = { - {0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9}, - {0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef}, - {0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef}, - {0xd66, 0xd6f}, {0xde6, 0xdef}, {0xe50, 0xe59}, {0xed0, 0xed9}, - {0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9}, - {0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89}, - {0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49}, - {0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909}, - {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9}, - {0xff10, 0xff19} + {0x30, 0x39}, {0x660, 0x669}, {0x6F0, 0x6F9}, {0x7C0, 0x7C9}, + {0x966, 0x96F}, {0x9E6, 0x9EF}, {0xA66, 0xA6F}, {0xAE6, 0xAEF}, + {0xB66, 0xB6F}, {0xBE6, 0xBEF}, {0xC66, 0xC6F}, {0xCE6, 0xCEF}, + {0xD66, 0xD6F}, {0xDE6, 0xDEF}, {0xE50, 0xE59}, {0xED0, 0xED9}, + {0xF20, 0xF29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17E0, 0x17E9}, + {0x1810, 0x1819}, {0x1946, 0x194F}, {0x19D0, 0x19D9}, {0x1A80, 0x1A89}, + {0x1A90, 0x1A99}, {0x1B50, 0x1B59}, {0x1BB0, 0x1BB9}, {0x1C40, 0x1C49}, + {0x1C50, 0x1C59}, {0xA620, 0xA629}, {0xA8D0, 0xA8D9}, {0xA900, 0xA909}, + {0xA9D0, 0xA9D9}, {0xA9F0, 0xA9F9}, {0xAA50, 0xAA59}, {0xABF0, 0xABF9}, + {0xFF10, 0xFF19} #if CHRBITS > 16 - ,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, - {0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, - {0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, - {0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9}, - {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e140, 0x1e149}, - {0x1e2f0, 0x1e2f9}, {0x1e950, 0x1e959} + ,{0x104A0, 0x104A9}, {0x10D30, 0x10D39}, {0x11066, 0x1106F}, {0x110F0, 0x110F9}, + {0x11136, 0x1113F}, {0x111D0, 0x111D9}, {0x112F0, 0x112F9}, {0x11450, 0x11459}, + {0x114D0, 0x114D9}, {0x11650, 0x11659}, {0x116C0, 0x116C9}, {0x11730, 0x11739}, + {0x118E0, 0x118E9}, {0x11950, 0x11959}, {0x11C50, 0x11C59}, {0x11D50, 0x11D59}, + {0x11DA0, 0x11DA9}, {0x16A60, 0x16A69}, {0x16B50, 0x16B59}, {0x1D7CE, 0x1D7FF}, + {0x1E140, 0x1E149}, {0x1E2F0, 0x1E2F9}, {0x1E950, 0x1E959}, {0x1FBF0, 0x1FBF9} #endif }; #define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange)) @@ -341,56 +344,56 @@ /* * Unicode: punctuation characters. */ static const crange punctRangeTable[] = { - {0x21, 0x23}, {0x25, 0x2a}, {0x2c, 0x2f}, {0x5b, 0x5d}, - {0x55a, 0x55f}, {0x66a, 0x66d}, {0x700, 0x70d}, {0x7f7, 0x7f9}, - {0x830, 0x83e}, {0xf04, 0xf12}, {0xf3a, 0xf3d}, {0xfd0, 0xfd4}, - {0x104a, 0x104f}, {0x1360, 0x1368}, {0x16eb, 0x16ed}, {0x17d4, 0x17d6}, - {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad}, - {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, - {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, - {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, - {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4f}, - {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, - {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, - {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, - {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, - {0xff5f, 0xff65} + {0x21, 0x23}, {0x25, 0x2A}, {0x2C, 0x2F}, {0x5B, 0x5D}, + {0x55A, 0x55F}, {0x66A, 0x66D}, {0x700, 0x70D}, {0x7F7, 0x7F9}, + {0x830, 0x83E}, {0xF04, 0xF12}, {0xF3A, 0xF3D}, {0xFD0, 0xFD4}, + {0x104A, 0x104F}, {0x1360, 0x1368}, {0x16EB, 0x16ED}, {0x17D4, 0x17D6}, + {0x17D8, 0x17DA}, {0x1800, 0x180A}, {0x1AA0, 0x1AA6}, {0x1AA8, 0x1AAD}, + {0x1B5A, 0x1B60}, {0x1BFC, 0x1BFF}, {0x1C3B, 0x1C3F}, {0x1CC0, 0x1CC7}, + {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205E}, + {0x2308, 0x230B}, {0x2768, 0x2775}, {0x27E6, 0x27EF}, {0x2983, 0x2998}, + {0x29D8, 0x29DB}, {0x2CF9, 0x2CFC}, {0x2E00, 0x2E2E}, {0x2E30, 0x2E4F}, + {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301F}, {0xA60D, 0xA60F}, + {0xA6F2, 0xA6F7}, {0xA874, 0xA877}, {0xA8F8, 0xA8FA}, {0xA9C1, 0xA9CD}, + {0xAA5C, 0xAA5F}, {0xFE10, 0xFE19}, {0xFE30, 0xFE52}, {0xFE54, 0xFE61}, + {0xFF01, 0xFF03}, {0xFF05, 0xFF0A}, {0xFF0C, 0xFF0F}, {0xFF3B, 0xFF3D}, + {0xFF5F, 0xFF65} #if CHRBITS > 16 - ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f}, - {0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, - {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, - {0x1144b, 0x1144f}, {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, - {0x1173c, 0x1173e}, {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, - {0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x16e97, 0x16e9a}, - {0x1da87, 0x1da8b} + ,{0x10100, 0x10102}, {0x10A50, 0x10A58}, {0x10AF0, 0x10AF6}, {0x10B39, 0x10B3F}, + {0x10B99, 0x10B9C}, {0x10F55, 0x10F59}, {0x11047, 0x1104D}, {0x110BE, 0x110C1}, + {0x11140, 0x11143}, {0x111C5, 0x111C8}, {0x111DD, 0x111DF}, {0x11238, 0x1123D}, + {0x1144B, 0x1144F}, {0x115C1, 0x115D7}, {0x11641, 0x11643}, {0x11660, 0x1166C}, + {0x1173C, 0x1173E}, {0x11944, 0x11946}, {0x11A3F, 0x11A46}, {0x11A9A, 0x11A9C}, + {0x11A9E, 0x11AA2}, {0x11C41, 0x11C45}, {0x12470, 0x12474}, {0x16B37, 0x16B3B}, + {0x16E97, 0x16E9A}, {0x1DA87, 0x1DA8B} #endif }; #define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange)) static const chr punctCharTable[] = { - 0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7, - 0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a, - 0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c, - 0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970, - 0x9fd, 0xa76, 0xaf0, 0xc77, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, - 0xf14, 0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166e, 0x169b, 0x169c, - 0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, - 0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, - 0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, - 0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, - 0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, - 0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, - 0xff5b, 0xff5d + 0x3A, 0x3B, 0x3F, 0x40, 0x5F, 0x7B, 0x7D, 0xA1, 0xA7, + 0xAB, 0xB6, 0xB7, 0xBB, 0xBF, 0x37E, 0x387, 0x589, 0x58A, + 0x5BE, 0x5C0, 0x5C3, 0x5C6, 0x5F3, 0x5F4, 0x609, 0x60A, 0x60C, + 0x60D, 0x61B, 0x61E, 0x61F, 0x6D4, 0x85E, 0x964, 0x965, 0x970, + 0x9FD, 0xA76, 0xAF0, 0xC77, 0xC84, 0xDF4, 0xE4F, 0xE5A, 0xE5B, + 0xF14, 0xF85, 0xFD9, 0xFDA, 0x10FB, 0x1400, 0x166E, 0x169B, 0x169C, + 0x1735, 0x1736, 0x1944, 0x1945, 0x1A1E, 0x1A1F, 0x1C7E, 0x1C7F, 0x1CD3, + 0x207D, 0x207E, 0x208D, 0x208E, 0x2329, 0x232A, 0x27C5, 0x27C6, 0x29FC, + 0x29FD, 0x2CFE, 0x2CFF, 0x2D70, 0x2E52, 0x3030, 0x303D, 0x30A0, 0x30FB, + 0xA4FE, 0xA4FF, 0xA673, 0xA67E, 0xA8CE, 0xA8CF, 0xA8FC, 0xA92E, 0xA92F, + 0xA95F, 0xA9DE, 0xA9DF, 0xAADE, 0xAADF, 0xAAF0, 0xAAF1, 0xABEB, 0xFD3E, + 0xFD3F, 0xFE63, 0xFE68, 0xFE6A, 0xFE6B, 0xFF1A, 0xFF1B, 0xFF1F, 0xFF20, + 0xFF3F, 0xFF5B, 0xFF5D #if CHRBITS > 16 - ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc, - 0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b, - 0x119e2, 0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x11fff, 0x16a6e, 0x16a6f, 0x16af5, - 0x16b44, 0x16fe2, 0x1bc9f, 0x1e95e, 0x1e95f + ,0x1039F, 0x103D0, 0x1056F, 0x10857, 0x1091F, 0x1093F, 0x10A7F, 0x10EAD, 0x110BB, + 0x110BC, 0x11174, 0x11175, 0x111CD, 0x111DB, 0x112A9, 0x1145A, 0x1145B, 0x1145D, + 0x114C6, 0x1183B, 0x119E2, 0x11C70, 0x11C71, 0x11EF7, 0x11EF8, 0x11FFF, 0x16A6E, + 0x16A6F, 0x16AF5, 0x16B44, 0x16FE2, 0x1BC9F, 0x1E95E, 0x1E95F #endif }; #define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr)) @@ -397,121 +400,122 @@ /* * Unicode: white space characters. */ static const crange spaceRangeTable[] = { - {0x9, 0xd}, {0x2000, 0x200b} + {0x9, 0xD}, {0x2000, 0x200B} }; #define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange)) static const chr spaceCharTable[] = { - 0x20, 0x85, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f, - 0x2060, 0x3000, 0xfeff + 0x20, 0x85, 0xA0, 0x1680, 0x180E, 0x2028, 0x2029, 0x202F, 0x205F, + 0x2060, 0x3000, 0xFEFF }; #define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr)) /* * Unicode: lowercase characters. */ static const crange lowerRangeTable[] = { - {0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180}, - {0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293}, - {0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7}, - {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa}, - {0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, - {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, - {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45}, - {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, - {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, - {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149}, - {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731}, - {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab67}, - {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a} + {0x61, 0x7A}, {0xDF, 0xF6}, {0xF8, 0xFF}, {0x17E, 0x180}, + {0x199, 0x19B}, {0x1BD, 0x1BF}, {0x233, 0x239}, {0x24F, 0x293}, + {0x295, 0x2AF}, {0x37B, 0x37D}, {0x3AC, 0x3CE}, {0x3D5, 0x3D7}, + {0x3EF, 0x3F3}, {0x430, 0x45F}, {0x560, 0x588}, {0x10D0, 0x10FA}, + {0x10FD, 0x10FF}, {0x13F8, 0x13FD}, {0x1C80, 0x1C88}, {0x1D00, 0x1D2B}, + {0x1D6B, 0x1D77}, {0x1D79, 0x1D9A}, {0x1E95, 0x1E9D}, {0x1EFF, 0x1F07}, + {0x1F10, 0x1F15}, {0x1F20, 0x1F27}, {0x1F30, 0x1F37}, {0x1F40, 0x1F45}, + {0x1F50, 0x1F57}, {0x1F60, 0x1F67}, {0x1F70, 0x1F7D}, {0x1F80, 0x1F87}, + {0x1F90, 0x1F97}, {0x1FA0, 0x1FA7}, {0x1FB0, 0x1FB4}, {0x1FC2, 0x1FC4}, + {0x1FD0, 0x1FD3}, {0x1FE0, 0x1FE7}, {0x1FF2, 0x1FF4}, {0x2146, 0x2149}, + {0x2C30, 0x2C5E}, {0x2C76, 0x2C7B}, {0x2D00, 0x2D25}, {0xA72F, 0xA731}, + {0xA771, 0xA778}, {0xA793, 0xA795}, {0xAB30, 0xAB5A}, {0xAB60, 0xAB68}, + {0xAB70, 0xABBF}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFF41, 0xFF5A} #if CHRBITS > 16 - ,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, - {0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, - {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, - {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, - {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, - {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, - {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, - {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943} + ,{0x10428, 0x1044F}, {0x104D8, 0x104FB}, {0x10CC0, 0x10CF2}, {0x118C0, 0x118DF}, + {0x16E60, 0x16E7F}, {0x1D41A, 0x1D433}, {0x1D44E, 0x1D454}, {0x1D456, 0x1D467}, + {0x1D482, 0x1D49B}, {0x1D4B6, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D4CF}, + {0x1D4EA, 0x1D503}, {0x1D51E, 0x1D537}, {0x1D552, 0x1D56B}, {0x1D586, 0x1D59F}, + {0x1D5BA, 0x1D5D3}, {0x1D5EE, 0x1D607}, {0x1D622, 0x1D63B}, {0x1D656, 0x1D66F}, + {0x1D68A, 0x1D6A5}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6E1}, {0x1D6FC, 0x1D714}, + {0x1D716, 0x1D71B}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D755}, {0x1D770, 0x1D788}, + {0x1D78A, 0x1D78F}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7C9}, {0x1E922, 0x1E943} #endif }; #define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange)) static const chr lowerCharTable[] = { - 0xb5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10b, 0x10d, 0x10f, - 0x111, 0x113, 0x115, 0x117, 0x119, 0x11b, 0x11d, 0x11f, 0x121, - 0x123, 0x125, 0x127, 0x129, 0x12b, 0x12d, 0x12f, 0x131, 0x133, - 0x135, 0x137, 0x138, 0x13a, 0x13c, 0x13e, 0x140, 0x142, 0x144, - 0x146, 0x148, 0x149, 0x14b, 0x14d, 0x14f, 0x151, 0x153, 0x155, - 0x157, 0x159, 0x15b, 0x15d, 0x15f, 0x161, 0x163, 0x165, 0x167, - 0x169, 0x16b, 0x16d, 0x16f, 0x171, 0x173, 0x175, 0x177, 0x17a, - 0x17c, 0x183, 0x185, 0x188, 0x18c, 0x18d, 0x192, 0x195, 0x19e, - 0x1a1, 0x1a3, 0x1a5, 0x1a8, 0x1aa, 0x1ab, 0x1ad, 0x1b0, 0x1b4, - 0x1b6, 0x1b9, 0x1ba, 0x1c6, 0x1c9, 0x1cc, 0x1ce, 0x1d0, 0x1d2, - 0x1d4, 0x1d6, 0x1d8, 0x1da, 0x1dc, 0x1dd, 0x1df, 0x1e1, 0x1e3, - 0x1e5, 0x1e7, 0x1e9, 0x1eb, 0x1ed, 0x1ef, 0x1f0, 0x1f3, 0x1f5, - 0x1f9, 0x1fb, 0x1fd, 0x1ff, 0x201, 0x203, 0x205, 0x207, 0x209, - 0x20b, 0x20d, 0x20f, 0x211, 0x213, 0x215, 0x217, 0x219, 0x21b, - 0x21d, 0x21f, 0x221, 0x223, 0x225, 0x227, 0x229, 0x22b, 0x22d, - 0x22f, 0x231, 0x23c, 0x23f, 0x240, 0x242, 0x247, 0x249, 0x24b, - 0x24d, 0x371, 0x373, 0x377, 0x390, 0x3d0, 0x3d1, 0x3d9, 0x3db, - 0x3dd, 0x3df, 0x3e1, 0x3e3, 0x3e5, 0x3e7, 0x3e9, 0x3eb, 0x3ed, - 0x3f5, 0x3f8, 0x3fb, 0x3fc, 0x461, 0x463, 0x465, 0x467, 0x469, - 0x46b, 0x46d, 0x46f, 0x471, 0x473, 0x475, 0x477, 0x479, 0x47b, - 0x47d, 0x47f, 0x481, 0x48b, 0x48d, 0x48f, 0x491, 0x493, 0x495, - 0x497, 0x499, 0x49b, 0x49d, 0x49f, 0x4a1, 0x4a3, 0x4a5, 0x4a7, - 0x4a9, 0x4ab, 0x4ad, 0x4af, 0x4b1, 0x4b3, 0x4b5, 0x4b7, 0x4b9, - 0x4bb, 0x4bd, 0x4bf, 0x4c2, 0x4c4, 0x4c6, 0x4c8, 0x4ca, 0x4cc, - 0x4ce, 0x4cf, 0x4d1, 0x4d3, 0x4d5, 0x4d7, 0x4d9, 0x4db, 0x4dd, - 0x4df, 0x4e1, 0x4e3, 0x4e5, 0x4e7, 0x4e9, 0x4eb, 0x4ed, 0x4ef, - 0x4f1, 0x4f3, 0x4f5, 0x4f7, 0x4f9, 0x4fb, 0x4fd, 0x4ff, 0x501, - 0x503, 0x505, 0x507, 0x509, 0x50b, 0x50d, 0x50f, 0x511, 0x513, - 0x515, 0x517, 0x519, 0x51b, 0x51d, 0x51f, 0x521, 0x523, 0x525, - 0x527, 0x529, 0x52b, 0x52d, 0x52f, 0x1e01, 0x1e03, 0x1e05, 0x1e07, - 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f, 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, - 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21, 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, - 0x1e2d, 0x1e2f, 0x1e31, 0x1e33, 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, - 0x1e3f, 0x1e41, 0x1e43, 0x1e45, 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, - 0x1e51, 0x1e53, 0x1e55, 0x1e57, 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, - 0x1e63, 0x1e65, 0x1e67, 0x1e69, 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, - 0x1e75, 0x1e77, 0x1e79, 0x1e7b, 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, - 0x1e87, 0x1e89, 0x1e8b, 0x1e8d, 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1, - 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9, 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, - 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb, 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, - 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd, 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, - 0x1ed9, 0x1edb, 0x1edd, 0x1edf, 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, - 0x1eeb, 0x1eed, 0x1eef, 0x1ef1, 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb, - 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe, 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, - 0x1ff7, 0x210a, 0x210e, 0x210f, 0x2113, 0x212f, 0x2134, 0x2139, 0x213c, - 0x213d, 0x214e, 0x2184, 0x2c61, 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c, - 0x2c71, 0x2c73, 0x2c74, 0x2c81, 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b, - 0x2c8d, 0x2c8f, 0x2c91, 0x2c93, 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d, - 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5, 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf, - 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7, 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1, - 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9, 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3, - 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb, 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4, - 0x2cec, 0x2cee, 0x2cf3, 0x2d27, 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647, - 0xa649, 0xa64b, 0xa64d, 0xa64f, 0xa651, 0xa653, 0xa655, 0xa657, 0xa659, - 0xa65b, 0xa65d, 0xa65f, 0xa661, 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b, - 0xa66d, 0xa681, 0xa683, 0xa685, 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f, - 0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727, - 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d, - 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f, - 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761, - 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c, - 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797, - 0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, - 0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7bb, 0xa7bd, 0xa7bf, 0xa7c3, 0xa7fa + 0xB5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10B, 0x10D, 0x10F, + 0x111, 0x113, 0x115, 0x117, 0x119, 0x11B, 0x11D, 0x11F, 0x121, + 0x123, 0x125, 0x127, 0x129, 0x12B, 0x12D, 0x12F, 0x131, 0x133, + 0x135, 0x137, 0x138, 0x13A, 0x13C, 0x13E, 0x140, 0x142, 0x144, + 0x146, 0x148, 0x149, 0x14B, 0x14D, 0x14F, 0x151, 0x153, 0x155, + 0x157, 0x159, 0x15B, 0x15D, 0x15F, 0x161, 0x163, 0x165, 0x167, + 0x169, 0x16B, 0x16D, 0x16F, 0x171, 0x173, 0x175, 0x177, 0x17A, + 0x17C, 0x183, 0x185, 0x188, 0x18C, 0x18D, 0x192, 0x195, 0x19E, + 0x1A1, 0x1A3, 0x1A5, 0x1A8, 0x1AA, 0x1AB, 0x1AD, 0x1B0, 0x1B4, + 0x1B6, 0x1B9, 0x1BA, 0x1C6, 0x1C9, 0x1CC, 0x1CE, 0x1D0, 0x1D2, + 0x1D4, 0x1D6, 0x1D8, 0x1DA, 0x1DC, 0x1DD, 0x1DF, 0x1E1, 0x1E3, + 0x1E5, 0x1E7, 0x1E9, 0x1EB, 0x1ED, 0x1EF, 0x1F0, 0x1F3, 0x1F5, + 0x1F9, 0x1FB, 0x1FD, 0x1FF, 0x201, 0x203, 0x205, 0x207, 0x209, + 0x20B, 0x20D, 0x20F, 0x211, 0x213, 0x215, 0x217, 0x219, 0x21B, + 0x21D, 0x21F, 0x221, 0x223, 0x225, 0x227, 0x229, 0x22B, 0x22D, + 0x22F, 0x231, 0x23C, 0x23F, 0x240, 0x242, 0x247, 0x249, 0x24B, + 0x24D, 0x371, 0x373, 0x377, 0x390, 0x3D0, 0x3D1, 0x3D9, 0x3DB, + 0x3DD, 0x3DF, 0x3E1, 0x3E3, 0x3E5, 0x3E7, 0x3E9, 0x3EB, 0x3ED, + 0x3F5, 0x3F8, 0x3FB, 0x3FC, 0x461, 0x463, 0x465, 0x467, 0x469, + 0x46B, 0x46D, 0x46F, 0x471, 0x473, 0x475, 0x477, 0x479, 0x47B, + 0x47D, 0x47F, 0x481, 0x48B, 0x48D, 0x48F, 0x491, 0x493, 0x495, + 0x497, 0x499, 0x49B, 0x49D, 0x49F, 0x4A1, 0x4A3, 0x4A5, 0x4A7, + 0x4A9, 0x4AB, 0x4AD, 0x4AF, 0x4B1, 0x4B3, 0x4B5, 0x4B7, 0x4B9, + 0x4BB, 0x4BD, 0x4BF, 0x4C2, 0x4C4, 0x4C6, 0x4C8, 0x4CA, 0x4CC, + 0x4CE, 0x4CF, 0x4D1, 0x4D3, 0x4D5, 0x4D7, 0x4D9, 0x4DB, 0x4DD, + 0x4DF, 0x4E1, 0x4E3, 0x4E5, 0x4E7, 0x4E9, 0x4EB, 0x4ED, 0x4EF, + 0x4F1, 0x4F3, 0x4F5, 0x4F7, 0x4F9, 0x4FB, 0x4FD, 0x4FF, 0x501, + 0x503, 0x505, 0x507, 0x509, 0x50B, 0x50D, 0x50F, 0x511, 0x513, + 0x515, 0x517, 0x519, 0x51B, 0x51D, 0x51F, 0x521, 0x523, 0x525, + 0x527, 0x529, 0x52B, 0x52D, 0x52F, 0x1E01, 0x1E03, 0x1E05, 0x1E07, + 0x1E09, 0x1E0B, 0x1E0D, 0x1E0F, 0x1E11, 0x1E13, 0x1E15, 0x1E17, 0x1E19, + 0x1E1B, 0x1E1D, 0x1E1F, 0x1E21, 0x1E23, 0x1E25, 0x1E27, 0x1E29, 0x1E2B, + 0x1E2D, 0x1E2F, 0x1E31, 0x1E33, 0x1E35, 0x1E37, 0x1E39, 0x1E3B, 0x1E3D, + 0x1E3F, 0x1E41, 0x1E43, 0x1E45, 0x1E47, 0x1E49, 0x1E4B, 0x1E4D, 0x1E4F, + 0x1E51, 0x1E53, 0x1E55, 0x1E57, 0x1E59, 0x1E5B, 0x1E5D, 0x1E5F, 0x1E61, + 0x1E63, 0x1E65, 0x1E67, 0x1E69, 0x1E6B, 0x1E6D, 0x1E6F, 0x1E71, 0x1E73, + 0x1E75, 0x1E77, 0x1E79, 0x1E7B, 0x1E7D, 0x1E7F, 0x1E81, 0x1E83, 0x1E85, + 0x1E87, 0x1E89, 0x1E8B, 0x1E8D, 0x1E8F, 0x1E91, 0x1E93, 0x1E9F, 0x1EA1, + 0x1EA3, 0x1EA5, 0x1EA7, 0x1EA9, 0x1EAB, 0x1EAD, 0x1EAF, 0x1EB1, 0x1EB3, + 0x1EB5, 0x1EB7, 0x1EB9, 0x1EBB, 0x1EBD, 0x1EBF, 0x1EC1, 0x1EC3, 0x1EC5, + 0x1EC7, 0x1EC9, 0x1ECB, 0x1ECD, 0x1ECF, 0x1ED1, 0x1ED3, 0x1ED5, 0x1ED7, + 0x1ED9, 0x1EDB, 0x1EDD, 0x1EDF, 0x1EE1, 0x1EE3, 0x1EE5, 0x1EE7, 0x1EE9, + 0x1EEB, 0x1EED, 0x1EEF, 0x1EF1, 0x1EF3, 0x1EF5, 0x1EF7, 0x1EF9, 0x1EFB, + 0x1EFD, 0x1FB6, 0x1FB7, 0x1FBE, 0x1FC6, 0x1FC7, 0x1FD6, 0x1FD7, 0x1FF6, + 0x1FF7, 0x210A, 0x210E, 0x210F, 0x2113, 0x212F, 0x2134, 0x2139, 0x213C, + 0x213D, 0x214E, 0x2184, 0x2C61, 0x2C65, 0x2C66, 0x2C68, 0x2C6A, 0x2C6C, + 0x2C71, 0x2C73, 0x2C74, 0x2C81, 0x2C83, 0x2C85, 0x2C87, 0x2C89, 0x2C8B, + 0x2C8D, 0x2C8F, 0x2C91, 0x2C93, 0x2C95, 0x2C97, 0x2C99, 0x2C9B, 0x2C9D, + 0x2C9F, 0x2CA1, 0x2CA3, 0x2CA5, 0x2CA7, 0x2CA9, 0x2CAB, 0x2CAD, 0x2CAF, + 0x2CB1, 0x2CB3, 0x2CB5, 0x2CB7, 0x2CB9, 0x2CBB, 0x2CBD, 0x2CBF, 0x2CC1, + 0x2CC3, 0x2CC5, 0x2CC7, 0x2CC9, 0x2CCB, 0x2CCD, 0x2CCF, 0x2CD1, 0x2CD3, + 0x2CD5, 0x2CD7, 0x2CD9, 0x2CDB, 0x2CDD, 0x2CDF, 0x2CE1, 0x2CE3, 0x2CE4, + 0x2CEC, 0x2CEE, 0x2CF3, 0x2D27, 0x2D2D, 0xA641, 0xA643, 0xA645, 0xA647, + 0xA649, 0xA64B, 0xA64D, 0xA64F, 0xA651, 0xA653, 0xA655, 0xA657, 0xA659, + 0xA65B, 0xA65D, 0xA65F, 0xA661, 0xA663, 0xA665, 0xA667, 0xA669, 0xA66B, + 0xA66D, 0xA681, 0xA683, 0xA685, 0xA687, 0xA689, 0xA68B, 0xA68D, 0xA68F, + 0xA691, 0xA693, 0xA695, 0xA697, 0xA699, 0xA69B, 0xA723, 0xA725, 0xA727, + 0xA729, 0xA72B, 0xA72D, 0xA733, 0xA735, 0xA737, 0xA739, 0xA73B, 0xA73D, + 0xA73F, 0xA741, 0xA743, 0xA745, 0xA747, 0xA749, 0xA74B, 0xA74D, 0xA74F, + 0xA751, 0xA753, 0xA755, 0xA757, 0xA759, 0xA75B, 0xA75D, 0xA75F, 0xA761, + 0xA763, 0xA765, 0xA767, 0xA769, 0xA76B, 0xA76D, 0xA76F, 0xA77A, 0xA77C, + 0xA77F, 0xA781, 0xA783, 0xA785, 0xA787, 0xA78C, 0xA78E, 0xA791, 0xA797, + 0xA799, 0xA79B, 0xA79D, 0xA79F, 0xA7A1, 0xA7A3, 0xA7A5, 0xA7A7, 0xA7A9, + 0xA7AF, 0xA7B5, 0xA7B7, 0xA7B9, 0xA7BB, 0xA7BD, 0xA7BF, 0xA7C3, 0xA7C8, + 0xA7CA, 0xA7F6, 0xA7FA #if CHRBITS > 16 - ,0x1d4bb, 0x1d7cb + ,0x1D4BB, 0x1D7CB #endif }; #define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr)) @@ -518,103 +522,103 @@ /* * Unicode: uppercase characters. */ static const crange upperRangeTable[] = { - {0x41, 0x5a}, {0xc0, 0xd6}, {0xd8, 0xde}, {0x189, 0x18b}, - {0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8}, - {0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab}, - {0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5}, - {0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f}, - {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, - {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, - {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112}, - {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e}, - {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, - {0xa7b0, 0xa7b4}, {0xa7c4, 0xa7c6}, {0xff21, 0xff3a} + {0x41, 0x5A}, {0xC0, 0xD6}, {0xD8, 0xDE}, {0x189, 0x18B}, + {0x18E, 0x191}, {0x196, 0x198}, {0x1B1, 0x1B3}, {0x1F6, 0x1F8}, + {0x243, 0x246}, {0x388, 0x38A}, {0x391, 0x3A1}, {0x3A3, 0x3AB}, + {0x3D2, 0x3D4}, {0x3FD, 0x42F}, {0x531, 0x556}, {0x10A0, 0x10C5}, + {0x13A0, 0x13F5}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF}, {0x1F08, 0x1F0F}, + {0x1F18, 0x1F1D}, {0x1F28, 0x1F2F}, {0x1F38, 0x1F3F}, {0x1F48, 0x1F4D}, + {0x1F68, 0x1F6F}, {0x1FB8, 0x1FBB}, {0x1FC8, 0x1FCB}, {0x1FD8, 0x1FDB}, + {0x1FE8, 0x1FEC}, {0x1FF8, 0x1FFB}, {0x210B, 0x210D}, {0x2110, 0x2112}, + {0x2119, 0x211D}, {0x212A, 0x212D}, {0x2130, 0x2133}, {0x2C00, 0x2C2E}, + {0x2C62, 0x2C64}, {0x2C6D, 0x2C70}, {0x2C7E, 0x2C80}, {0xA7AA, 0xA7AE}, + {0xA7B0, 0xA7B4}, {0xA7C4, 0xA7C7}, {0xFF21, 0xFF3A} #if CHRBITS > 16 - ,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, - {0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, - {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, - {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, - {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, - {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, - {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, - {0x1e900, 0x1e921} + ,{0x10400, 0x10427}, {0x104B0, 0x104D3}, {0x10C80, 0x10CB2}, {0x118A0, 0x118BF}, + {0x16E40, 0x16E5F}, {0x1D400, 0x1D419}, {0x1D434, 0x1D44D}, {0x1D468, 0x1D481}, + {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B5}, {0x1D4D0, 0x1D4E9}, {0x1D507, 0x1D50A}, + {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, + {0x1D54A, 0x1D550}, {0x1D56C, 0x1D585}, {0x1D5A0, 0x1D5B9}, {0x1D5D4, 0x1D5ED}, + {0x1D608, 0x1D621}, {0x1D63C, 0x1D655}, {0x1D670, 0x1D689}, {0x1D6A8, 0x1D6C0}, + {0x1D6E2, 0x1D6FA}, {0x1D71C, 0x1D734}, {0x1D756, 0x1D76E}, {0x1D790, 0x1D7A8}, + {0x1E900, 0x1E921} #endif }; #define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange)) static const chr upperCharTable[] = { - 0x100, 0x102, 0x104, 0x106, 0x108, 0x10a, 0x10c, 0x10e, 0x110, - 0x112, 0x114, 0x116, 0x118, 0x11a, 0x11c, 0x11e, 0x120, 0x122, - 0x124, 0x126, 0x128, 0x12a, 0x12c, 0x12e, 0x130, 0x132, 0x134, - 0x136, 0x139, 0x13b, 0x13d, 0x13f, 0x141, 0x143, 0x145, 0x147, - 0x14a, 0x14c, 0x14e, 0x150, 0x152, 0x154, 0x156, 0x158, 0x15a, - 0x15c, 0x15e, 0x160, 0x162, 0x164, 0x166, 0x168, 0x16a, 0x16c, - 0x16e, 0x170, 0x172, 0x174, 0x176, 0x178, 0x179, 0x17b, 0x17d, - 0x181, 0x182, 0x184, 0x186, 0x187, 0x193, 0x194, 0x19c, 0x19d, - 0x19f, 0x1a0, 0x1a2, 0x1a4, 0x1a6, 0x1a7, 0x1a9, 0x1ac, 0x1ae, - 0x1af, 0x1b5, 0x1b7, 0x1b8, 0x1bc, 0x1c4, 0x1c7, 0x1ca, 0x1cd, - 0x1cf, 0x1d1, 0x1d3, 0x1d5, 0x1d7, 0x1d9, 0x1db, 0x1de, 0x1e0, - 0x1e2, 0x1e4, 0x1e6, 0x1e8, 0x1ea, 0x1ec, 0x1ee, 0x1f1, 0x1f4, - 0x1fa, 0x1fc, 0x1fe, 0x200, 0x202, 0x204, 0x206, 0x208, 0x20a, - 0x20c, 0x20e, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21a, 0x21c, - 0x21e, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22a, 0x22c, 0x22e, - 0x230, 0x232, 0x23a, 0x23b, 0x23d, 0x23e, 0x241, 0x248, 0x24a, - 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x37f, 0x386, 0x38c, 0x38e, - 0x38f, 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4, - 0x3e6, 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa, - 0x460, 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470, - 0x472, 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a, - 0x48c, 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c, - 0x49e, 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae, - 0x4b0, 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0, - 0x4c1, 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2, - 0x4d4, 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4, - 0x4e6, 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6, - 0x4f8, 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508, - 0x50a, 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a, - 0x51c, 0x51e, 0x520, 0x522, 0x524, 0x526, 0x528, 0x52a, 0x52c, - 0x52e, 0x10c7, 0x10cd, 0x1e00, 0x1e02, 0x1e04, 0x1e06, 0x1e08, 0x1e0a, - 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14, 0x1e16, 0x1e18, 0x1e1a, 0x1e1c, - 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26, 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e, - 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38, 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40, - 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a, 0x1e4c, 0x1e4e, 0x1e50, 0x1e52, - 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c, 0x1e5e, 0x1e60, 0x1e62, 0x1e64, - 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e, 0x1e70, 0x1e72, 0x1e74, 0x1e76, - 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80, 0x1e82, 0x1e84, 0x1e86, 0x1e88, - 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92, 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2, - 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac, 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4, - 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe, 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6, - 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0, 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8, - 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2, 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea, - 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4, 0x1ef6, 0x1ef8, 0x1efa, 0x1efc, - 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f, 0x2102, 0x2107, 0x2115, 0x2124, - 0x2126, 0x2128, 0x213e, 0x213f, 0x2145, 0x2183, 0x2c60, 0x2c67, 0x2c69, - 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84, 0x2c86, 0x2c88, 0x2c8a, 0x2c8c, - 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96, 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e, - 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8, 0x2caa, 0x2cac, 0x2cae, 0x2cb0, - 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba, 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2, - 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc, 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4, - 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde, 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced, - 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646, 0xa648, 0xa64a, 0xa64c, 0xa64e, - 0xa650, 0xa652, 0xa654, 0xa656, 0xa658, 0xa65a, 0xa65c, 0xa65e, 0xa660, - 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a, 0xa66c, 0xa680, 0xa682, 0xa684, - 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e, 0xa690, 0xa692, 0xa694, 0xa696, - 0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e, - 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742, - 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754, - 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766, - 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780, - 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798, - 0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6, - 0xa7b8, 0xa7ba, 0xa7bc, 0xa7be, 0xa7c2 + 0x100, 0x102, 0x104, 0x106, 0x108, 0x10A, 0x10C, 0x10E, 0x110, + 0x112, 0x114, 0x116, 0x118, 0x11A, 0x11C, 0x11E, 0x120, 0x122, + 0x124, 0x126, 0x128, 0x12A, 0x12C, 0x12E, 0x130, 0x132, 0x134, + 0x136, 0x139, 0x13B, 0x13D, 0x13F, 0x141, 0x143, 0x145, 0x147, + 0x14A, 0x14C, 0x14E, 0x150, 0x152, 0x154, 0x156, 0x158, 0x15A, + 0x15C, 0x15E, 0x160, 0x162, 0x164, 0x166, 0x168, 0x16A, 0x16C, + 0x16E, 0x170, 0x172, 0x174, 0x176, 0x178, 0x179, 0x17B, 0x17D, + 0x181, 0x182, 0x184, 0x186, 0x187, 0x193, 0x194, 0x19C, 0x19D, + 0x19F, 0x1A0, 0x1A2, 0x1A4, 0x1A6, 0x1A7, 0x1A9, 0x1AC, 0x1AE, + 0x1AF, 0x1B5, 0x1B7, 0x1B8, 0x1BC, 0x1C4, 0x1C7, 0x1CA, 0x1CD, + 0x1CF, 0x1D1, 0x1D3, 0x1D5, 0x1D7, 0x1D9, 0x1DB, 0x1DE, 0x1E0, + 0x1E2, 0x1E4, 0x1E6, 0x1E8, 0x1EA, 0x1EC, 0x1EE, 0x1F1, 0x1F4, + 0x1FA, 0x1FC, 0x1FE, 0x200, 0x202, 0x204, 0x206, 0x208, 0x20A, + 0x20C, 0x20E, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21A, 0x21C, + 0x21E, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22A, 0x22C, 0x22E, + 0x230, 0x232, 0x23A, 0x23B, 0x23D, 0x23E, 0x241, 0x248, 0x24A, + 0x24C, 0x24E, 0x370, 0x372, 0x376, 0x37F, 0x386, 0x38C, 0x38E, + 0x38F, 0x3CF, 0x3D8, 0x3DA, 0x3DC, 0x3DE, 0x3E0, 0x3E2, 0x3E4, + 0x3E6, 0x3E8, 0x3EA, 0x3EC, 0x3EE, 0x3F4, 0x3F7, 0x3F9, 0x3FA, + 0x460, 0x462, 0x464, 0x466, 0x468, 0x46A, 0x46C, 0x46E, 0x470, + 0x472, 0x474, 0x476, 0x478, 0x47A, 0x47C, 0x47E, 0x480, 0x48A, + 0x48C, 0x48E, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49A, 0x49C, + 0x49E, 0x4A0, 0x4A2, 0x4A4, 0x4A6, 0x4A8, 0x4AA, 0x4AC, 0x4AE, + 0x4B0, 0x4B2, 0x4B4, 0x4B6, 0x4B8, 0x4BA, 0x4BC, 0x4BE, 0x4C0, + 0x4C1, 0x4C3, 0x4C5, 0x4C7, 0x4C9, 0x4CB, 0x4CD, 0x4D0, 0x4D2, + 0x4D4, 0x4D6, 0x4D8, 0x4DA, 0x4DC, 0x4DE, 0x4E0, 0x4E2, 0x4E4, + 0x4E6, 0x4E8, 0x4EA, 0x4EC, 0x4EE, 0x4F0, 0x4F2, 0x4F4, 0x4F6, + 0x4F8, 0x4FA, 0x4FC, 0x4FE, 0x500, 0x502, 0x504, 0x506, 0x508, + 0x50A, 0x50C, 0x50E, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51A, + 0x51C, 0x51E, 0x520, 0x522, 0x524, 0x526, 0x528, 0x52A, 0x52C, + 0x52E, 0x10C7, 0x10CD, 0x1E00, 0x1E02, 0x1E04, 0x1E06, 0x1E08, 0x1E0A, + 0x1E0C, 0x1E0E, 0x1E10, 0x1E12, 0x1E14, 0x1E16, 0x1E18, 0x1E1A, 0x1E1C, + 0x1E1E, 0x1E20, 0x1E22, 0x1E24, 0x1E26, 0x1E28, 0x1E2A, 0x1E2C, 0x1E2E, + 0x1E30, 0x1E32, 0x1E34, 0x1E36, 0x1E38, 0x1E3A, 0x1E3C, 0x1E3E, 0x1E40, + 0x1E42, 0x1E44, 0x1E46, 0x1E48, 0x1E4A, 0x1E4C, 0x1E4E, 0x1E50, 0x1E52, + 0x1E54, 0x1E56, 0x1E58, 0x1E5A, 0x1E5C, 0x1E5E, 0x1E60, 0x1E62, 0x1E64, + 0x1E66, 0x1E68, 0x1E6A, 0x1E6C, 0x1E6E, 0x1E70, 0x1E72, 0x1E74, 0x1E76, + 0x1E78, 0x1E7A, 0x1E7C, 0x1E7E, 0x1E80, 0x1E82, 0x1E84, 0x1E86, 0x1E88, + 0x1E8A, 0x1E8C, 0x1E8E, 0x1E90, 0x1E92, 0x1E94, 0x1E9E, 0x1EA0, 0x1EA2, + 0x1EA4, 0x1EA6, 0x1EA8, 0x1EAA, 0x1EAC, 0x1EAE, 0x1EB0, 0x1EB2, 0x1EB4, + 0x1EB6, 0x1EB8, 0x1EBA, 0x1EBC, 0x1EBE, 0x1EC0, 0x1EC2, 0x1EC4, 0x1EC6, + 0x1EC8, 0x1ECA, 0x1ECC, 0x1ECE, 0x1ED0, 0x1ED2, 0x1ED4, 0x1ED6, 0x1ED8, + 0x1EDA, 0x1EDC, 0x1EDE, 0x1EE0, 0x1EE2, 0x1EE4, 0x1EE6, 0x1EE8, 0x1EEA, + 0x1EEC, 0x1EEE, 0x1EF0, 0x1EF2, 0x1EF4, 0x1EF6, 0x1EF8, 0x1EFA, 0x1EFC, + 0x1EFE, 0x1F59, 0x1F5B, 0x1F5D, 0x1F5F, 0x2102, 0x2107, 0x2115, 0x2124, + 0x2126, 0x2128, 0x213E, 0x213F, 0x2145, 0x2183, 0x2C60, 0x2C67, 0x2C69, + 0x2C6B, 0x2C72, 0x2C75, 0x2C82, 0x2C84, 0x2C86, 0x2C88, 0x2C8A, 0x2C8C, + 0x2C8E, 0x2C90, 0x2C92, 0x2C94, 0x2C96, 0x2C98, 0x2C9A, 0x2C9C, 0x2C9E, + 0x2CA0, 0x2CA2, 0x2CA4, 0x2CA6, 0x2CA8, 0x2CAA, 0x2CAC, 0x2CAE, 0x2CB0, + 0x2CB2, 0x2CB4, 0x2CB6, 0x2CB8, 0x2CBA, 0x2CBC, 0x2CBE, 0x2CC0, 0x2CC2, + 0x2CC4, 0x2CC6, 0x2CC8, 0x2CCA, 0x2CCC, 0x2CCE, 0x2CD0, 0x2CD2, 0x2CD4, + 0x2CD6, 0x2CD8, 0x2CDA, 0x2CDC, 0x2CDE, 0x2CE0, 0x2CE2, 0x2CEB, 0x2CED, + 0x2CF2, 0xA640, 0xA642, 0xA644, 0xA646, 0xA648, 0xA64A, 0xA64C, 0xA64E, + 0xA650, 0xA652, 0xA654, 0xA656, 0xA658, 0xA65A, 0xA65C, 0xA65E, 0xA660, + 0xA662, 0xA664, 0xA666, 0xA668, 0xA66A, 0xA66C, 0xA680, 0xA682, 0xA684, + 0xA686, 0xA688, 0xA68A, 0xA68C, 0xA68E, 0xA690, 0xA692, 0xA694, 0xA696, + 0xA698, 0xA69A, 0xA722, 0xA724, 0xA726, 0xA728, 0xA72A, 0xA72C, 0xA72E, + 0xA732, 0xA734, 0xA736, 0xA738, 0xA73A, 0xA73C, 0xA73E, 0xA740, 0xA742, + 0xA744, 0xA746, 0xA748, 0xA74A, 0xA74C, 0xA74E, 0xA750, 0xA752, 0xA754, + 0xA756, 0xA758, 0xA75A, 0xA75C, 0xA75E, 0xA760, 0xA762, 0xA764, 0xA766, + 0xA768, 0xA76A, 0xA76C, 0xA76E, 0xA779, 0xA77B, 0xA77D, 0xA77E, 0xA780, + 0xA782, 0xA784, 0xA786, 0xA78B, 0xA78D, 0xA790, 0xA792, 0xA796, 0xA798, + 0xA79A, 0xA79C, 0xA79E, 0xA7A0, 0xA7A2, 0xA7A4, 0xA7A6, 0xA7A8, 0xA7B6, + 0xA7B8, 0xA7BA, 0xA7BC, 0xA7BE, 0xA7C2, 0xA7C9, 0xA7F5 #if CHRBITS > 16 - ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538, - 0x1d539, 0x1d546, 0x1d7ca + ,0x1D49C, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D504, 0x1D505, 0x1D538, + 0x1D539, 0x1D546, 0x1D7CA #endif }; #define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr)) @@ -621,185 +625,190 @@ /* * Unicode: unicode print characters excluding space. */ static const crange graphRangeTable[] = { - {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f}, - {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556}, - {0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea}, - {0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d}, - {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d}, - {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4}, - {0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c}, - {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, - {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03}, - {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42}, - {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {0xa81, 0xa83}, - {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0}, - {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd}, - {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03}, - {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, - {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, - {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, - {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, - {0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, - {0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d}, - {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc77, 0xc8c}, - {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, - {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, - {0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, - {0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, - {0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, - {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, - {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe86, 0xe8a}, - {0xe8c, 0xea3}, {0xea7, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, - {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, - {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda}, - {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, - {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, - {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, - {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, - {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f}, - {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714}, - {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770}, - {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d}, - {0x1810, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18aa}, {0x18b0, 0x18f5}, - {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d}, - {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da}, - {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, - {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, - {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, - {0x1c4d, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cfa}, - {0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, - {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, - {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, - {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, - {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0}, - {0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73}, - {0x2b76, 0x2b95}, {0x2b98, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, - {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, - {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, - {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4f}, - {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, - {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f}, - {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e}, - {0x3220, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c}, {0xa490, 0xa4c6}, - {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7bf}, {0xa7c2, 0xa7c6}, - {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5}, - {0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, - {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, - {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06}, - {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e}, - {0xab30, 0xab67}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, - {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, - {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, - {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, - {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66}, - {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe}, - {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}, - {0xffe0, 0xffe6}, {0xffe8, 0xffee} + {0x21, 0x7E}, {0xA1, 0xAC}, {0xAE, 0x377}, {0x37A, 0x37F}, + {0x384, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x52F}, {0x531, 0x556}, + {0x559, 0x58A}, {0x58D, 0x58F}, {0x591, 0x5C7}, {0x5D0, 0x5EA}, + {0x5EF, 0x5F4}, {0x606, 0x61B}, {0x61E, 0x6DC}, {0x6DE, 0x70D}, + {0x710, 0x74A}, {0x74D, 0x7B1}, {0x7C0, 0x7FA}, {0x7FD, 0x82D}, + {0x830, 0x83E}, {0x840, 0x85B}, {0x860, 0x86A}, {0x8A0, 0x8B4}, + {0x8B6, 0x8C7}, {0x8D3, 0x8E1}, {0x8E3, 0x983}, {0x985, 0x98C}, + {0x993, 0x9A8}, {0x9AA, 0x9B0}, {0x9B6, 0x9B9}, {0x9BC, 0x9C4}, + {0x9CB, 0x9CE}, {0x9DF, 0x9E3}, {0x9E6, 0x9FE}, {0xA01, 0xA03}, + {0xA05, 0xA0A}, {0xA13, 0xA28}, {0xA2A, 0xA30}, {0xA3E, 0xA42}, + {0xA4B, 0xA4D}, {0xA59, 0xA5C}, {0xA66, 0xA76}, {0xA81, 0xA83}, + {0xA85, 0xA8D}, {0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, + {0xAB5, 0xAB9}, {0xABC, 0xAC5}, {0xAC7, 0xAC9}, {0xACB, 0xACD}, + {0xAE0, 0xAE3}, {0xAE6, 0xAF1}, {0xAF9, 0xAFF}, {0xB01, 0xB03}, + {0xB05, 0xB0C}, {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, + {0xB3C, 0xB44}, {0xB4B, 0xB4D}, {0xB55, 0xB57}, {0xB5F, 0xB63}, + {0xB66, 0xB77}, {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, + {0xBA8, 0xBAA}, {0xBAE, 0xBB9}, {0xBBE, 0xBC2}, {0xBC6, 0xBC8}, + {0xBCA, 0xBCD}, {0xBE6, 0xBFA}, {0xC00, 0xC0C}, {0xC0E, 0xC10}, + {0xC12, 0xC28}, {0xC2A, 0xC39}, {0xC3D, 0xC44}, {0xC46, 0xC48}, + {0xC4A, 0xC4D}, {0xC58, 0xC5A}, {0xC60, 0xC63}, {0xC66, 0xC6F}, + {0xC77, 0xC8C}, {0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, + {0xCB5, 0xCB9}, {0xCBC, 0xCC4}, {0xCC6, 0xCC8}, {0xCCA, 0xCCD}, + {0xCE0, 0xCE3}, {0xCE6, 0xCEF}, {0xD00, 0xD0C}, {0xD0E, 0xD10}, + {0xD12, 0xD44}, {0xD46, 0xD48}, {0xD4A, 0xD4F}, {0xD54, 0xD63}, + {0xD66, 0xD7F}, {0xD81, 0xD83}, {0xD85, 0xD96}, {0xD9A, 0xDB1}, + {0xDB3, 0xDBB}, {0xDC0, 0xDC6}, {0xDCF, 0xDD4}, {0xDD8, 0xDDF}, + {0xDE6, 0xDEF}, {0xDF2, 0xDF4}, {0xE01, 0xE3A}, {0xE3F, 0xE5B}, + {0xE86, 0xE8A}, {0xE8C, 0xEA3}, {0xEA7, 0xEBD}, {0xEC0, 0xEC4}, + {0xEC8, 0xECD}, {0xED0, 0xED9}, {0xEDC, 0xEDF}, {0xF00, 0xF47}, + {0xF49, 0xF6C}, {0xF71, 0xF97}, {0xF99, 0xFBC}, {0xFBE, 0xFCC}, + {0xFCE, 0xFDA}, {0x1000, 0x10C5}, {0x10D0, 0x1248}, {0x124A, 0x124D}, + {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D}, + {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5}, + {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A}, + {0x135D, 0x137C}, {0x1380, 0x1399}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD}, + {0x1400, 0x167F}, {0x1681, 0x169C}, {0x16A0, 0x16F8}, {0x1700, 0x170C}, + {0x170E, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176C}, + {0x176E, 0x1770}, {0x1780, 0x17DD}, {0x17E0, 0x17E9}, {0x17F0, 0x17F9}, + {0x1800, 0x180D}, {0x1810, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18AA}, + {0x18B0, 0x18F5}, {0x1900, 0x191E}, {0x1920, 0x192B}, {0x1930, 0x193B}, + {0x1944, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9}, + {0x19D0, 0x19DA}, {0x19DE, 0x1A1B}, {0x1A1E, 0x1A5E}, {0x1A60, 0x1A7C}, + {0x1A7F, 0x1A89}, {0x1A90, 0x1A99}, {0x1AA0, 0x1AAD}, {0x1AB0, 0x1AC0}, + {0x1B00, 0x1B4B}, {0x1B50, 0x1B7C}, {0x1B80, 0x1BF3}, {0x1BFC, 0x1C37}, + {0x1C3B, 0x1C49}, {0x1C4D, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CC7}, + {0x1CD0, 0x1CFA}, {0x1D00, 0x1DF9}, {0x1DFB, 0x1F15}, {0x1F18, 0x1F1D}, + {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57}, {0x1F5F, 0x1F7D}, + {0x1F80, 0x1FB4}, {0x1FB6, 0x1FC4}, {0x1FC6, 0x1FD3}, {0x1FD6, 0x1FDB}, + {0x1FDD, 0x1FEF}, {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFE}, {0x2010, 0x2027}, + {0x2030, 0x205E}, {0x2074, 0x208E}, {0x2090, 0x209C}, {0x20A0, 0x20BF}, + {0x20D0, 0x20F0}, {0x2100, 0x218B}, {0x2190, 0x2426}, {0x2440, 0x244A}, + {0x2460, 0x2B73}, {0x2B76, 0x2B95}, {0x2B97, 0x2C2E}, {0x2C30, 0x2C5E}, + {0x2C60, 0x2CF3}, {0x2CF9, 0x2D25}, {0x2D30, 0x2D67}, {0x2D7F, 0x2D96}, + {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, + {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, + {0x2DE0, 0x2E52}, {0x2E80, 0x2E99}, {0x2E9B, 0x2EF3}, {0x2F00, 0x2FD5}, + {0x2FF0, 0x2FFB}, {0x3001, 0x303F}, {0x3041, 0x3096}, {0x3099, 0x30FF}, + {0x3105, 0x312F}, {0x3131, 0x318E}, {0x3190, 0x31E3}, {0x31F0, 0x321E}, + {0x3220, 0x9FFC}, {0xA000, 0xA48C}, {0xA490, 0xA4C6}, {0xA4D0, 0xA62B}, + {0xA640, 0xA6F7}, {0xA700, 0xA7BF}, {0xA7C2, 0xA7CA}, {0xA7F5, 0xA82C}, + {0xA830, 0xA839}, {0xA840, 0xA877}, {0xA880, 0xA8C5}, {0xA8CE, 0xA8D9}, + {0xA8E0, 0xA953}, {0xA95F, 0xA97C}, {0xA980, 0xA9CD}, {0xA9CF, 0xA9D9}, + {0xA9DE, 0xA9FE}, {0xAA00, 0xAA36}, {0xAA40, 0xAA4D}, {0xAA50, 0xAA59}, + {0xAA5C, 0xAAC2}, {0xAADB, 0xAAF6}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, + {0xAB11, 0xAB16}, {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB6B}, + {0xAB70, 0xABED}, {0xABF0, 0xABF9}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, + {0xD7CB, 0xD7FB}, {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, + {0xFB13, 0xFB17}, {0xFB1D, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBC1}, + {0xFBD3, 0xFD3F}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7}, {0xFDF0, 0xFDFD}, + {0xFE00, 0xFE19}, {0xFE20, 0xFE52}, {0xFE54, 0xFE66}, {0xFE68, 0xFE6B}, + {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF01, 0xFFBE}, {0xFFC2, 0xFFC7}, + {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC}, {0xFFE0, 0xFFE6}, + {0xFFE8, 0xFFEE} #if CHRBITS > 16 - ,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d}, - {0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133}, - {0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c}, - {0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x1032d, 0x1034a}, - {0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, - {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb}, + ,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D}, + {0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10100, 0x10102}, {0x10107, 0x10133}, + {0x10137, 0x1018E}, {0x10190, 0x1019C}, {0x101D0, 0x101FD}, {0x10280, 0x1029C}, + {0x102A0, 0x102D0}, {0x102E0, 0x102FB}, {0x10300, 0x10323}, {0x1032D, 0x1034A}, + {0x10350, 0x1037A}, {0x10380, 0x1039D}, {0x1039F, 0x103C3}, {0x103C8, 0x103D5}, + {0x10400, 0x1049D}, {0x104A0, 0x104A9}, {0x104B0, 0x104D3}, {0x104D8, 0x104FB}, {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755}, - {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855}, - {0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b}, - {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03}, - {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a}, - {0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, - {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, - {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, - {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39}, - {0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x10fe0, 0x10ff6}, - {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, - {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, - {0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, - {0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, - {0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, - {0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, - {0x11335, 0x11339}, {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, - {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x1145d, 0x1145f}, - {0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, - {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b8}, - {0x116c0, 0x116c9}, {0x11700, 0x1171a}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, - {0x11800, 0x1183b}, {0x118a0, 0x118f2}, {0x119a0, 0x119a7}, {0x119aa, 0x119d7}, - {0x119da, 0x119e4}, {0x11a00, 0x11a47}, {0x11a50, 0x11aa2}, {0x11ac0, 0x11af8}, - {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c}, - {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06}, - {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65}, - {0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8}, - {0x11fc0, 0x11ff1}, {0x11fff, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, - {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, - {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, - {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, - {0x16b7d, 0x16b8f}, {0x16e40, 0x16e9a}, {0x16f00, 0x16f4a}, {0x16f4f, 0x16f87}, - {0x16f8f, 0x16f9f}, {0x16fe0, 0x16fe3}, {0x17000, 0x187f7}, {0x18800, 0x18af2}, - {0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb}, - {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, - {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, - {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356}, - {0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, - {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, - {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, - {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, - {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, - {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e100, 0x1e12c}, - {0x1e130, 0x1e13d}, {0x1e140, 0x1e149}, {0x1e2c0, 0x1e2f9}, {0x1e800, 0x1e8c4}, - {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94b}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4}, - {0x1ed01, 0x1ed3d}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, - {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, - {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, - {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, - {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, - {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f16c}, {0x1f170, 0x1f1ac}, - {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, - {0x1f300, 0x1f6d5}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6fa}, {0x1f700, 0x1f773}, - {0x1f780, 0x1f7d8}, {0x1f7e0, 0x1f7eb}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, - {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, - {0x1f90d, 0x1f971}, {0x1f973, 0x1f976}, {0x1f97a, 0x1f9a2}, {0x1f9a5, 0x1f9aa}, - {0x1f9ae, 0x1f9ca}, {0x1f9cd, 0x1fa53}, {0x1fa60, 0x1fa6d}, {0x1fa70, 0x1fa73}, - {0x1fa78, 0x1fa7a}, {0x1fa80, 0x1fa82}, {0x1fa90, 0x1fa95}, {0x20000, 0x2a6d6}, - {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, - {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef} + {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080A, 0x10835}, {0x1083F, 0x10855}, + {0x10857, 0x1089E}, {0x108A7, 0x108AF}, {0x108E0, 0x108F2}, {0x108FB, 0x1091B}, + {0x1091F, 0x10939}, {0x10980, 0x109B7}, {0x109BC, 0x109CF}, {0x109D2, 0x10A03}, + {0x10A0C, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35}, {0x10A38, 0x10A3A}, + {0x10A3F, 0x10A48}, {0x10A50, 0x10A58}, {0x10A60, 0x10A9F}, {0x10AC0, 0x10AE6}, + {0x10AEB, 0x10AF6}, {0x10B00, 0x10B35}, {0x10B39, 0x10B55}, {0x10B58, 0x10B72}, + {0x10B78, 0x10B91}, {0x10B99, 0x10B9C}, {0x10BA9, 0x10BAF}, {0x10C00, 0x10C48}, + {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10CFA, 0x10D27}, {0x10D30, 0x10D39}, + {0x10E60, 0x10E7E}, {0x10E80, 0x10EA9}, {0x10EAB, 0x10EAD}, {0x10F00, 0x10F27}, + {0x10F30, 0x10F59}, {0x10FB0, 0x10FCB}, {0x10FE0, 0x10FF6}, {0x11000, 0x1104D}, + {0x11052, 0x1106F}, {0x1107F, 0x110BC}, {0x110BE, 0x110C1}, {0x110D0, 0x110E8}, + {0x110F0, 0x110F9}, {0x11100, 0x11134}, {0x11136, 0x11147}, {0x11150, 0x11176}, + {0x11180, 0x111DF}, {0x111E1, 0x111F4}, {0x11200, 0x11211}, {0x11213, 0x1123E}, + {0x11280, 0x11286}, {0x1128A, 0x1128D}, {0x1128F, 0x1129D}, {0x1129F, 0x112A9}, + {0x112B0, 0x112EA}, {0x112F0, 0x112F9}, {0x11300, 0x11303}, {0x11305, 0x1130C}, + {0x11313, 0x11328}, {0x1132A, 0x11330}, {0x11335, 0x11339}, {0x1133B, 0x11344}, + {0x1134B, 0x1134D}, {0x1135D, 0x11363}, {0x11366, 0x1136C}, {0x11370, 0x11374}, + {0x11400, 0x1145B}, {0x1145D, 0x11461}, {0x11480, 0x114C7}, {0x114D0, 0x114D9}, + {0x11580, 0x115B5}, {0x115B8, 0x115DD}, {0x11600, 0x11644}, {0x11650, 0x11659}, + {0x11660, 0x1166C}, {0x11680, 0x116B8}, {0x116C0, 0x116C9}, {0x11700, 0x1171A}, + {0x1171D, 0x1172B}, {0x11730, 0x1173F}, {0x11800, 0x1183B}, {0x118A0, 0x118F2}, + {0x118FF, 0x11906}, {0x1190C, 0x11913}, {0x11918, 0x11935}, {0x1193B, 0x11946}, + {0x11950, 0x11959}, {0x119A0, 0x119A7}, {0x119AA, 0x119D7}, {0x119DA, 0x119E4}, + {0x11A00, 0x11A47}, {0x11A50, 0x11AA2}, {0x11AC0, 0x11AF8}, {0x11C00, 0x11C08}, + {0x11C0A, 0x11C36}, {0x11C38, 0x11C45}, {0x11C50, 0x11C6C}, {0x11C70, 0x11C8F}, + {0x11C92, 0x11CA7}, {0x11CA9, 0x11CB6}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D36}, + {0x11D3F, 0x11D47}, {0x11D50, 0x11D59}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D8E}, + {0x11D93, 0x11D98}, {0x11DA0, 0x11DA9}, {0x11EE0, 0x11EF8}, {0x11FC0, 0x11FF1}, + {0x11FFF, 0x12399}, {0x12400, 0x1246E}, {0x12470, 0x12474}, {0x12480, 0x12543}, + {0x13000, 0x1342E}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E}, + {0x16A60, 0x16A69}, {0x16AD0, 0x16AED}, {0x16AF0, 0x16AF5}, {0x16B00, 0x16B45}, + {0x16B50, 0x16B59}, {0x16B5B, 0x16B61}, {0x16B63, 0x16B77}, {0x16B7D, 0x16B8F}, + {0x16E40, 0x16E9A}, {0x16F00, 0x16F4A}, {0x16F4F, 0x16F87}, {0x16F8F, 0x16F9F}, + {0x16FE0, 0x16FE4}, {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, + {0x1B000, 0x1B11E}, {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, + {0x1BC00, 0x1BC6A}, {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, + {0x1BC9C, 0x1BC9F}, {0x1D000, 0x1D0F5}, {0x1D100, 0x1D126}, {0x1D129, 0x1D172}, + {0x1D17B, 0x1D1E8}, {0x1D200, 0x1D245}, {0x1D2E0, 0x1D2F3}, {0x1D300, 0x1D356}, + {0x1D360, 0x1D378}, {0x1D400, 0x1D454}, {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC}, + {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A}, + {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E}, + {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D7CB}, + {0x1D7CE, 0x1DA8B}, {0x1DA9B, 0x1DA9F}, {0x1DAA1, 0x1DAAF}, {0x1E000, 0x1E006}, + {0x1E008, 0x1E018}, {0x1E01B, 0x1E021}, {0x1E026, 0x1E02A}, {0x1E100, 0x1E12C}, + {0x1E130, 0x1E13D}, {0x1E140, 0x1E149}, {0x1E2C0, 0x1E2F9}, {0x1E800, 0x1E8C4}, + {0x1E8C7, 0x1E8D6}, {0x1E900, 0x1E94B}, {0x1E950, 0x1E959}, {0x1EC71, 0x1ECB4}, + {0x1ED01, 0x1ED3D}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32}, + {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72}, + {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B}, + {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x1F000, 0x1F02B}, + {0x1F030, 0x1F093}, {0x1F0A0, 0x1F0AE}, {0x1F0B1, 0x1F0BF}, {0x1F0C1, 0x1F0CF}, + {0x1F0D1, 0x1F0F5}, {0x1F100, 0x1F1AD}, {0x1F1E6, 0x1F202}, {0x1F210, 0x1F23B}, + {0x1F240, 0x1F248}, {0x1F260, 0x1F265}, {0x1F300, 0x1F6D7}, {0x1F6E0, 0x1F6EC}, + {0x1F6F0, 0x1F6FC}, {0x1F700, 0x1F773}, {0x1F780, 0x1F7D8}, {0x1F7E0, 0x1F7EB}, + {0x1F800, 0x1F80B}, {0x1F810, 0x1F847}, {0x1F850, 0x1F859}, {0x1F860, 0x1F887}, + {0x1F890, 0x1F8AD}, {0x1F900, 0x1F978}, {0x1F97A, 0x1F9CB}, {0x1F9CD, 0x1FA53}, + {0x1FA60, 0x1FA6D}, {0x1FA70, 0x1FA74}, {0x1FA78, 0x1FA7A}, {0x1FA80, 0x1FA86}, + {0x1FA90, 0x1FAA8}, {0x1FAB0, 0x1FAB6}, {0x1FAC0, 0x1FAC2}, {0x1FAD0, 0x1FAD6}, + {0x1FB00, 0x1FB92}, {0x1FB94, 0x1FBCA}, {0x1FBF0, 0x1FBF9}, {0x20000, 0x2A6DD}, + {0x2A700, 0x2B734}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, + {0x2F800, 0x2FA1D}, {0x30000, 0x3134A}, {0xE0100, 0xE01EF} #endif }; #define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange)) static const chr graphCharTable[] = { - 0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc, - 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39, - 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f, - 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d, - 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, - 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2, - 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xea5, - 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, - 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, - 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd + 0x38C, 0x85E, 0x98F, 0x990, 0x9B2, 0x9C7, 0x9C8, 0x9D7, 0x9DC, + 0x9DD, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36, 0xA38, 0xA39, + 0xA3C, 0xA47, 0xA48, 0xA51, 0xA5E, 0xAB2, 0xAB3, 0xAD0, 0xB0F, + 0xB10, 0xB32, 0xB33, 0xB47, 0xB48, 0xB5C, 0xB5D, 0xB82, 0xB83, + 0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0, 0xBD7, + 0xC55, 0xC56, 0xCD5, 0xCD6, 0xCDE, 0xCF1, 0xCF2, 0xDBD, 0xDCA, + 0xDD6, 0xE81, 0xE82, 0xE84, 0xEA5, 0xEC6, 0x10C7, 0x10CD, 0x1258, + 0x12C0, 0x1772, 0x1773, 0x1940, 0x1F59, 0x1F5B, 0x1F5D, 0x2070, 0x2071, + 0x2D27, 0x2D2D, 0x2D6F, 0x2D70, 0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44, + 0xFFFC, 0xFFFD #if CHRBITS > 16 - ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, - 0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333, - 0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x118ff, 0x11d08, 0x11d09, 0x11d3a, - 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e, 0x16a6f, 0x1d49e, - 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e14e, - 0x1e14f, 0x1e2ff, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, - 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, - 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, - 0x1eef1, 0x1f250, 0x1f251 + ,0x1003C, 0x1003D, 0x101A0, 0x1056F, 0x10808, 0x10837, 0x10838, 0x1083C, 0x108F4, + 0x108F5, 0x1093F, 0x10A05, 0x10A06, 0x10EB0, 0x10EB1, 0x11288, 0x1130F, 0x11310, + 0x11332, 0x11333, 0x11347, 0x11348, 0x11350, 0x11357, 0x11909, 0x11915, 0x11916, + 0x11937, 0x11938, 0x11D08, 0x11D09, 0x11D3A, 0x11D3C, 0x11D3D, 0x11D67, 0x11D68, + 0x11D90, 0x11D91, 0x11FB0, 0x16A6E, 0x16A6F, 0x16FF0, 0x16FF1, 0x1D49E, 0x1D49F, + 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E023, 0x1E024, 0x1E14E, 0x1E14F, + 0x1E2FF, 0x1E95E, 0x1E95F, 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, + 0x1EE42, 0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, + 0x1EE5B, 0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E, 0x1EEF0, 0x1EEF1, + 0x1F250, 0x1F251, 0x1F8B0, 0x1F8B1 #endif }; #define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr)) /* * End of auto-generated Unicode character ranges declarations. */ + +#define CH NOCELT /* - element - map collating-element name to celt ^ static celt element(struct vars *, const chr *, const chr *); */ @@ -888,13 +897,13 @@ cv = getcvec(v, nchrs, 0); NOERRN(); for (c=a; c<=b; c++) { addchr(cv, c); - lc = Tcl_UniCharToLower(c); - uc = Tcl_UniCharToUpper(c); - tc = Tcl_UniCharToTitle(c); + lc = Tcl_UniCharToLower((chr)c); + uc = Tcl_UniCharToUpper((chr)c); + tc = Tcl_UniCharToTitle((chr)c); if (c != lc) { addchr(cv, lc); } if (c != uc) { addchr(cv, uc); @@ -939,15 +948,15 @@ * Crude fake equivalence class for testing. */ if ((v->cflags®_FAKE) && c == 'x') { cv = getcvec(v, 4, 0); - addchr(cv, 'x'); - addchr(cv, 'y'); + addchr(cv, (chr)'x'); + addchr(cv, (chr)'y'); if (cases) { - addchr(cv, 'X'); - addchr(cv, 'Y'); + addchr(cv, (chr)'X'); + addchr(cv, (chr)'Y'); } return cv; } /* @@ -957,11 +966,11 @@ if (cases) { return allcases(v, c); } cv = getcvec(v, 1, 0); assert(cv != NULL); - addchr(cv, c); + addchr(cv, (chr)c); return cv; } /* - cclass - supply cvec for a character class @@ -978,12 +987,11 @@ size_t len; struct cvec *cv = NULL; Tcl_DString ds; const char *np; const char *const *namePtr; - size_t i; - int index; + int i, index; /* * The following arrays define the valid character class names. */ @@ -1002,11 +1010,11 @@ * Extract the class name */ len = endp - startp; Tcl_DStringInit(&ds); - np = Tcl_UniCharToUtfDString(startp, len, &ds); + np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); /* * Map the name to the corresponding enumerated value. */ @@ -1037,39 +1045,39 @@ switch((enum classes) index) { case CC_ALNUM: cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE); if (cv) { - for (i=0 ; iparent == NULL) { dumpcolors(nfa->cm, f); } fflush(f); +#else + (void)nfa; + (void)f; #endif } #ifdef REG_DEBUG /* subordinates of dumpnfa */ /* @@ -3155,10 +3158,13 @@ fprintf(f, "\n"); for (st = 0; st < cnfa->nstates; st++) { dumpcstate(st, cnfa, f); } fflush(f); +#else + (void)cnfa; + (void)f; #endif } #ifdef REG_DEBUG /* subordinates of dumpcnfa */ /* Index: generic/regcomp.c ================================================================== --- generic/regcomp.c +++ generic/regcomp.c @@ -37,11 +37,11 @@ */ /* =====^!^===== begin forwards =====^!^===== */ /* automatically gathered by fwd; do not hand-edit */ /* === regcomp.c === */ int compile(regex_t *, const chr *, size_t, int); -static void moresubs(struct vars *, size_t); +static void moresubs(struct vars *, int); static int freev(struct vars *, int); static void makesearch(struct vars *, struct nfa *); static struct subre *parse(struct vars *, int, int, struct state *, struct state *); static struct subre *parsebranch(struct vars *, int, int, struct state *, struct state *, int); static void parseqatom(struct vars *, int, int, struct state *, struct state *, struct subre *); @@ -57,11 +57,10 @@ static void dovec(struct vars *, struct cvec *, struct state *, struct state *); static void wordchrs(struct vars *); static struct subre *subre(struct vars *, int, int, struct state *, struct state *); static void freesubre(struct vars *, struct subre *); static void freesrnode(struct vars *, struct subre *); -static void optst(struct vars *, struct subre *); static int numst(struct subre *, int); static void markst(struct subre *); static void cleanst(struct vars *); static long nfatree(struct vars *, struct subre *, FILE *); static long nfanode(struct vars *, struct subre *, FILE *); @@ -242,10 +241,11 @@ #define INSIST(c, e) do { if (!(c)) ERR(e); } while (0) /* error if c false */ #define NOTE(b) (v->re->re_info |= (b)) /* note visible condition */ #define EMPTYARC(x, y) newarc(v->nfa, EMPTY, 0, x, y) /* token type codes, some also used as NFA arc types */ +#undef DIGIT /* prevent conflict with libtommath */ #define EMPTY 'n' /* no token present */ #define EOS 'e' /* end of string */ #define PLAIN 'p' /* ordinary character */ #define DIGIT 'd' /* digit (in bound) */ #define BACKREF 'b' /* back reference */ @@ -336,10 +336,11 @@ v->lacons = NULL; v->nlacons = 0; v->spaceused = 0; re->re_magic = REMAGIC; re->re_info = 0; /* bits get set during parse */ + re->re_csize = sizeof(chr); re->re_guts = NULL; re->re_fns = (void*)(&functions); /* * More complex setup, malloced things. @@ -391,11 +392,10 @@ if (debug != NULL) { fprintf(debug, "\n\n\n========= RAW ==========\n"); dumpnfa(v->nfa, debug); dumpst(v->tree, debug, 1); } - optst(v, v->tree); v->ntree = numst(v->tree, 1); markst(v->tree); cleanst(v); if (debug != NULL) { fprintf(debug, "\n\n\n========= TREE FIXED ==========\n"); @@ -465,16 +465,16 @@ return freev(v, 0); } /* - moresubs - enlarge subRE vector - ^ static void moresubs(struct vars *, size_t); + ^ static void moresubs(struct vars *, int); */ static void moresubs( struct vars *v, - size_t wanted) /* want enough room for this one */ + int wanted) /* want enough room for this one */ { struct subre **p; int n; assert(wanted > 0 && wanted >= v->nsubs); @@ -509,11 +509,11 @@ static int freev( struct vars *v, int err) { - register int ret; + int ret; if (v->re != NULL) { rfree(v->re); } if (v->subs != v->sub10) { @@ -806,11 +806,11 @@ */ atom = NULL; assert(lp->nouts == 0); /* must string new code */ assert(rp->nins == 0); /* between lp and rp */ - subno = 0; /* just to shut lint up */ + subno = 0; /* * An atom or constraint... */ @@ -919,11 +919,11 @@ /* * Legal in EREs due to specification botch. */ NOTE(REG_UPBOTCH); - /* fallthrough into case PLAIN */ + /* FALLTHRU */ case PLAIN: onechr(v, v->nextvalue, lp, rp); okcolors(v->nfa, v->cm); NOERR(); NEXT(); @@ -1806,29 +1806,10 @@ v->treefree = sr; } else { FREE(sr); } } - -/* - - optst - optimize a subRE subtree - ^ static void optst(struct vars *, struct subre *); - */ -static void -optst( - struct vars *v, - struct subre *t) -{ - /* - * DGP (2007-11-13): I assume it was the programmer's intent to eventually - * come back and add code to optimize subRE trees, but the routine coded - * just spends effort traversing the tree and doing nothing. We can do - * nothing with less effort. - */ - - return; -} /* - numst - number tree nodes (assigning "id" indexes) ^ static int numst(struct subre *, int); */ @@ -2082,12 +2063,12 @@ fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic, GUTSMAGIC); } fprintf(f, "\n\n\n========= DUMP ==========\n"); - fprintf(f, "nsub %" TCL_Z_MODIFIER "d, info 0%lo, ntree %d\n", - re->re_nsub, re->re_info, g->ntree); + fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n", + (int) re->re_nsub, re->re_info, re->re_csize, g->ntree); dumpcolors(&g->cmap, f); if (!NULLCNFA(g->search)) { fprintf(f, "\nsearch:\n"); dumpcnfa(&g->search, f); @@ -2097,10 +2078,13 @@ (g->lacons[i].subno) ? "positive" : "negative"); dumpcnfa(&g->lacons[i].cnfa, f); } fprintf(f, "\n"); dumpst(g->tree, f, 0); +#else + (void)re; + (void)f; #endif } /* - dumpst - dump a subRE tree Index: generic/regcustom.h ================================================================== --- generic/regcustom.h +++ generic/regcustom.h @@ -34,13 +34,13 @@ /* * Overrides for regguts.h definitions, if any. */ -#define MALLOC(n) Tcl_AttemptAlloc(n) -#define FREE(p) Tcl_Free(p) -#define REALLOC(p,n) Tcl_AttemptRealloc(p,n) +#define MALLOC(n) (void*)(attemptckalloc(n)) +#define FREE(p) ckfree((void*)(p)) +#define REALLOC(p,n) (void*)(attemptckrealloc((void*)(p),n)) /* * Do not insert extras between the "begin" and "end" lines - this chunk is * automatically extracted to be fitted into regex.h. */ @@ -54,18 +54,22 @@ #undef __REG_WIDE_COMPILE #endif #ifdef __REG_WIDE_EXEC #undef __REG_WIDE_EXEC #endif +#ifdef __REG_REGOFF_T +#undef __REG_REGOFF_T +#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif #ifdef __REG_NOCHAR #undef __REG_NOCHAR #endif /* Interface types */ #define __REG_WIDE_T Tcl_UniChar +#define __REG_REGOFF_T long /* Not really right, but good enough... */ /* Names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec #define __REG_NOFRONT /* Don't want regcomp() and regexec() */ #define __REG_NOCHAR /* Or the char versions */ @@ -82,18 +86,18 @@ typedef unsigned uchr; /* Unsigned type that will hold a chr. */ typedef int celt; /* Type to hold chr, or NOCELT */ #define NOCELT (-1) /* Celt value which is not valid chr */ #define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */ #define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */ -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 #define CHRBITS 32 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */ -#define CHR_MAX 0x10ffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ +#define CHR_MAX 0x10FFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #else #define CHRBITS 16 /* Bits in a chr; must not use sizeof */ #define CHR_MIN 0x0000 /* Smallest and largest chr; the value */ -#define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */ +#define CHR_MAX 0xFFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */ #endif /* * Functions operating on chr. */ @@ -125,20 +129,20 @@ */ #if 1 #define AllocVars(vPtr) \ static Tcl_ThreadDataKey varsKey; \ - register struct vars *vPtr = (struct vars *) \ + struct vars *vPtr = (struct vars *) \ Tcl_GetThreadData(&varsKey, sizeof(struct vars)) #else /* * This strategy for allocating workspace is "more proper" in some sense, but * quite a bit slower. Using TSD (as above) leads to code that is quite a bit * faster in practice (measured!) */ #define AllocVars(vPtr) \ - register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) + struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars)) #define FreeVars(vPtr) \ FREE(vPtr) #endif /* Index: generic/regerror.c ================================================================== --- generic/regerror.c +++ generic/regerror.c @@ -52,15 +52,13 @@ }; /* - regerror - the interface to error numbers */ -/* ARGSUSED */ size_t /* Actual space needed (including NUL) */ regerror( int code, /* Error code, or REG_ATOI or REG_ITOA */ - const regex_t *preg, /* Associated regex_t (unused at present) */ char *errbuf, /* Result buffer (unless errbuf_size==0) */ size_t errbuf_size) /* Available space in errbuf, can be 0 */ { const struct rerr *r; const char *msg; @@ -86,11 +84,11 @@ } } if (r->code >= 0) { msg = r->name; } else { /* Unknown; tell him the number */ - sprintf(convbuf, "REG_%u", icode); + sprintf(convbuf, "REG_%u", (unsigned)icode); msg = convbuf; } break; default: /* A real, normal error code */ for (r = rerrs; r->code >= 0; r++) { Index: generic/regex.h ================================================================== --- generic/regex.h +++ generic/regex.h @@ -87,18 +87,22 @@ #undef __REG_WIDE_COMPILE #endif #ifdef __REG_WIDE_EXEC #undef __REG_WIDE_EXEC #endif +#ifdef __REG_REGOFF_T +#undef __REG_REGOFF_T +#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif #ifdef __REG_NOCHAR #undef __REG_NOCHAR #endif /* interface types */ #define __REG_WIDE_T Tcl_UniChar +#define __REG_REGOFF_T long /* not really right, but good enough... */ /* names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec #define __REG_NOFRONT /* don't want regcomp() and regexec() */ #define __REG_NOCHAR /* or the char versions */ @@ -108,19 +112,30 @@ /* * interface types etc. */ +/* + * regoff_t has to be large enough to hold either off_t or ssize_t, and must + * be signed; it's only a guess that long is suitable, so we offer + * an override. + */ +#ifdef __REG_REGOFF_T +typedef __REG_REGOFF_T regoff_t; +#else +typedef long regoff_t; +#endif + /* * other interface types */ /* the biggie, a compiled RE (or rather, a front end to same) */ typedef struct { int re_magic; /* magic number */ - long re_info; /* information about RE */ size_t re_nsub; /* number of subexpressions */ + long re_info; /* information about RE */ #define REG_UBACKREF 000001 #define REG_ULOOKAHEAD 000002 #define REG_UBOUNDS 000004 #define REG_UBRACES 000010 #define REG_UBSALNUM 000020 @@ -131,20 +146,21 @@ #define REG_UUNPORT 001000 #define REG_ULOCALE 002000 #define REG_UEMPTYMATCH 004000 #define REG_UIMPOSSIBLE 010000 #define REG_USHORTEST 020000 + int re_csize; /* sizeof(character) */ char *re_endp; /* backward compatibility kludge */ /* the rest is opaque pointers to hidden innards */ - char *re_guts; /* `char *' is more portable than `void *' */ - char *re_fns; + void *re_guts; + void *re_fns; } regex_t; /* result reporting (may acquire more fields later) */ typedef struct { - size_t rm_so; /* start of substring */ - size_t rm_eo; /* end of substring */ + regoff_t rm_so; /* start of substring */ + regoff_t rm_eo; /* end of substring */ } regmatch_t; /* supplementary control and reporting */ typedef struct { regmatch_t rm_extend; /* see REG_EXPECT */ @@ -214,11 +230,11 @@ * * Note that there is no wide-char variant of regerror at this time; what kind * of character is used for error reports is independent of what kind is used * in matching. * - ^ extern size_t regerror(int, const regex_t *, char *, size_t); + ^ extern size_t regerror(int, char *, size_t); */ #define REG_OKAY 0 /* no errors detected */ #define REG_NOMATCH 1 /* failed to match */ #define REG_BADPAT 2 /* invalid regexp */ #define REG_ECOLLATE 3 /* invalid collating element */ @@ -265,11 +281,11 @@ #endif #ifdef __REG_WIDE_T MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif MODULE_SCOPE void regfree(regex_t *); -MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t); +MODULE_SCOPE size_t regerror(int, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ /* * more C++ voodoo Index: generic/regexec.c ================================================================== --- generic/regexec.c +++ generic/regexec.c @@ -89,11 +89,10 @@ struct sset ssets[FEWSTATES*2]; unsigned statesarea[FEWSTATES*2 + WORK]; struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; -#define DOMALLOC ((struct smalldfa *)NULL) /* force malloc */ /* * Internal variables, bundled for easy passing around. */ @@ -127,11 +126,11 @@ /* === regexec.c === */ int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int); static struct dfa *getsubdfa(struct vars *, struct subre *); static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const); static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const); -static int complicatedFindLoop(struct vars *const, struct cnfa *const, struct colormap *const, struct dfa *const, struct dfa *const, chr **const); +static int complicatedFindLoop(struct vars *const, struct dfa *const, struct dfa *const, chr **const); static void zapallsubs(regmatch_t *const, const size_t); static void zaptreesubs(struct vars *const, struct subre *const); static void subset(struct vars *const, struct subre *const, chr *const, chr *const); static int cdissect(struct vars *, struct subre *, chr *, chr *); static int ccondissect(struct vars *, struct subre *, chr *, chr *); @@ -184,10 +183,14 @@ */ if (re == NULL || string == NULL || re->re_magic != REMAGIC) { FreeVars(v); return REG_INVARG; + } + if (re->re_csize != sizeof(chr)) { + FreeVars(v); + return REG_MIXED; } /* * Setup. */ @@ -293,11 +296,11 @@ static struct dfa * getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { - v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, DOMALLOC); + v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, NULL); if (ISERR()) return NULL; } return v->subdfas[t->id]; } @@ -428,11 +431,11 @@ assert(d == NULL); freeDFA(s); return v->err; } - ret = complicatedFindLoop(v, cnfa, cm, d, s, &cold); + ret = complicatedFindLoop(v, d, s, &cold); freeDFA(d); freeDFA(s); NOERR(); if (v->g->cflags®_EXPECT) { @@ -447,18 +450,16 @@ return ret; } /* - complicatedFindLoop - the heart of complicatedFind - ^ static int complicatedFindLoop(struct vars *, struct cnfa *, struct colormap *, + ^ static int complicatedFindLoop(struct vars *, ^ struct dfa *, struct dfa *, chr **); */ static int complicatedFindLoop( struct vars *const v, - struct cnfa *const cnfa, - struct colormap *const cm, struct dfa *const d, struct dfa *const s, chr **const coldp) /* where to put coldstart pointer */ { chr *begin, *end; Index: generic/regguts.h ================================================================== --- generic/regguts.h +++ generic/regguts.h @@ -72,11 +72,11 @@ #define NOTREACHED 0 #define DUPMAX _POSIX2_RE_DUP_MAX #define DUPINF (DUPMAX+1) -#define REMAGIC 0xfed7 /* magic number for main struct */ +#define REMAGIC 0xFED7 /* magic number for main struct */ /* * debugging facilities */ #ifdef REG_DEBUG @@ -388,11 +388,11 @@ * the insides of a regex_t, hidden behind a void * */ struct guts { int magic; -#define GUTSMAGIC 0xfed9 +#define GUTSMAGIC 0xFED9 int cflags; /* copy of compile flags */ long info; /* copy of re_info */ size_t nsub; /* copy of re_nsub */ struct subre *tree; struct cnfa search; /* for fast preliminary search */ @@ -409,11 +409,11 @@ */ #ifndef AllocVars #define AllocVars(vPtr) \ struct vars var; \ - register struct vars *vPtr = &var + struct vars *vPtr = &var #endif #ifndef FreeVars #define FreeVars(vPtr) ((void) 0) #endif Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -38,36 +38,36 @@ } declare 2 { TCL_NORETURN void Tcl_Panic(const char *format, ...) } declare 3 { - void *Tcl_Alloc(size_t size) + char *Tcl_Alloc(unsigned int size) } declare 4 { - void Tcl_Free(void *ptr) + void Tcl_Free(char *ptr) } declare 5 { - void *Tcl_Realloc(void *ptr, size_t size) + char *Tcl_Realloc(char *ptr, unsigned int size) } declare 6 { - void *Tcl_DbCkalloc(size_t size, const char *file, int line) + char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) } declare 7 { - void Tcl_DbCkfree(void *ptr, const char *file, int line) + void Tcl_DbCkfree(char *ptr, const char *file, int line) } declare 8 { - void *Tcl_DbCkrealloc(void *ptr, size_t size, + char *Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line) } # Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix, # but they are part of the old generic interface, so we include them here for # compatibility reasons. declare 9 unix { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, - void *clientData) + ClientData clientData) } declare 10 unix { void Tcl_DeleteFileHandler(int fd) } declare 11 { @@ -84,11 +84,11 @@ } declare 15 { void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) } declare 16 { - void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, size_t length) + void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length) } declare 17 { Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]) } declare 18 { @@ -102,16 +102,15 @@ void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line) } declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } -# Removed in 9.0 (changed to macro): -#declare 22 { -# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) -#} +declare 22 {deprecated {No longer in use, changed to macro}} { + Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) +} declare 23 { - Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, size_t length, + Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line) } declare 24 { Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line) @@ -118,28 +117,26 @@ } declare 25 { Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line) } -# Removed in 9.0 (changed to macro): -#declare 26 { -# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) -#} +declare 26 {deprecated {No longer in use, changed to macro}} { + Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) +} declare 27 { Tcl_Obj *Tcl_DbNewObj(const char *file, int line) } declare 28 { - Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, size_t length, + Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length, const char *file, int line) } declare 29 { Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr) } -# Removed in 9.0 -#declare 30 { -# void TclFreeObj(Tcl_Obj *objPtr) -#} +declare 30 { + void TclFreeObj(Tcl_Obj *objPtr) +} declare 31 { int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr) } declare 32 { int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -153,15 +150,14 @@ } declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } -# Removed in 9.0, replaced by macro. -#declare 36 {deprecated {No longer in use, changed to macro}} { -# int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, -# const char *const *tablePtr, const char *msg, int flags, int *indexPtr) -#} +declare 36 {deprecated {No longer in use, changed to macro}} { + int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + const char *const *tablePtr, const char *msg, int flags, int *indexPtr) +} declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) } declare 38 { int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr) @@ -168,11 +164,11 @@ } declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { - const Tcl_ObjType *Tcl_GetObjType(const char *typeName) + CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 42 { @@ -200,77 +196,69 @@ } declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]) } -# Removed in 9.0 (changed to macro): -#declare 49 { -# Tcl_Obj *Tcl_NewBooleanObj(int boolValue) -#} +declare 49 {deprecated {No longer in use, changed to macro}} { + Tcl_Obj *Tcl_NewBooleanObj(int boolValue) +} declare 50 { - Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, size_t length) + Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length) } declare 51 { Tcl_Obj *Tcl_NewDoubleObj(double doubleValue) } -# Removed in 9.0 (changed to macro): -#declare 52 { -# Tcl_Obj *Tcl_NewIntObj(int intValue) -#} +declare 52 {deprecated {No longer in use, changed to macro}} { + Tcl_Obj *Tcl_NewIntObj(int intValue) +} declare 53 { Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[]) } -# Removed in 9.0 (changed to macro): -#declare 54 { -# Tcl_Obj *Tcl_NewLongObj(long longValue) -#} +declare 54 {deprecated {No longer in use, changed to macro}} { + Tcl_Obj *Tcl_NewLongObj(long longValue) +} declare 55 { Tcl_Obj *Tcl_NewObj(void) } declare 56 { - Tcl_Obj *Tcl_NewStringObj(const char *bytes, size_t length) + Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length) } -# Removed in 9.0 (changed to macro): -#declare 57 { -# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) -#} +declare 57 {deprecated {No longer in use, changed to macro}} { + void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) +} declare 58 { - unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length) + unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length) } declare 59 { void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, - size_t length) + int length) } declare 60 { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) } -# Removed in 9.0 (changed to macro): -#declare 61 { -# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) -#} +declare 61 {deprecated {No longer in use, changed to macro}} { + void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) +} declare 62 { void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]) } -# Removed in 9.0 (changed to macro): -#declare 63 { -# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) -#} +declare 63 {deprecated {No longer in use, changed to macro}} { + void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) +} declare 64 { - void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length) + void Tcl_SetObjLength(Tcl_Obj *objPtr, int length) } declare 65 { - void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length) -} -# Removed in 9.0, replaced by macro. -#declare 66 {deprecated {No longer in use, changed to macro}} { -# void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) -#} -# Removed in 9.0, replaced by macro. -#declare 67 {deprecated {No longer in use, changed to macro}} { -# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, -# int length) -#} + void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length) +} +declare 66 {deprecated {No longer in use, changed to macro}} { + void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) +} +declare 67 {deprecated {No longer in use, changed to macro}} { + void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, + int length) +} declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } declare 69 { void Tcl_AppendElement(Tcl_Interp *interp, const char *element) @@ -278,11 +266,11 @@ declare 70 { void Tcl_AppendResult(Tcl_Interp *interp, ...) } declare 71 { Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - void *clientData) + ClientData clientData) } declare 72 { void Tcl_AsyncDelete(Tcl_AsyncHandler async) } declare 73 { @@ -292,28 +280,26 @@ void Tcl_AsyncMark(Tcl_AsyncHandler async) } declare 75 { int Tcl_AsyncReady(void) } -# Removed in 9.0 -#declare 76 {deprecated {No longer in use, changed to macro}} { -# void Tcl_BackgroundError(Tcl_Interp *interp) -#} -# Removed in 9.0: -#declare 77 {deprecated {Use Tcl_UtfBackslash}} { -# char Tcl_Backslash(const char *src, int *readPtr) -#} +declare 76 {deprecated {No longer in use, changed to macro}} { + void Tcl_BackgroundError(Tcl_Interp *interp) +} +declare 77 {deprecated {Use Tcl_UtfBackslash}} { + char Tcl_Backslash(const char *src, int *readPtr) +} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) } declare 79 { void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, - void *clientData) + ClientData clientData) } declare 80 { - void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData) + void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData) } declare 81 { int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) } declare 82 { @@ -321,14 +307,14 @@ } declare 83 { char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { - size_t Tcl_ConvertElement(const char *src, char *dst, int flags) + int Tcl_ConvertElement(const char *src, char *dst, int flags) } declare 85 { - size_t Tcl_ConvertCountedElement(const char *src, size_t length, char *dst, + int Tcl_ConvertCountedElement(const char *src, int length, char *dst, int flags) } declare 86 { int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, @@ -339,85 +325,84 @@ Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]) } declare 88 { Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, void *instanceData, int mask) + const char *chanName, ClientData instanceData, int mask) } declare 89 { void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, void *clientData) + Tcl_ChannelProc *proc, ClientData clientData) } declare 90 { void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - void *clientData) + ClientData clientData) } declare 91 { Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_CmdProc *proc, void *clientData, + Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 92 { void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, void *clientData) + Tcl_EventCheckProc *checkProc, ClientData clientData) } declare 93 { - void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData) + void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -# Removed in 9.0: -#declare 95 {deprecated {}} { -# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, -# int numArgs, Tcl_ValueType *argTypes, -# Tcl_MathProc *proc, void *clientData) -#} +declare 95 {deprecated {}} { + void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, + int numArgs, Tcl_ValueType *argTypes, + Tcl_MathProc *proc, ClientData clientData) +} declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_ObjCmdProc *proc, void *clientData, + Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 97 { Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName, int isSafe) } declare 98 { Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, void *clientData) + Tcl_TimerProc *proc, ClientData clientData) } declare 99 { Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, void *clientData) + Tcl_CmdTraceProc *proc, ClientData clientData) } declare 100 { void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name) } declare 101 { void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, - void *clientData) + ClientData clientData) } declare 102 { void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - void *clientData) + ClientData clientData) } declare 103 { int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName) } declare 104 { int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command) } declare 105 { - void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, void *clientData) + void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData) } declare 106 { void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, void *clientData) + Tcl_EventCheckProc *checkProc, ClientData clientData) } declare 107 { - void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData) + void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 108 { void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr) } declare 109 { @@ -435,20 +420,20 @@ declare 113 { void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace) } declare 114 { void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, void *clientData) + Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 115 { int Tcl_DoOneEvent(int flags) } declare 116 { - void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData) + void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) } declare 117 { - char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length) + char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length) } declare 118 { char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element) } declare 119 { @@ -465,11 +450,11 @@ } declare 123 { void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr) } declare 124 { - void Tcl_DStringSetLength(Tcl_DString *dsPtr, size_t length) + void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length) } declare 125 { void Tcl_DStringStartSublist(Tcl_DString *dsPtr) } declare 126 { @@ -479,23 +464,21 @@ const char *Tcl_ErrnoId(void) } declare 128 { const char *Tcl_ErrnoMsg(int err) } -# Removed in 9.0, replaced by macro. -#declare 129 { -# int Tcl_Eval(Tcl_Interp *interp, const char *script) -#} +declare 129 { + int Tcl_Eval(Tcl_Interp *interp, const char *script) +} declare 130 { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } -# Removed in 9.0, replaced by macro. -#declare 131 { -# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -#} +declare 131 {deprecated {No longer in use, changed to macro}} { + int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +} declare 132 { - void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc) + void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc) } declare 133 { TCL_NORETURN void Tcl_Exit(int status) } declare 134 { @@ -528,22 +511,21 @@ int Tcl_ExprString(Tcl_Interp *interp, const char *expr) } declare 143 { void Tcl_Finalize(void) } -# Removed in 9.0 (stub entry only) -#declare 144 { -# void Tcl_FindExecutable(const char *argv0) -#} +declare 144 {nostub {Don't use this function in a stub-enabled extension}} { + void Tcl_FindExecutable(const char *argv0) +} declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } -declare 147 { +declare 147 {deprecated {see TIP #559. Use Tcl_ResetResult}} { void Tcl_FreeResult(Tcl_Interp *interp) } declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, @@ -553,11 +535,11 @@ int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) } declare 150 { - void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name, + ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 { Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr) @@ -565,14 +547,14 @@ declare 152 { int Tcl_GetChannelBufferSize(Tcl_Channel chan) } declare 153 { int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - void **handlePtr) + ClientData *handlePtr) } declare 154 { - void *Tcl_GetChannelInstanceData(Tcl_Channel chan) + ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan) } declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 { @@ -581,11 +563,11 @@ declare 157 { int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr) } declare 158 { - const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) + CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) } declare 159 { int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr) } @@ -611,26 +593,26 @@ declare 166 { Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp) } # Tcl_GetOpenFile is only available on unix, but it is a part of the old -# generic interface, so we inlcude it here for compatibility reasons. +# generic interface, so we include it here for compatibility reasons. declare 167 unix { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, void **filePtr) + int checkUsage, ClientData *filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified # and therefore usually faster. declare 168 { Tcl_PathType Tcl_GetPathType(const char *path) } declare 169 { - size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) + int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) } declare 170 { - size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) + int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 171 { int Tcl_GetServiceMode(void) } declare 172 { @@ -637,31 +619,27 @@ Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName) } declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } -# Removed in 9.0, replaced by macro. -#declare 174 { -# const char *Tcl_GetStringResult(Tcl_Interp *interp) -#} -# Removed in 9.0, replaced by macro. -#declare 175 {deprecated {No longer in use, changed to macro}} { -# const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, -# int flags) -#} +declare 174 { + const char *Tcl_GetStringResult(Tcl_Interp *interp) +} +declare 175 {deprecated {No longer in use, changed to macro}} { + const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, + int flags) +} declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -# Removed in 9.0, replaced by macro. -#declare 177 { -# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) -#} -# Removed in 9.0, replaced by macro. -#declare 178 { -# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -#} +declare 177 { + int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) +} +declare 178 {deprecated {No longer in use, changed to macro}} { + int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +} declare 179 { int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken) } declare 180 { @@ -696,17 +674,17 @@ # declare 188 { # Tcl_MainLoop # } declare 189 { - Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode) + Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode) } declare 190 { int Tcl_MakeSafe(Tcl_Interp *interp) } declare 191 { - Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket) + Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) } declare 192 { char *Tcl_Merge(int argc, const char *const *argv) } declare 193 { @@ -737,14 +715,14 @@ const char *address, const char *myaddr, int myport, int async) } declare 200 { Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - void *callbackData) + ClientData callbackData) } declare 201 { - void Tcl_Preserve(void *data) + void Tcl_Preserve(ClientData data) } declare 202 { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) } declare 203 { @@ -755,11 +733,11 @@ } declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) } declare 206 { - size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, size_t toRead) + int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead) } declare 207 { void Tcl_ReapDetachedProcs(void) } declare 208 { @@ -784,38 +762,37 @@ declare 214 { int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern) } declare 215 { - void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index, + void Tcl_RegExpRange(Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr) } declare 216 { - void Tcl_Release(void *clientData) + void Tcl_Release(ClientData clientData) } declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 { - size_t Tcl_ScanElement(const char *src, int *flagPtr) + int Tcl_ScanElement(const char *src, int *flagPtr) } declare 219 { - size_t Tcl_ScanCountedElement(const char *src, size_t length, int *flagPtr) + int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Removed in 9.0: -#declare 220 { -# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) -#} +declare 220 {deprecated {}} { + int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +} declare 221 { int Tcl_ServiceAll(void) } declare 222 { int Tcl_ServiceEvent(int flags) } declare 223 { void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, - Tcl_InterpDeleteProc *proc, void *clientData) + Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 224 { void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz) } declare 225 { @@ -833,22 +810,20 @@ void Tcl_SetErrorCode(Tcl_Interp *interp, ...) } declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } -# Removed in 9.0 (stub entry only) -#declare 230 { -# void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) -#} +declare 230 {nostub {Don't use this function in a stub-enabled extension}} { + void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) +} declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } -# Removed in 9.0, replaced by macro. -#declare 232 { -# void Tcl_SetResult(Tcl_Interp *interp, char *result, -# Tcl_FreeProc *freeProc) -#} +declare 232 { + void Tcl_SetResult(Tcl_Interp *interp, char *result, + Tcl_FreeProc *freeProc) +} declare 233 { int Tcl_SetServiceMode(int mode) } declare 234 { void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr) @@ -857,15 +832,14 @@ void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr) } declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } -# Removed in 9.0, replaced by macro. -#declare 237 {deprecated {No longer in use, changed to macro}} { -# const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, -# const char *newValue, int flags) -#} +declare 237 {deprecated {No longer in use, changed to macro}} { + const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, + const char *newValue, int flags) +} declare 238 { const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) } declare 239 { @@ -883,90 +857,82 @@ } # Obsolete, use Tcl_FSSplitPath declare 243 { void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } -# Removed in 9.0 (stub entry only) -#declare 244 { -# void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, -# Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) -#} -# Removed in 9.0 (stub entry only) -#declare 245 { -# int Tcl_StringMatch(const char *str, const char *pattern) -#} -# Removed in 9.0: -#declare 246 { -# int Tcl_TellOld(Tcl_Channel chan) -#} -# Removed in 9.0, replaced by macro. -#declare 247 {deprecated {No longer in use, changed to macro}} { -# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, -# Tcl_VarTraceProc *proc, ClientData clientData) -#} +declare 244 {nostub {Don't use this function in a stub-enabled extension}} { + void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, + Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) +} +declare 245 {deprecated {No longer in use, changed to macro}} { + int Tcl_StringMatch(const char *str, const char *pattern) +} +declare 246 {deprecated {}} { + int Tcl_TellOld(Tcl_Channel chan) +} +declare 247 {deprecated {No longer in use, changed to macro}} { + int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, + Tcl_VarTraceProc *proc, ClientData clientData) +} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, - int flags, Tcl_VarTraceProc *proc, void *clientData) + int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 249 { char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr) } declare 250 { - size_t Tcl_Ungets(Tcl_Channel chan, const char *str, size_t len, int atHead) + int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead) } declare 251 { void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName) } declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } -# Removed in 9.0, replaced by macro. -#declare 253 {deprecated {No longer in use, changed to macro}} { -# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) -#} +declare 253 {deprecated {No longer in use, changed to macro}} { + int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) +} declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -# Removed in 9.0, replaced by macro. -#declare 255 {deprecated {No longer in use, changed to macro}} { -# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, -# Tcl_VarTraceProc *proc, ClientData clientData) -#} +declare 255 {deprecated {No longer in use, changed to macro}} { + void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, + Tcl_VarTraceProc *proc, ClientData clientData) +} declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - void *clientData) + ClientData clientData) } declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } -# Removed in 9.0, replaced by macro. -#declare 258 {deprecated {No longer in use, changed to macro}} { -# int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, -# const char *varName, const char *localName, int flags) -#} +declare 258 {deprecated {No longer in use, changed to macro}} { + int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, + const char *varName, const char *localName, int flags) +} declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) } declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } -# Removed in 9.0, replaced by macro. -#declare 261 {deprecated {No longer in use, changed to macro}} { -# ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, -# int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) -#} +declare 261 {deprecated {No longer in use, changed to macro}} { + ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, + int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) +} declare 262 { - void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, + ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - void *prevClientData) + ClientData prevClientData) } declare 263 { - size_t Tcl_Write(Tcl_Channel chan, const char *s, size_t slen) + int Tcl_Write(Tcl_Channel chan, const char *s, int slen) } declare 264 { void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message) } @@ -974,61 +940,53 @@ int Tcl_DumpActiveMemory(const char *fileName) } declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } -# Removed in 9.0: -#declare 267 { -# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) -#} -# Removed in 9.0: -#declare 268 { -# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) -#} +declare 267 {deprecated {see TIP #422}} { + void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) +} +declare 268 {deprecated {see TIP #422}} { + void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) +} declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr) } -# Removed in 9.0, replaced by macro. -#declare 271 {deprecated {No longer in use, changed to macro}} { -# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, -# const char *version, int exact) -#} +declare 271 {deprecated {No longer in use, changed to macro}} { + const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *version, int exact) +} declare 272 { const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } -# Removed in 9.0, replaced by macro. -#declare 273 {deprecated {No longer in use, changed to macro}} { -# int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, -# const char *version) -#} +declare 273 {deprecated {No longer in use, changed to macro}} { + int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, + const char *version) +} # TIP #268: The internally used new Require function is in slot 573. -# Removed in 9.0, replaced by macro. -#declare 274 {deprecated {No longer in use, changed to macro}} { -# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, -# const char *version, int exact) -#} -# Removed in 9.0: -#declare 275 { -# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) -#} -# Removed in 9.0: -#declare 276 { -# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) -#} +declare 274 {deprecated {No longer in use, changed to macro}} { + const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *version, int exact) +} +declare 275 {deprecated {see TIP #422}} { + void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) +} +declare 276 {deprecated {see TIP #422}} { + int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) +} declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } -# Removed in 9.0: -#declare 278 { -# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) -#} +declare 278 {deprecated {see TIP #422}} { + TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) +} declare 279 { void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type) } declare 280 { void Tcl_InitMemory(Tcl_Interp *interp) @@ -1048,11 +1006,11 @@ # (patch usually has no problems to integrate the patch file for the last # version into the new one). declare 281 { Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, - const Tcl_ChannelType *typePtr, void *instanceData, + const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan) } declare 282 { int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan) } @@ -1076,21 +1034,20 @@ } declare 287 { Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr) } declare 288 { - void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData) + void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 289 { - void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData) + void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) } -# Removed in 9.0, replaced by macro. -#declare 290 { -# void Tcl_DiscardResult(Tcl_SavedResult *statePtr) -#} +declare 290 { + void Tcl_DiscardResult(Tcl_SavedResult *statePtr) +} declare 291 { - int Tcl_EvalEx(Tcl_Interp *interp, const char *script, size_t numBytes, + int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags) } declare 292 { int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) @@ -1101,23 +1058,23 @@ declare 294 { TCL_NORETURN void Tcl_ExitThread(int status) } declare 295 { int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, - const char *src, size_t srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, size_t dstLen, + const char *src, int srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 296 { char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding, - const char *src, size_t srcLen, Tcl_DString *dsPtr) + const char *src, int srcLen, Tcl_DString *dsPtr) } declare 297 { void Tcl_FinalizeThread(void) } declare 298 { - void Tcl_FinalizeNotifier(void *clientData) + void Tcl_FinalizeNotifier(ClientData clientData) } declare 299 { void Tcl_FreeEncoding(Tcl_Encoding encoding) } declare 300 { @@ -1132,22 +1089,22 @@ declare 303 { void Tcl_GetEncodingNames(Tcl_Interp *interp) } declare 304 { int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, - const void *tablePtr, size_t offset, const char *msg, int flags, + const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr) } declare 305 { - void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size) + void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) } declare 306 { Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 307 { - void *Tcl_InitNotifier(void) + ClientData Tcl_InitNotifier(void) } declare 308 { void Tcl_MutexLock(Tcl_Mutex *mutexPtr) } declare 309 { @@ -1159,24 +1116,22 @@ declare 311 { void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr) } declare 312 { - size_t Tcl_NumUtfChars(const char *src, size_t length) + int Tcl_NumUtfChars(const char *src, int length) } declare 313 { - size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, - size_t charsToRead, int appendFlag) -} -# Removed in 9.0, replaced by macro. -#declare 314 {deprecated {No longer in use, changed to macro}} { -# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -#} -# Removed in 9.0, replaced by macro. -#declare 315 {deprecated {No longer in use, changed to macro}} { -# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -#} + int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, + int appendFlag) +} +declare 314 { + void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +} +declare 315 { + void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } declare 317 { Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, @@ -1188,11 +1143,11 @@ declare 319 { void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position) } declare 320 { - int Tcl_UniCharAtIndex(const char *src, size_t index) + int Tcl_UniCharAtIndex(const char *src, int index) } declare 321 { int Tcl_UniCharToLower(int ch) } declare 322 { @@ -1203,17 +1158,17 @@ } declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - const char *Tcl_UtfAtIndex(const char *src, size_t index) + const char *Tcl_UtfAtIndex(const char *src, int index) } declare 326 { - int Tcl_UtfCharComplete(const char *src, size_t length) + int Tcl_UtfCharComplete(const char *src, int length) } declare 327 { - size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) + int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { const char *Tcl_UtfFindFirst(const char *src, int ch) } declare 329 { @@ -1225,49 +1180,47 @@ declare 331 { const char *Tcl_UtfPrev(const char *src, const char *start) } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, - const char *src, size_t srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, size_t dstLen, + const char *src, int srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 333 { char *Tcl_UtfToExternalDString(Tcl_Encoding encoding, - const char *src, size_t srcLen, Tcl_DString *dsPtr) + const char *src, int srcLen, Tcl_DString *dsPtr) } declare 334 { int Tcl_UtfToLower(char *src) } declare 335 { int Tcl_UtfToTitle(char *src) } declare 336 { - int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr) + int Tcl_UtfToChar16(const char *src, unsigned short *chPtr) } declare 337 { int Tcl_UtfToUpper(char *src) } declare 338 { - size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, size_t srcLen) + int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen) } declare 339 { - size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) + int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -# Removed in 9.0: -#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { -# const char *Tcl_GetDefaultEncodingDir(void) -#} -# Removed in 9.0: -#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { -# void Tcl_SetDefaultEncodingDir(const char *path) -#} +declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { + const char *Tcl_GetDefaultEncodingDir(void) +} +declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { + void Tcl_SetDefaultEncodingDir(const char *path) +} declare 343 { - void Tcl_AlertNotifier(void *clientData) + void Tcl_AlertNotifier(ClientData clientData) } declare 344 { void Tcl_ServiceModeHook(int mode) } declare 345 { @@ -1289,62 +1242,60 @@ int Tcl_UniCharIsUpper(int ch) } declare 351 { int Tcl_UniCharIsWordChar(int ch) } -declare 352 { - size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr) +declare 352 {deprecated {Use Tcl_GetCharLength}} { + int Tcl_UniCharLen(const Tcl_UniChar *uniStr) } -declare 353 { +declare 353 {deprecated {Use Tcl_UtfNcmp}} { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) + unsigned long numChars) } declare 354 { - char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, - size_t uniLength, Tcl_DString *dsPtr) + char *Tcl_Char16ToUtfDString(const unsigned short *uniStr, + int uniLength, Tcl_DString *dsPtr) } declare 355 { - Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src, - size_t length, Tcl_DString *dsPtr) + unsigned short *Tcl_UtfToChar16DString(const char *src, + int length, Tcl_DString *dsPtr) } declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -# Removed in 9.0: -#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { -# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, -# int count) -#} +declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { + Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, + int count) +} declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } declare 359 { void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, - const char *command, size_t length) + const char *command, int length) } declare 360 { - int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, - size_t numBytes, Tcl_Parse *parsePtr, int append, - const char **termPtr) + int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, + Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 361 { - int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, - size_t numBytes, int nested, Tcl_Parse *parsePtr) + int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, + int nested, Tcl_Parse *parsePtr) } declare 362 { - int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, size_t numBytes, + int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr) } declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, - size_t numBytes, Tcl_Parse *parsePtr, int append, + int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 364 { - int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, - size_t numBytes, Tcl_Parse *parsePtr, int append) + int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, + Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, # Tcl_FSAccess and Tcl_FSStat declare 365 { char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) @@ -1357,14 +1308,14 @@ } declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) + int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) } declare 372 { @@ -1379,38 +1330,37 @@ declare 375 { int Tcl_UniCharIsPunct(int ch) } declare 376 { int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, - Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags) + Tcl_Obj *textObj, int offset, int nmatches, int flags) } declare 377 { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) } declare 378 { - Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, size_t numChars) + Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars) } declare 379 { void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - size_t numChars) + int numChars) } declare 380 { - size_t Tcl_GetCharLength(Tcl_Obj *objPtr) + int Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { - int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) + int Tcl_GetUniChar(Tcl_Obj *objPtr, int index) } -# Removed in 9.0, replaced by macro. -#declare 382 {deprecated {No longer in use, changed to macro}} { -# Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) -#} +declare 382 {deprecated {No longer in use, changed to macro}} { + Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) +} declare 383 { - Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last) + Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last) } -declare 384 { +declare 384 {deprecated {Use Tcl_AppendStringsToObj}} { void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - size_t length) + int length) } declare 385 { int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) } @@ -1425,11 +1375,11 @@ } declare 389 { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern) } declare 390 { - int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, + int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 391 { void Tcl_ConditionFinalize(Tcl_Condition *condPtr) } @@ -1436,19 +1386,19 @@ declare 392 { void Tcl_MutexFinalize(Tcl_Mutex *mutex) } declare 393 { int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, - void *clientData, size_t stackSize, int flags) + ClientData clientData, int stackSize, int flags) } # Introduced in 8.3.2 declare 394 { - size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, size_t bytesToRead) + int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead) } declare 395 { - size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, size_t srcLen) + int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen) } declare 396 { Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan) } declare 397 { @@ -1463,11 +1413,11 @@ } declare 400 { Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) } -declare 401 { +declare 401 {deprecated {Use Tcl_ChannelClose2Proc}} { Tcl_DriverCloseProc *Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr) } declare 402 { Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc( @@ -1479,11 +1429,11 @@ } declare 404 { Tcl_DriverOutputProc *Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr) } -declare 405 { +declare 405 {deprecated {Use Tcl_ChannelWideSeekProc}} { Tcl_DriverSeekProc *Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr) } declare 406 { Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc( @@ -1530,62 +1480,60 @@ void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 { int Tcl_IsChannelExisting(const char *channelName) } -declare 419 { +declare 419 {deprecated {Use Tcl_UtfNcasecmp}} { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) + unsigned long numChars) } -declare 420 { +declare 420 {deprecated {Use Tcl_StringCaseMatch}} { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase) } -# Removed in 9.0, as it is actually a macro: -#declare 421 { -# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) -#} -# Removed in 9.0, as it is actually a macro: -#declare 422 { -# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, -# const void *key, int *newPtr) -#} +declare 421 { + Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) +} +declare 422 { + Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, + const void *key, int *newPtr) +} declare 423 { void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr) } declare 424 { void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) } declare 425 { - void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, + ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - void *prevClientData) + ClientData prevClientData) } declare 426 { int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, void *clientData) + Tcl_CommandTraceProc *proc, ClientData clientData) } declare 427 { void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, - int flags, Tcl_CommandTraceProc *proc, void *clientData) + int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 { - void *Tcl_AttemptAlloc(size_t size) + char *Tcl_AttemptAlloc(unsigned int size) } declare 429 { - void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line) + char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) } declare 430 { - void *Tcl_AttemptRealloc(void *ptr, size_t size) + char *Tcl_AttemptRealloc(char *ptr, unsigned int size) } declare 431 { - void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size, + char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line) } declare 432 { - int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length) + int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length) } # TIP#10 (thread-aware channels) akupries declare 433 { Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel) @@ -1595,20 +1543,18 @@ declare 434 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf -# Removed in 9.0: -#declare 435 {deprecated {}} { -# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, -# int *numArgsPtr, Tcl_ValueType **argTypesPtr, -# Tcl_MathProc **procPtr, void **clientDataPtr) -#} -# Removed in 9.0: -#declare 436 {deprecated {}} { -# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) -#} +declare 435 {deprecated {}} { + int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, + int *numArgsPtr, Tcl_ValueType **argTypesPtr, + Tcl_MathProc **procPtr, ClientData *clientDataPtr) +} +declare 436 {deprecated {}} { + Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) +} # TIP#36 (better access to 'subst') dkf declare 437 { Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } @@ -1666,11 +1612,11 @@ declare 452 { int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 { - const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, + const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 { int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) } @@ -1705,11 +1651,11 @@ declare 464 { Tcl_Obj *Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]) } declare 465 { - void *Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, + ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr) } declare 466 { Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr) } @@ -1716,11 +1662,11 @@ declare 467 { int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName) } declare 468 { Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem, - void *clientData) + ClientData clientData) } declare 469 { const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr) } declare 470 { @@ -1731,24 +1677,24 @@ } declare 472 { Tcl_Obj *Tcl_FSListVolumes(void) } declare 473 { - int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr) + int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr) } declare 474 { int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr) } declare 475 { - void *Tcl_FSData(const Tcl_Filesystem *fsPtr) + ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr) } declare 476 { const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr) } declare 477 { - const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) + CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) } declare 478 { Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) } @@ -1761,11 +1707,11 @@ } # TIP#56 (evaluate a parsed script) msofer declare 481 { int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, - size_t count) + int count) } # TIP#73 (access to current time) kbk declare 482 { void Tcl_GetTime(Tcl_Time *timeBuf) @@ -1772,11 +1718,11 @@ } # TIP#32 (object-enabled traces) kbk declare 483 { Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, - Tcl_CmdObjTraceProc *objProc, void *clientData, + Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc) } declare 484 { int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr) } @@ -1870,11 +1816,11 @@ # TIP #139 (partial exposure of namespace API - transferred from tclInt.decls) # dkf, API by Brent Welch? declare 506 { Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, - void *clientData, Tcl_NamespaceDeleteProc *deleteProc) + ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 507 { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) } declare 508 { @@ -1919,24 +1865,24 @@ declare 518 { int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName) } -# Removed in 9.0 (stub entry only) -#declare 519 {nostub {Don't use this function in a stub-enabled extension}} { -# Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) -#} +# TIP#121 (exit handler) dkf for Joe Mistachkin +declare 519 {nostub {Don't use this function in a stub-enabled extension}} { + Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) +} # TIP#143 (resource limits) dkf declare 520 { void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, void *clientData, + Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc) } declare 521 { void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, void *clientData) + Tcl_LimitHandlerProc *handlerProc, ClientData clientData) } declare 522 { int Tcl_LimitReady(Tcl_Interp *interp) } declare 523 { @@ -2045,16 +1991,16 @@ # TIP#233 (virtualized time) akupries declare 552 { void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - void *clientData) + ClientData clientData) } declare 553 { void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - void **clientData) + ClientData *clientData) } # TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4 declare 554 { Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc( @@ -2061,23 +2007,23 @@ const Tcl_ChannelType *chanTypePtr) } # TIP#237 (arbitrary-precision integers) kbk declare 555 { - Tcl_Obj *Tcl_NewBignumObj(mp_int *value) + Tcl_Obj *Tcl_NewBignumObj(void *value) } declare 556 { - Tcl_Obj *Tcl_DbNewBignumObj(mp_int *value, const char *file, int line) + Tcl_Obj *Tcl_DbNewBignumObj(void *value, const char *file, int line) } declare 557 { - void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value) + void Tcl_SetBignumObj(Tcl_Obj *obj, void *value) } declare 558 { - int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value) + int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } declare 559 { - int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value) + int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value) } # TIP #208 ('chan' command) jeffh declare 560 { int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length) @@ -2102,11 +2048,11 @@ } # TIP #237 (additional conversion functions for bignum support) kbk/dgp declare 566 { int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, - mp_int *toInit) + void *toInit) } # TIP#181 (namespace unknown command) dgp for Neil Madden declare 567 { Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, @@ -2141,12 +2087,12 @@ # TIP#270 (utility C routines for string formatting) dgp declare 574 { void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 575 { - void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, - size_t length, size_t limit, const char *ellipsis) + void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, + int limit, const char *ellipsis) } declare 576 { Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]) } @@ -2164,11 +2110,11 @@ # ----- BASELINE -- FOR -- 8.5.0 ----- # # TIP #285 (script cancellation support) jmistachkin declare 580 { int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, - void *clientData, int flags) + ClientData clientData, int flags) } declare 581 { int Tcl_Canceled(Tcl_Interp *interp, int flags) } @@ -2180,34 +2126,34 @@ # TIP #322 (NRE public interface) msofer declare 583 { Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, void *clientData, + Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 584 { int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } declare 585 { - int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[], int flags) + int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], + int flags) } declare 586 { int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags) } declare 587 { void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, - void *data0, void *data1, void *data2, - void *data3) + ClientData data0, ClientData data1, ClientData data2, + ClientData data3) } # For use by NR extenders, to have a simple way to also provide a (required!) # classic objProc declare 588 { int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, - void *clientData, int objc, Tcl_Obj *const objv[]) + ClientData clientData, int objc, Tcl_Obj *const objv[]) } # TIP#316 (Tcl_StatBuf reader functions) dkf declare 589 { unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr) @@ -2273,11 +2219,11 @@ void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum) } # TIP#307 (move results between interpreters) dkf declare 607 { - void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result, + void Tcl_TransferResult(Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp) } # TIP#335 (detect if interpreter in use) jmistachkin declare 608 { @@ -2294,19 +2240,19 @@ int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj) } declare 611 { int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, - size_t buffersize, Tcl_Obj *gzipHeaderDictObj) + int buffersize, Tcl_Obj *gzipHeaderDictObj) } declare 612 { unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, - size_t len) + int len) } declare 613 { unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, - size_t len) + int len) } declare 614 { int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle) } @@ -2321,12 +2267,11 @@ } declare 618 { int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush) } declare 619 { - int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, - size_t count) + int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count) } declare 620 { int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle) } declare 621 { @@ -2380,11 +2325,11 @@ # TIP #456 declare 631 { Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - void *callbackData) + ClientData callbackData) } # TIP #430 declare 632 { int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint, @@ -2405,11 +2350,11 @@ declare 636 { void Tcl_FreeIntRep(Tcl_Obj *objPtr) } declare 637 { char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - size_t numBytes) + unsigned int numBytes) } declare 638 { Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr) } declare 639 { @@ -2434,16 +2379,29 @@ } # TIP#312 New Tcl_LinkArray() function declare 644 { int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, - int type, size_t size) + int type, int size) } declare 645 { int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t endValue, size_t *indexPtr) + int endValue, int *indexPtr) +} + +# TIP #548 +declare 646 { + int Tcl_UtfToUniChar(const char *src, int *chPtr) +} +declare 647 { + char *Tcl_UniCharToUtfDString(const int *uniStr, + int uniLength, Tcl_DString *dsPtr) +} +declare 648 { + int *Tcl_UtfToUniCharDString(const char *src, + int length, Tcl_DString *dsPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## @@ -2461,34 +2419,37 @@ # Windows specific functions # Added in Tcl 8.1 declare 0 win { - TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr) + TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr) } declare 1 win { - char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr) + char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) } ################################ # Mac OS X specific functions declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, - size_t maxPathLen, char *libraryPath) + int maxPathLen, char *libraryPath) } declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, - int hasResourceFile, size_t maxPathLen, char *libraryPath) + int hasResourceFile, int maxPathLen, char *libraryPath) } ############################################################################## # Public functions that are not accessible via the stubs table. +export { + void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) +} export { void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp) } export { @@ -2517,9 +2478,12 @@ int exact) } export { void Tcl_GetMemoryInfo(Tcl_DString *dsPtr) } +export { + void Tcl_InitSubsystems(void) +} # Local Variables: # mode: tcl # End: Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -46,19 +46,34 @@ * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) * tools/tcl.hpj.in (not patchlevel, for windows installer) */ -#define TCL_MAJOR_VERSION 9 -#define TCL_MINOR_VERSION 0 +#define TCL_MAJOR_VERSION 8 +#define TCL_MINOR_VERSION 7 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 0 +#define TCL_RELEASE_SERIAL 4 -#define TCL_VERSION "9.0" -#define TCL_PATCH_LEVEL "9.0a0" +#define TCL_VERSION "8.7" +#define TCL_PATCH_LEVEL "8.7a4" -#if defined(RC_INVOKED) +#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) +/* + *---------------------------------------------------------------------------- + * The following definitions set up the proper options for Windows compilers. + * We use this method because there is no autoconf equivalent. + */ + +#ifdef _WIN32 +# ifndef __WIN32__ +# define __WIN32__ +# endif +# ifndef WIN32 +# define WIN32 +# endif +#endif + /* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double * quotation marks), JOIN joins two arguments. */ @@ -68,11 +83,15 @@ #endif #ifndef JOIN # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif -#endif /* RC_INVOKED */ + +#ifndef TCL_THREADS +# define TCL_THREADS 1 +#endif +#endif /* !TCL_NO_DEPRECATED */ /* * A special definition used to allow this header file to be included from * windows resource files so that they can obtain version information. * RC_INVOKED is defined by default by the windows RC tool. @@ -99,15 +118,36 @@ * prior Tcl releases. */ #include +/* + *---------------------------------------------------------------------------- + * Support for functions with a variable number of arguments. + * + * The following TCL_VARARGS* macros are to support old extensions + * written for older versions of Tcl where the macros permitted + * support for the varargs.h system as well as stdarg.h . + * + * New code should just directly be written to use stdarg.h conventions. + */ + +#include +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +# define TCL_VARARGS(type, name) (type name, ...) +# define TCL_VARARGS_DEF(type, name) (type name, ...) +# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) +#endif /* !TCL_NO_DEPRECATED */ #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) -# define TCL_NORETURN1 __attribute__ ((noreturn)) +# if defined(BUILD_tcl) || defined(BUILD_tk) +# define TCL_NORETURN1 __attribute__ ((noreturn)) +# else +# define TCL_NORETURN1 /* nothing */ +# endif #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) # define TCL_NORETURN _declspec(noreturn) # define TCL_NOINLINE __declspec(noinline) @@ -199,11 +239,37 @@ # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif -#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED) +/* + * The following _ANSI_ARGS_ macro is to support old extensions + * written for older versions of Tcl where it permitted support + * for compilers written in the pre-prototype era of C. + * + * New code should use prototypes. + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +# undef _ANSI_ARGS_ +# define _ANSI_ARGS_(x) x + +/* + * Definitions that allow this header file to be used either with or without + * ANSI C features. + */ + +#ifndef INLINE +# define INLINE +#endif +#ifndef CONST +# define CONST const +#endif + +#endif /* !TCL_NO_DEPRECATED */ + +#ifndef CONST86 # define CONST86 const #endif /* * Make sure EXTERN isn't defined elsewhere. @@ -217,15 +283,45 @@ # define EXTERN extern "C" TCL_STORAGE_CLASS #else # define EXTERN extern TCL_STORAGE_CLASS #endif +/* + *---------------------------------------------------------------------------- + * The following code is copied from winnt.h. If we don't replicate it here, + * then can't be included after tcl.h, since tcl.h also defines + * VOID. This block is skipped under Cygwin and Mingw. + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) +#ifndef VOID +#define VOID void +typedef char CHAR; +typedef short SHORT; +typedef long LONG; +#endif +#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ + +/* + * Macro to use instead of "void" for arguments that must have type "void *" + * in ANSI C; maps them to type "char *" in non-ANSI systems. + */ + +#ifndef __VXWORKS__ +# define VOID void +#endif +#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ + /* * Miscellaneous declarations. */ -typedef void *ClientData; +#ifndef _CLIENTDATA + typedef void *ClientData; +# define _CLIENTDATA +#endif /* * Darwin specific configure overrides (to support fat compiles, where * configure runs only once for multiple architectures): */ @@ -263,11 +359,11 @@ * tclObj.c) depends on the function * sprintf(...,"%" TCL_LL_MODIFIER "d",...). */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) -# if defined(_WIN32) +# if defined(_MSC_VER) || defined(_WIN32) # define TCL_WIDE_INT_TYPE __int64 # define TCL_LL_MODIFIER "I64" # if defined(_WIN64) # define TCL_Z_MODIFIER "I" # endif @@ -308,11 +404,11 @@ #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; -# elif defined(_WIN64) +# elif defined(_WIN64) || defined(_USE_64BIT_TIME_T) typedef struct __stat64 Tcl_StatBuf; # elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T) typedef struct _stati64 Tcl_StatBuf; # else typedef struct _stat32i64 Tcl_StatBuf; @@ -358,11 +454,21 @@ * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc. * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ -typedef struct Tcl_Interp Tcl_Interp; +typedef struct Tcl_Interp +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +{ + /* TIP #330: Strongly discourage extensions from using the string + * result. */ + char *resultDontUse; /* Don't use in extensions! */ + void (*freeProcDontUse) (char *); /* Don't use in extensions! */ + int errorLineDontUse; /* Don't use in extensions! */ +} +#endif /* !TCL_NO_DEPRECATED */ +Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion; typedef struct Tcl_Command_ *Tcl_Command; @@ -389,13 +495,13 @@ * following this definition is given to each call of 'Tcl_CreateThread' and * will be called as the main fuction of the new thread created by that call. */ #if defined _WIN32 -typedef unsigned (__stdcall Tcl_ThreadCreateProc) (void *clientData); +typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData); #else -typedef void (Tcl_ThreadCreateProc) (void *clientData); +typedef void (Tcl_ThreadCreateProc) (ClientData clientData); #endif /* * Threading function return types used for abstracting away platform * differences when writing a Tcl_ThreadCreateProc. See the NewThread function @@ -457,22 +563,23 @@ * relative to the start of the match string, not the beginning of the entire * string. */ typedef struct Tcl_RegExpIndices { - size_t start; /* Character offset of first character in + long start; /* Character offset of first character in * match. */ - size_t end; /* Character offset of first character after + long end; /* Character offset of first character after * the match. */ } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - size_t nsubs; /* Number of subexpressions in the compiled + int nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ - size_t extendStart; /* The offset at which a subsequent match + long extendStart; /* The offset at which a subsequent match * might begin. */ + long reserved; /* Reserved for later use. */ } Tcl_RegExpInfo; /* * Picky compilers complain if this typdef doesn't appear before the struct's * reference in tclDecls.h. @@ -506,10 +613,14 @@ #define TCL_ERROR 1 #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#define TCL_RESULT_SIZE 200 +#endif + /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): */ @@ -516,10 +627,31 @@ #define TCL_SUBST_COMMANDS 001 #define TCL_SUBST_VARIABLES 002 #define TCL_SUBST_BACKSLASHES 004 #define TCL_SUBST_ALL 007 +/* + * Argument descriptors for math function callbacks in expressions: + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +typedef enum { + TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT +} Tcl_ValueType; + +typedef struct Tcl_Value { + Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, + * or both. */ + long intValue; /* Integer value. */ + double doubleValue; /* Double-precision floating value. */ + Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ +} Tcl_Value; +#else +#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */ +#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */ +#endif + /* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ @@ -529,64 +661,66 @@ *---------------------------------------------------------------------------- * Function types defined by Tcl: */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); -typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp, +typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, int code); -typedef void (Tcl_ChannelProc) (void *clientData, int mask); -typedef void (Tcl_CloseProc) (void *data); -typedef void (Tcl_CmdDeleteProc) (void *clientData); -typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, +typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); +typedef void (Tcl_CloseProc) (ClientData data); +typedef void (Tcl_CmdDeleteProc) (ClientData clientData); +typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[]); -typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, +typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - void *cmdClientData, int argc, const char *argv[]); -typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, + ClientData cmdClientData, int argc, const char *argv[]); +typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); -typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); +typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); -typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, +typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); -#define Tcl_EncodingFreeProc Tcl_FreeProc +typedef void (Tcl_EncodingFreeProc) (ClientData clientData); typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); -typedef void (Tcl_EventCheckProc) (void *clientData, int flags); -typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); -typedef void (Tcl_EventSetupProc) (void *clientData, int flags); -#define Tcl_ExitProc Tcl_FreeProc -typedef void (Tcl_FileProc) (void *clientData, int mask); -#define Tcl_FileFreeProc Tcl_FreeProc +typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); +typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); +typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); +typedef void (Tcl_ExitProc) (ClientData clientData); +typedef void (Tcl_FileProc) (ClientData clientData, int mask); +typedef void (Tcl_FileFreeProc) (ClientData clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (void *blockPtr); -typedef void (Tcl_IdleProc) (void *clientData); -typedef void (Tcl_InterpDeleteProc) (void *clientData, +typedef void (Tcl_FreeProc) (char *blockPtr); +typedef void (Tcl_IdleProc) (ClientData clientData); +typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); -typedef void (Tcl_NamespaceDeleteProc) (void *clientData); -typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, +typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, + Tcl_Value *args, Tcl_Value *resultPtr); +typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); +typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp); typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); -typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, +typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, char *address, int port); -typedef void (Tcl_TimerProc) (void *clientData); +typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); -typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp, +typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *part1, const char *part2, int flags); -typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp, +typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, - void *clientData); + ClientData clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); -typedef void (Tcl_AlertNotifierProc) (void *clientData); +typedef void (Tcl_AlertNotifierProc) (ClientData clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); -typedef void *(Tcl_InitNotifierProc) (void); -typedef void (Tcl_FinalizeNotifierProc) (void *clientData); +typedef ClientData (Tcl_InitNotifierProc) (void); +typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData); typedef void (Tcl_MainLoopProc) (void); /* *---------------------------------------------------------------------------- * The following structure represents a type of object, which is a particular @@ -640,23 +774,23 @@ * An object stores a value as either a string, some internal representation, * or both. */ typedef struct Tcl_Obj { - size_t refCount; /* When 0 the object will be freed. */ + int refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * must be followed by a null byte (i.e., at * offset length) but may also contain * embedded null characters. The array's - * storage is allocated by Tcl_Alloc. NULL means + * storage is allocated by ckalloc. NULL means * the string rep is invalid and must be * regenerated from the internal rep. Clients * should use Tcl_GetStringFromObj or * Tcl_GetString to get a pointer to the byte * array as a readonly value. */ - size_t length; /* The number of bytes at *bytes, not + int length; /* The number of bytes at *bytes, not * including the terminating null. */ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ @@ -664,15 +798,24 @@ } Tcl_Obj; /* *---------------------------------------------------------------------------- - * The following type contains the state needed by Tcl_SaveResult. It - * is typically allocated on the stack. + * The following structure contains the state needed by Tcl_SaveResult. No-one + * outside of Tcl should access any of these fields. This structure is + * typically allocated on the stack. */ -typedef Tcl_Obj *Tcl_SavedResult; +typedef struct Tcl_SavedResult { + char *result; + Tcl_FreeProc *freeProc; + Tcl_Obj *objResultPtr; + char *appendResult; + int appendAvl; + int appendUsed; + char resultSpace[200+1]; +} Tcl_SavedResult; /* *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first * five fields must match exactly the fields in a Namespace structure (see @@ -684,11 +827,11 @@ * namespace. This contains no ::'s. The name * of the global namespace is "" although "::" * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* Arbitrary value associated with this + ClientData clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the * namespace to, e.g., free clientData. */ struct Tcl_Namespace *parentPtr; @@ -756,17 +899,17 @@ int isNativeObjectProc; /* 1 if objProc was registered by a call to * Tcl_CreateObjCommand; 0 otherwise. * Tcl_SetCmdInfo does not modify this * field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ - void *objClientData; /* ClientData for object proc. */ + ClientData objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - void *clientData; /* ClientData for string proc. */ + ClientData clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - void *deleteData; /* Value to pass to deleteProc (usually the + ClientData 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 * change a command's namespace; use * TclRenameCommand or Tcl_Eval (of 'rename') @@ -782,26 +925,29 @@ #define TCL_DSTRING_STATIC_SIZE 200 typedef struct Tcl_DString { char *string; /* Points to beginning of string: either * staticSpace below or a malloced array. */ - size_t length; /* Number of non-NULL characters in the + int length; /* Number of non-NULL characters in the * string. */ - size_t spaceAvl; /* Total number of bytes available for the + int spaceAvl; /* Total number of bytes available for the * string and its terminating NULL char. */ char staticSpace[TCL_DSTRING_STATIC_SIZE]; /* Space to use in common case where string is * small. */ } Tcl_DString; #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +# define Tcl_DStringTrunc Tcl_DStringSetLength +#endif /* !TCL_NO_DEPRECATED */ /* * Definitions for the maximum number of digits of precision that may be - * produced by Tcl_PrintDouble, and the number of bytes of buffer space - * required by Tcl_PrintDouble. + * specified in the "tcl_precision" variable, and the number of bytes of + * buffer space required by Tcl_PrintDouble. */ #define TCL_MAX_PREC 17 #define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10) @@ -883,11 +1029,15 @@ #define TCL_LIST_ELEMENT 8 #define TCL_TRACE_READS 0x10 #define TCL_TRACE_WRITES 0x20 #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #define TCL_INTERP_DESTROYED 0x100 +#endif + #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES /* Required to support old variable/vdelete/vinfo traces. */ #define TCL_TRACE_OLD_STYLE 0x1000 @@ -911,10 +1061,21 @@ #define TCL_TRACE_RENAME 0x2000 #define TCL_TRACE_DELETE 0x4000 #define TCL_ALLOW_INLINE_COMPILATION 0x20000 +/* + * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now + * always parsed whenever the part2 is NULL. (This is to avoid a common error + * when converting code to use the new object based APIs and forgetting to + * give the flag) + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +# define TCL_PARSE_PART1 0x400 +#endif /* !TCL_NO_DEPRECATED */ + /* * Types for linked variables: */ #define TCL_LINK_INT 1 @@ -944,11 +1105,11 @@ *---------------------------------------------------------------------------- * Forward declarations of Tcl_HashTable and related types. */ #ifndef TCL_HASH_TYPE -# define TCL_HASH_TYPE size_t +# define TCL_HASH_TYPE unsigned #endif typedef struct Tcl_HashKeyType Tcl_HashKeyType; typedef struct Tcl_HashTable Tcl_HashTable; typedef struct Tcl_HashEntry Tcl_HashEntry; @@ -966,12 +1127,14 @@ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * 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 *hash; /* Hash value, stored as pointer to ensure + * that the offsets of the fields in this + * structure are not changed. */ + ClientData clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */ int words[1]; /* Multiple integer words for key. The actual @@ -1055,20 +1218,20 @@ * points to first entry in bucket's hash * chain, or NULL. */ Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - size_t numBuckets; /* Total number of buckets allocated at + int numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - size_t numEntries; /* Total number of entries present in + int numEntries; /* Total number of entries present in * table. */ - size_t rebuildSize; /* Enlarge table when numEntries gets to be + int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - size_t mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ + int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the * number of ints that is the size of the * key. */ @@ -1085,11 +1248,11 @@ * hash tables: */ typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - size_t nextIndex; /* Index of next bucket to be enumerated after + int nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ } Tcl_HashSearch; @@ -1126,11 +1289,11 @@ */ typedef struct { void *next; /* Search position for underlying hash * table. */ - size_t epoch; /* Epoch marker for dictionary being searched, + unsigned int epoch; /* Epoch marker for dictionary being searched, * or 0 if search has terminated. */ Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ } Tcl_DictSearch; /* @@ -1185,19 +1348,19 @@ typedef struct Tcl_Time { long sec; /* Seconds. */ long usec; /* Microseconds. */ } Tcl_Time; -typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr); -typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr); +typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr); +typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); /* * TIP #233 (Virtualized Time) */ -typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, void *clientData); -typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData); +typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData); +typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); /* *---------------------------------------------------------------------------- * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to * indicate what sorts of events are of interest: @@ -1235,14 +1398,16 @@ /* * Channel version tag. This was introduced in 8.3.2/8.4. */ +#ifndef TCL_NO_DEPRECATED #define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) #define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) #define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3) #define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4) +#endif #define TCL_CHANNEL_VERSION_5 ((Tcl_ChannelTypeVersion) 0x5) /* * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc. */ @@ -1252,44 +1417,44 @@ /* * Typedefs for the various operations in a channel type: */ -typedef int (Tcl_DriverBlockModeProc) (void *instanceData, int mode); -typedef int (Tcl_DriverCloseProc) (void *instanceData, +typedef int (Tcl_DriverBlockModeProc) (ClientData instanceData, int mode); +typedef int (Tcl_DriverCloseProc) (ClientData instanceData, Tcl_Interp *interp); -typedef int (Tcl_DriverClose2Proc) (void *instanceData, +typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, Tcl_Interp *interp, int flags); -typedef int (Tcl_DriverInputProc) (void *instanceData, char *buf, +typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); -typedef int (Tcl_DriverOutputProc) (void *instanceData, +typedef int (Tcl_DriverOutputProc) (ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr); -typedef int (Tcl_DriverSeekProc) (void *instanceData, long offset, +typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, int mode, int *errorCodePtr); -typedef int (Tcl_DriverSetOptionProc) (void *instanceData, +typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); -typedef int (Tcl_DriverGetOptionProc) (void *instanceData, +typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -typedef void (Tcl_DriverWatchProc) (void *instanceData, int mask); -typedef int (Tcl_DriverGetHandleProc) (void *instanceData, - int direction, void **handlePtr); -typedef int (Tcl_DriverFlushProc) (void *instanceData); -typedef int (Tcl_DriverHandlerProc) (void *instanceData, +typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); +typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, + int direction, ClientData *handlePtr); +typedef int (Tcl_DriverFlushProc) (ClientData instanceData); +typedef int (Tcl_DriverHandlerProc) (ClientData instanceData, int interestMask); -typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData, +typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr); /* * TIP #218, Channel Thread Actions */ -typedef void (Tcl_DriverThreadActionProc) (void *instanceData, +typedef void (Tcl_DriverThreadActionProc) (ClientData instanceData, int action); /* * TIP #208, File Truncation (etc.) */ -typedef int (Tcl_DriverTruncateProc) (void *instanceData, +typedef int (Tcl_DriverTruncateProc) (ClientData instanceData, Tcl_WideInt length); /* * struct Tcl_ChannelType: * @@ -1307,11 +1472,11 @@ * type. */ Tcl_ChannelTypeVersion version; /* Version of the channel type. */ Tcl_DriverCloseProc *closeProc; /* Function to call to close the channel, or - * TCL_CLOSE2PROC if the close2Proc should be + * NULL or TCL_CLOSE2PROC if the close2Proc should be * used instead. */ Tcl_DriverInputProc *inputProc; /* Function to call for input on channel. */ Tcl_DriverOutputProc *outputProc; /* Function to call for output on channel. */ @@ -1458,26 +1623,26 @@ typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval); typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); -typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, +typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, - void **clientDataPtr); + ClientData *clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); -#define Tcl_FSFreeInternalRepProc Tcl_FreeProc -typedef void *(Tcl_FSDupInternalRepProc) (void *clientData); -typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (void *clientData); -typedef void *(Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); +typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData); +typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); +typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); +typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); typedef struct Tcl_FSVersion_ *Tcl_FSVersion; /* *---------------------------------------------------------------------------- @@ -1492,11 +1657,11 @@ /* * struct Tcl_Filesystem: * * One such structure exists for each type (kind) of filesystem. It collects - * together in one place all the functions that are part of the specific + * together the functions that form the interface for a particulr the * filesystem. Tcl always accesses the filesystem through one of these * structures. * * Not all entries need be non-NULL; any which are NULL are simply ignored. * However, a complete filesystem should provide all of these functions. The @@ -1503,155 +1668,127 @@ * explanations in the structure show the importance of each function. */ typedef struct Tcl_Filesystem { const char *typeName; /* The name of the filesystem. */ - size_t structureLength; /* Length of this structure, so future binary + int structureLength; /* Length of this structure, so future binary * compatibility can be assured. */ Tcl_FSVersion version; /* Version of the filesystem type. */ Tcl_FSPathInFilesystemProc *pathInFilesystemProc; - /* Function to check whether a path is in this + /* Determines whether the pathname is in this * filesystem. This is the most important * filesystem function. */ Tcl_FSDupInternalRepProc *dupInternalRepProc; - /* Function to duplicate internal fs rep. May - * be NULL (but then fs is less efficient). */ + /* Duplicates the internal handle of the node. + * If it is NULL, the filesystem is less + * performant. */ Tcl_FSFreeInternalRepProc *freeInternalRepProc; - /* Function to free internal fs rep. Must be - * implemented if internal representations - * need freeing, otherwise it can be NULL. */ + /* Frees the internal handle of the node. NULL + * only if there is no need to free resources + * used for the internal handle. */ Tcl_FSInternalToNormalizedProc *internalToNormalizedProc; - /* Function to convert internal representation - * to a normalized path. Only required if the - * fs creates pure path objects with no - * string/path representation. */ + /* Converts the internal handle to a normalized + * path. NULL if the filesystem creates nodes + * having no pathname. */ Tcl_FSCreateInternalRepProc *createInternalRepProc; - /* Function to create a filesystem-specific - * internal representation. May be NULL if - * paths have no internal representation, or - * if the Tcl_FSPathInFilesystemProc for this - * filesystem always immediately creates an - * internal representation for paths it - * accepts. */ + /* Creates an internal handle for a pathname. + * May be NULL if pathnames have no internal + * handle or if pathInFilesystemProc always + * immediately creates an internal + * representation for pathnames in the + * filesystem. */ Tcl_FSNormalizePathProc *normalizePathProc; - /* Function to normalize a path. Should be - * implemented for all filesystems which can - * have multiple string representations for - * the same path object. */ + /* Normalizes a path. Should be implemented if + * the filesystems supports multiple paths to + * the same node. */ Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc; - /* Function to determine the type of a path in - * this filesystem. May be NULL. */ + /* Determines the type of a path in this + * filesystem. May be NULL. */ Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc; - /* Function to return the separator - * character(s) for this filesystem. Must be - * implemented. */ - Tcl_FSStatProc *statProc; /* Function to process a 'Tcl_FSStat()' call. - * Must be implemented for any reasonable - * filesystem. */ + /* Produces the separator character(s) for this + * filesystem. Must not be NULL. */ + Tcl_FSStatProc *statProc; /* Called by 'Tcl_FSStat()'. Provided by any + * reasonable filesystem. */ Tcl_FSAccessProc *accessProc; - /* Function to process a 'Tcl_FSAccess()' - * call. Must be implemented for any - * reasonable filesystem. */ + /* Called by 'Tcl_FSAccess()'. Implemented by + * any reasonable filesystem. */ Tcl_FSOpenFileChannelProc *openFileChannelProc; - /* Function to process a - * 'Tcl_FSOpenFileChannel()' call. Must be - * implemented for any reasonable - * filesystem. */ + /* Called by 'Tcl_FSOpenFileChannel()'. + * Provided by any reasonable filesystem. */ Tcl_FSMatchInDirectoryProc *matchInDirectoryProc; - /* Function to process a - * 'Tcl_FSMatchInDirectory()'. If not - * implemented, then glob and recursive copy - * functionality will be lacking in the - * filesystem. */ - Tcl_FSUtimeProc *utimeProc; /* Function to process a 'Tcl_FSUtime()' call. - * Required to allow setting (not reading) of - * times with 'file mtime', 'file atime' and - * the open-r/open-w/fcopy implementation of - * 'file copy'. */ - Tcl_FSLinkProc *linkProc; /* Function to process a 'Tcl_FSLink()' call. - * Should be implemented only if the - * filesystem supports links (reading or - * creating). */ + /* Called by 'Tcl_FSMatchInDirectory()'. NULL + * if the filesystem does not support glob or + * recursive copy. */ + Tcl_FSUtimeProc *utimeProc; /* Called by 'Tcl_FSUtime()', by 'file + * mtime' to set (not read) times, 'file + * atime', and the open-r/open-w/fcopy variant + * of 'file copy'. */ + Tcl_FSLinkProc *linkProc; /* Called by 'Tcl_FSLink()'. NULL if reading or + * creating links is not supported. */ Tcl_FSListVolumesProc *listVolumesProc; - /* Function to list any filesystem volumes - * added by this filesystem. Should be - * implemented only if the filesystem adds - * volumes at the head of the filesystem. */ + /* Lists filesystem volumes added by this + * filesystem. NULL if the filesystem does not + * use volumes. */ Tcl_FSFileAttrStringsProc *fileAttrStringsProc; - /* Function to list all attributes strings - * which are valid for this filesystem. If not - * implemented the filesystem will not support - * the 'file attributes' command. This allows - * arbitrary additional information to be - * attached to files in the filesystem. */ + /* List all valid attributes strings. NULL if + * the filesystem does not support the 'file + * attributes' command. Can be used to attach + * arbitrary additional data to files in a + * filesystem. */ Tcl_FSFileAttrsGetProc *fileAttrsGetProc; - /* Function to process a - * 'Tcl_FSFileAttrsGet()' call, used by 'file - * attributes'. */ + /* Called by 'Tcl_FSFileAttrsGet()' and by + * 'file attributes'. */ Tcl_FSFileAttrsSetProc *fileAttrsSetProc; - /* Function to process a - * 'Tcl_FSFileAttrsSet()' call, used by 'file - * attributes'. */ + /* Called by 'Tcl_FSFileAttrsSet()' and by + * 'file attributes'. */ Tcl_FSCreateDirectoryProc *createDirectoryProc; - /* Function to process a - * 'Tcl_FSCreateDirectory()' call. Should be - * implemented unless the FS is read-only. */ + /* Called by 'Tcl_FSCreateDirectory()'. May be + * NULL if the filesystem is read-only. */ Tcl_FSRemoveDirectoryProc *removeDirectoryProc; - /* Function to process a - * 'Tcl_FSRemoveDirectory()' call. Should be - * implemented unless the FS is read-only. */ + /* Called by 'Tcl_FSRemoveDirectory()'. May be + * NULL if the filesystem is read-only. */ Tcl_FSDeleteFileProc *deleteFileProc; - /* Function to process a 'Tcl_FSDeleteFile()' - * call. Should be implemented unless the FS - * is read-only. */ + /* Called by 'Tcl_FSDeleteFile()' May be NULL + * if the filesystem is is read-only. */ Tcl_FSCopyFileProc *copyFileProc; - /* Function to process a 'Tcl_FSCopyFile()' - * call. If not implemented Tcl will fall back - * on open-r, open-w and fcopy as a copying - * mechanism, for copying actions initiated in - * Tcl (not C). */ + /* Called by 'Tcl_FSCopyFile()'. If NULL, for + * a copy operation at the script level (not + * C) Tcl uses open-r, open-w and fcopy. */ Tcl_FSRenameFileProc *renameFileProc; - /* Function to process a 'Tcl_FSRenameFile()' - * call. If not implemented, Tcl will fall - * back on a copy and delete mechanism, for - * rename actions initiated in Tcl (not C). */ + /* Called by 'Tcl_FSRenameFile()'. If NULL, for + * a rename operation at the script level (not + * C) Tcl performs a copy operation followed + * by a delete operation. */ Tcl_FSCopyDirectoryProc *copyDirectoryProc; - /* Function to process a - * 'Tcl_FSCopyDirectory()' call. If not - * implemented, Tcl will fall back on a - * recursive create-dir, file copy mechanism, - * for copying actions initiated in Tcl (not - * C). */ - Tcl_FSLstatProc *lstatProc; /* Function to process a 'Tcl_FSLstat()' call. - * If not implemented, Tcl will attempt to use - * the 'statProc' defined above instead. */ + /* Called by 'Tcl_FSCopyDirectory()'. If NULL, + * for a copy operation at the script level + * (not C) Tcl recursively creates directories + * and copies files. */ + Tcl_FSLstatProc *lstatProc; /* Called by 'Tcl_FSLstat()'. If NULL, Tcl + * attempts to use 'statProc' instead. */ Tcl_FSLoadFileProc *loadFileProc; - /* Function to process a 'Tcl_FSLoadFile()' - * call. If not implemented, Tcl will fall - * back on a copy to native-temp followed by a - * Tcl_FSLoadFile on that temporary copy. */ + /* Called by 'Tcl_FSLoadFile()'. If NULL, Tcl + * performs a copy to a temporary file in the + * native filesystem and then calls + * Tcl_FSLoadFile() on that temporary copy. */ Tcl_FSGetCwdProc *getCwdProc; - /* Function to process a 'Tcl_FSGetCwd()' - * call. Most filesystems need not implement - * this. It will usually only be called once, - * if 'getcwd' is called before 'chdir'. May - * be NULL. */ - Tcl_FSChdirProc *chdirProc; /* Function to process a 'Tcl_FSChdir()' call. - * If filesystems do not implement this, it - * will be emulated by a series of directory - * access checks. Otherwise, virtual - * filesystems which do implement it need only - * respond with a positive return result if - * the dirName is a valid directory in their - * filesystem. They need not remember the - * result, since that will be automatically - * remembered for use by GetCwd. Real - * filesystems should carry out the correct - * action (i.e. call the correct system - * 'chdir' api). If not implemented, then 'cd' - * and 'pwd' will fail inside the - * filesystem. */ + /* Called by 'Tcl_FSGetCwd()'. Normally NULL. + * Usually only called once: If 'getcwd' is + * called before 'chdir' is ever called. */ + Tcl_FSChdirProc *chdirProc; /* Called by 'Tcl_FSChdir()'. For a virtual + * filesystem, chdirProc just returns zero + * (success) if the pathname is a valid + * directory, and some other value otherwise. + * For A real filesystem, chdirProc performs + * the correct action, e.g. calls the system + * 'chdir' function. If not implemented, then + * 'cd' and 'pwd' fail for a pathname in this + * filesystem. On success Tcl stores the + * pathname for use by GetCwd. If NULL, Tcl + * performs records the pathname as the new + * current directory if it passes a series of + * directory access checks. */ } Tcl_Filesystem; /* * The following definitions are used as values for the 'linkAction' flag to * Tcl_FSLink, or the linkProc of any filesystem. Any combination of flags can @@ -1693,12 +1830,12 @@ 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. */ - size_t size; /* Number of bytes in token. */ - size_t numComponents; /* If this token is composed of other tokens, + int size; /* Number of bytes in token. */ + int 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 * this one. */ } Tcl_Token; @@ -1760,11 +1897,11 @@ * the operator, then TCL_TOKEN_SUB_EXPR tokens * for the left then the right operands. * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR - * token is always preceeded by one + * token is always preceded by one * TCL_TOKEN_SUB_EXPR token for the operator's * subexpression, and is followed by zero or more * TCL_TOKEN_SUB_EXPR tokens for the operator's * operands. NumComponents is always 0. * TCL_TOKEN_EXPAND_WORD - This token is just like TCL_TOKEN_WORD except @@ -1808,11 +1945,11 @@ #define NUM_STATIC_TOKENS 20 typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - size_t commentSize; /* Number of bytes in comments (up through + int 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. */ @@ -1876,14 +2013,14 @@ /* Function to convert from external encoding * into UTF-8. */ Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ - Tcl_FreeProc *freeProc; + Tcl_EncodingFreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + ClientData clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ int nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is @@ -1908,33 +2045,32 @@ * perform any finalization that needs to occur * after the last byte is converted and then to * reset to an initial state. If the source * buffer contains the entire input stream to be * converted, this flag should be set. - * TCL_ENCODING_STOPONERROR - If set, then the converter will return - * immediately upon encountering an invalid byte - * sequence or a source character that has no - * mapping in the target encoding. If clear, then - * the converter will skip the problem, - * substituting one or more "close" characters in - * the destination buffer and then continue to + * TCL_ENCODING_STOPONERROR - If set, the converter returns immediately upon + * encountering an invalid byte sequence or a + * source character that has no mapping in the + * target encoding. If clear, the converter + * substitues the problematic character(s) with + * one or more "close" characters in the + * destination buffer and then continues to * convert the source. - * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf will not append a - * terminating NUL byte. Knowing that it will - * not need space to do so, it will fill all - * dstLen bytes with encoded UTF-8 content, as - * other circumstances permit. If clear, the - * default behavior is to reserve a byte in - * the dst space for NUL termination, and to - * append the NUL byte. + * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a + * terminating NUL byte. Since it does not need + * an extra byte for a terminating NUL, it fills + * all dstLen bytes with encoded UTF-8 content if + * needed. If clear, a byte is reserved in the + * dst space for NUL termination, and a + * terminating NUL is appended. * TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then - * Tcl_ExternalToUtf takes the initial value - * of *dstCharsPtr is taken as a limit of the - * maximum number of chars to produce in the - * encoded UTF-8 content. Otherwise, the - * number of chars produced is controlled only - * by other limiting factors. + * Tcl_ExternalToUtf takes the initial value of + * *dstCharsPtr as a limit of the maximum number + * of chars to produce in the encoded UTF-8 + * content. Otherwise, the number of chars + * produced is controlled only by other limiting + * factors. */ #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 #define TCL_ENCODING_STOPONERROR 0x04 @@ -1974,38 +2110,33 @@ #define TCL_CONVERT_UNKNOWN (-3) #define TCL_CONVERT_NOSPACE (-4) /* * The maximum number of bytes that are necessary to represent a single - * Unicode character in UTF-8. The valid values are 4 and 6 - * (or perhaps 1 if we want to support a non-unicode enabled core). If 4, - * then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6, - * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode - * is the default and recommended mode. UCS-4 is experimental and not - * recommended. It works for the core, but most extensions expect UCS-2. + * Unicode character in UTF-8. The valid values are 3 and 4 + * (or perhaps 1 if we want to support a non-unicode enabled core). If 3, + * then Tcl_UniChar must be 2-bytes in size (UTF-16) (the default). If > 3, + * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UTF-16 mode + * is the default and recommended mode. */ #ifndef TCL_UTF_MAX -#define TCL_UTF_MAX 4 +#define TCL_UTF_MAX 3 #endif /* * This represents a Unicode character. Any changes to this should also be * reflected in regcustom.h. */ -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 /* - * unsigned int isn't 100% accurate as it should be a strict 4-byte value - * (perhaps wchar_t). 64-bit systems may have troubles. The size of this - * value must be reflected correctly in regcustom.h and - * in tclEncoding.c. - * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode - * XXX: string rep that Tcl_UniChar represents. Changing the size - * XXX: of Tcl_UniChar is /not/ supported. + * int isn't 100% accurate as it should be a strict 4-byte value + * (perhaps wchar_t). ILP64/SILP64 systems may have troubles. The + * size of this value must be reflected correctly in regcustom.h. */ -typedef unsigned int Tcl_UniChar; +typedef int Tcl_UniChar; #else typedef unsigned short Tcl_UniChar; #endif /* @@ -2033,24 +2164,31 @@ /* * Structure containing information about a limit handler to be called when a * command- or time-limit is exceeded by an interpreter. */ -typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp); -typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData); +typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); +typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); +#if 0 /* *---------------------------------------------------------------------------- - * Override definitions for libtommath. + * We would like to provide an anonymous structure "mp_int" here, which is + * compatible with libtommath's "mp_int", but without duplicating anything + * from or including here. But the libtommath project + * didn't honor our request. See: + * + * That's why this part is commented out, and we are using (void *) in + * various API's in stead of the more correct (mp_int *). */ -typedef struct mp_int mp_int; +#ifndef MP_INT_DECLARED #define MP_INT_DECLARED -typedef unsigned int mp_digit; -#define MP_DIGIT_DECLARED -typedef unsigned TCL_WIDE_INT_TYPE mp_word; -#define MP_WORD_DECLARED +typedef struct mp_int mp_int; +#endif + +#endif /* *---------------------------------------------------------------------------- * Definitions needed for Tcl_ParseArgvObj routines. * Based on tkArgv.c. @@ -2065,11 +2203,11 @@ * depends on type.*/ void *dstPtr; /* Address of value to be modified; usage * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - void *clientData; /* Word to pass to function callbacks. */ + ClientData clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* * Legal values for the type field of a Tcl_ArgInfo: see the user * documentation for details. @@ -2088,13 +2226,13 @@ /* * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC * argument types: */ -typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr, +typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr, void *dstPtr); -typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp, +typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, void *dstPtr); /* * Shorthand for commonly used argTable entries. */ @@ -2163,32 +2301,32 @@ */ #define TCL_TCPSERVER_REUSEADDR (1<<0) #define TCL_TCPSERVER_REUSEPORT (1<<1) /* - * Constants for special size_t-typed values, see TIP #494 + * Constants for special int-typed values, see TIP #494 */ -#define TCL_IO_FAILURE ((size_t)-1) -#define TCL_AUTO_LENGTH ((size_t)-1) -#define TCL_INDEX_NONE ((size_t)-1) +#define TCL_IO_FAILURE (-1) +#define TCL_AUTO_LENGTH (-1) +#define TCL_INDEX_NONE (-1) /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ -typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, +typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, int result); /* *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the - * stubs tables. If TCL_UTF_MAX>4 use a different value. + * stubs tables. */ -#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *) + (TCL_UTF_MAX>4)) +#define TCL_STUB_MAGIC ((int) 0xFCA3BACF) /* * The following function is required to be defined in all stubs aware * extensions. The function is actually implemented in the stub library, not * the main Tcl library, although there is a trivial implementation in the @@ -2198,13 +2336,13 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); #if defined(_WIN32) - TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); #else -# define Tcl_ConsolePanic NULL +# define Tcl_ConsolePanic ((Tcl_PanicProc *)0) #endif #ifdef USE_TCL_STUBS #if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE # define Tcl_InitStubs(interp, version, exact) \ @@ -2234,24 +2372,19 @@ * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)())) -EXTERN TCL_NORETURN void Tcl_MainEx(int argc, char **argv, +EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); +EXTERN void Tcl_InitSubsystems(void); EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); -EXTERN void Tcl_FindExecutable(const char *argv0); -EXTERN void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *panicProc); -EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, - const char *pkgName, - Tcl_PackageInitProc *initProc, - Tcl_PackageInitProc *safeInitProc); -EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); -#ifndef _WIN32 +#ifdef _WIN32 +EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv); +#else EXTERN int TclZipfs_AppHook(int *argc, char ***argv); #endif /* *---------------------------------------------------------------------------- @@ -2274,28 +2407,46 @@ #include "tclPlatDecls.h" /* *---------------------------------------------------------------------------- - * The following declarations map ckalloc and ckfree to Tcl_Alloc and - * Tcl_Free. + * The following declarations either map ckalloc and ckfree to malloc and + * free, or they map them to functions with all sorts of debugging hooks + * defined in tclCkalloc.c. */ -#define ckalloc Tcl_Alloc -#define ckfree Tcl_Free -#define ckrealloc Tcl_Realloc -#define attemptckalloc Tcl_AttemptAlloc -#define attemptckrealloc Tcl_AttemptRealloc +#ifdef TCL_MEM_DEBUG + +# define ckalloc(x) \ + ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) +# define ckfree(x) \ + Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) +# define ckrealloc(x,y) \ + ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) +# define attemptckalloc(x) \ + ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) +# define attemptckrealloc(x,y) \ + ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) -#ifndef TCL_MEM_DEBUG +#else /* !TCL_MEM_DEBUG */ /* * If we are not using the debugging allocator, we should call the Tcl_Alloc, * et al. routines in order to guarantee that every module is using the same * memory allocator both inside and outside of the Tcl library. */ +# define ckalloc(x) \ + ((void *) Tcl_Alloc((unsigned)(x))) +# define ckfree(x) \ + Tcl_Free((char *)(x)) +# define ckrealloc(x,y) \ + ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) +# define attemptckalloc(x) \ + ((void *) Tcl_AttemptAlloc((unsigned)(x))) +# define attemptckrealloc(x,y) \ + ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory # define Tcl_DumpActiveMemory(x) # undef Tcl_ValidateAllMemory @@ -2311,10 +2462,29 @@ # define Tcl_DecrRefCount(objPtr) \ Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__) # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) +#else +# undef Tcl_IncrRefCount +# define Tcl_IncrRefCount(objPtr) \ + ++(objPtr)->refCount + /* + * Use do/while0 idiom for optimum correctness without compiler warnings. + * http://c2.com/cgi/wiki?TrivialDoWhileLoop + */ +# undef Tcl_DecrRefCount +# define Tcl_DecrRefCount(objPtr) \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if ((_objPtr)->refCount-- <= 1) { \ + TclFreeObj(_objPtr); \ + } \ + } while(0) +# undef Tcl_IsShared +# define Tcl_IsShared(objPtr) \ + ((objPtr)->refCount > 1) #endif /* * Macros and definitions that help to debug the use of Tcl objects. When * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call @@ -2352,11 +2522,11 @@ *---------------------------------------------------------------------------- * Macros for clients to use to access fields of hash entries: */ #define Tcl_GetHashValue(h) ((h)->clientData) -#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value)) +#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (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)) @@ -2364,15 +2534,49 @@ /* * Macros to use for clients to use to invoke find and create functions for * hash tables: */ +#undef Tcl_FindHashEntry #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) +#undef Tcl_CreateHashEntry #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) +/* + *---------------------------------------------------------------------------- + * Deprecated Tcl functions: + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +/* + * These function have been renamed. The old names are deprecated, but we + * define these macros for backwards compatibility. + */ + +# define Tcl_Ckalloc Tcl_Alloc +# define Tcl_Ckfree Tcl_Free +# define Tcl_Ckrealloc Tcl_Realloc +# define Tcl_Return Tcl_SetResult +# define Tcl_TildeSubst Tcl_TranslateFileName +#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */ +# define panic Tcl_Panic +#endif +# define panicVA Tcl_PanicVA + +/* + *---------------------------------------------------------------------------- + * Convenience declaration of Tcl_AppInit for backwards compatibility. This + * function is not *implemented* by the tcl library, so the storage class is + * neither DLLEXPORT nor DLLIMPORT. + */ + +extern Tcl_AppInitProc Tcl_AppInit; + +#endif /* !TCL_NO_DEPRECATED */ + #endif /* RC_INVOKED */ /* * end block for C++ */ Index: generic/tclAlloc.c ================================================================== --- generic/tclAlloc.c +++ generic/tclAlloc.c @@ -66,11 +66,11 @@ #define rangeCheckMagic ovu.rmagic #define realBlockSize ovu.size }; -#define MAGIC 0xef /* magic # on accounting info */ +#define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ #ifndef NDEBUG #define RSLOP sizeof(unsigned short) #else @@ -249,15 +249,15 @@ *---------------------------------------------------------------------- */ void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + unsigned int numBytes) /* Number of bytes to allocate. */ { - register union overhead *overPtr; - register size_t bucket; - register size_t amount; + union overhead *overPtr; + size_t bucket; + unsigned amount; struct block *bigBlockPtr = NULL; if (!allocInit) { /* * We have to make the "self initializing" because Tcl_Alloc may be @@ -272,12 +272,12 @@ * First the simple case: we simple allocate big blocks directly. */ if (numBytes >= MAXMALLOC - OVERHEAD) { if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) { - bigBlockPtr = TclpSysAlloc( - sizeof(struct block) + OVERHEAD + numBytes); + bigBlockPtr = (struct block *) TclpSysAlloc( + sizeof(struct block) + OVERHEAD + numBytes, 0); } if (bigBlockPtr == NULL) { Tcl_MutexUnlock(allocMutexPtr); return NULL; } @@ -286,11 +286,11 @@ bigBlockPtr->prevPtr = &bigBlocks; bigBlockPtr->nextPtr->prevPtr = bigBlockPtr; overPtr = (union overhead *) (bigBlockPtr + 1); overPtr->overMagic0 = overPtr->overMagic1 = MAGIC; - overPtr->bucketIndex = 0xff; + overPtr->bucketIndex = 0xFF; #ifdef MSTATS numMallocs[NBUCKETS]++; #endif #ifndef NDEBUG @@ -302,11 +302,11 @@ overPtr->rangeCheckMagic = RMAGIC; BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); - return (void *)(overPtr+1); + return (char *)(overPtr+1); } /* * Convert amount of memory requested into closest block size stored in * hash buckets which satisfies request. Account for space used per block @@ -343,11 +343,11 @@ * Remove from linked list */ nextf[bucket] = overPtr->next; overPtr->overMagic0 = overPtr->overMagic1 = MAGIC; - overPtr->bucketIndex = (unsigned char) bucket; + overPtr->bucketIndex = UCHAR(bucket); #ifdef MSTATS numMallocs[bucket]++; #endif @@ -385,12 +385,12 @@ static void MoreCore( size_t bucket) /* What bucket to allocate to. */ { - register union overhead *overPtr; - register size_t size; /* size of desired block */ + union overhead *overPtr; + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; /* @@ -403,11 +403,12 @@ amount = MAXMALLOC; numBlocks = amount / size; ASSERT(numBlocks*size == amount); - blockPtr = TclpSysAlloc(sizeof(struct block) + amount); + blockPtr = (struct block *) TclpSysAlloc( + (sizeof(struct block) + amount), 1); /* no more room! */ if (blockPtr == NULL) { return; } blockPtr->nextPtr = blockList; @@ -445,12 +446,12 @@ void TclpFree( void *oldPtr) /* Pointer to memory to free. */ { - register size_t size; - register union overhead *overPtr; + size_t size; + union overhead *overPtr; struct block *bigBlockPtr; if (oldPtr == NULL) { return; } @@ -466,11 +467,11 @@ } RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC); RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC); size = overPtr->bucketIndex; - if (size == 0xff) { + if (size == 0xFF) { #ifdef MSTATS numMallocs[NBUCKETS]--; #endif bigBlockPtr = (struct block *) overPtr - 1; @@ -509,11 +510,11 @@ */ void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + unsigned int numBytes) /* New size of memory. */ { int i; union overhead *overPtr; struct block *bigBlockPtr; int expensive; @@ -540,11 +541,11 @@ /* * If the block isn't in a bin, just realloc it. */ - if (i == 0xff) { + if (i == 0xFF) { struct block *prevPtr, *nextPtr; bigBlockPtr = (struct block *) overPtr - 1; prevPtr = bigBlockPtr->prevPtr; nextPtr = bigBlockPtr->nextPtr; bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, @@ -578,11 +579,11 @@ overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); BLOCK_END(overPtr) = RMAGIC; #endif Tcl_MutexUnlock(allocMutexPtr); - return (char *)(overPtr+1); + return (void *)(overPtr+1); } maxSize = 1 << (i+3); expensive = 0; if (numBytes+OVERHEAD > maxSize) { expensive = 1; @@ -642,12 +643,12 @@ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { - register unsigned int i, j; - register union overhead *overPtr; + unsigned int i, j; + union overhead *overPtr; size_t totalFree = 0, totalUsed = 0; Tcl_MutexLock(allocMutexPtr); fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); @@ -689,14 +690,13 @@ * None. * *---------------------------------------------------------------------- */ -#undef TclpAlloc void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + unsigned int numBytes) /* Number of bytes to allocate. */ { return malloc(numBytes); } /* @@ -713,11 +713,10 @@ * None. * *---------------------------------------------------------------------- */ -#undef TclpFree void TclpFree( void *oldPtr) /* Pointer to memory to free. */ { free(oldPtr); @@ -741,11 +740,11 @@ */ void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + unsigned int numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } #endif /* !USE_TCLALLOC */ Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -285,12 +285,11 @@ static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*); static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**); static void LookForFreshCatches(BasicBlock*, BasicBlock**); static void MoveCodeForJumps(AssemblyEnv*, int); -static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int, - int); +static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int); static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int); static int ProcessCatches(AssemblyEnv*); static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, BasicBlock*, enum BasicBlockCatchState, int); static void ResetVisitedBasicBlocks(AssemblyEnv*); @@ -408,10 +407,11 @@ {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0}, {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0}, {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0}, {"label", ASSEM_LABEL, 0, 0, 0}, + {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8 | INST_LAPPEND_SCALAR4), 1, 1}, {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8 | INST_LAPPEND_ARRAY4),2, 1}, @@ -435,10 +435,11 @@ | INST_LOAD_SCALAR4), 0, 1}, {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8 | INST_LOAD_ARRAY4), 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, {"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1}, + {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, {"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1}, {"lt", ASSEM_1BYTE, INST_LT, 2, 1}, {"mod", ASSEM_1BYTE, INST_MOD, 2, 1}, @@ -502,11 +503,11 @@ {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, - {NULL, 0, 0, 0, 0} + {NULL, ASSEM_1BYTE, 0, 0, 0} }; /* * List of instructions that cannot throw an exception under any * circumstances. These instructions are the ones that are permissible after @@ -673,11 +674,11 @@ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ - int op = TalInstructionTable[tblIdx].tclInstCode & 0xff; + int op = TalInstructionTable[tblIdx].tclInstCode & 0xFF; /* * If this is the first instruction in a basic block, record its line * number. */ @@ -735,17 +736,17 @@ /* Compilation environment */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ int op = TalInstructionTable[tblIdx].tclInstCode; - if (param <= 0xff) { + if (param <= 0xFF) { op >>= 8; } else { - op &= 0xff; + op &= 0xFF; } TclEmitInt1(op, envPtr); - if (param <= 0xff) { + if (param <= 0xFF) { TclEmitInt1(param, envPtr); } else { TclEmitInt4(param, envPtr); } TclUpdateAtCmdStart(op, envPtr); @@ -769,26 +770,26 @@ *----------------------------------------------------------------------------- */ int Tcl_AssembleObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, /* clientData */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* * Boilerplate - make sure that there is an NRE trampoline on the C stack * because there needs to be one in place to execute bytecode. */ - return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, clientData, objc, objv); } int TclNRAssembleObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ByteCode *codePtr; /* Pointer to the bytecode to execute */ @@ -849,17 +850,17 @@ Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ - register ByteCode *codePtr = NULL; + ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ - size_t sourceLen; /* Length of the source code in bytes */ + int sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ @@ -957,20 +958,18 @@ int TclCompileAssembleCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Token in the input script */ int numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; int depth = envPtr->currStackDepth; - /* * Make sure that the command has a single arg that is a simple word. */ if (parsePtr->numWords != 2) { @@ -989,11 +988,11 @@ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, TCL_EVAL_DIRECT)) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", - (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, + parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, Tcl_GetErrorLine(interp))); envPtr->numCommands = numCommands; envPtr->codeNext = envPtr->codeStart + offset; envPtr->currStackDepth = depth; TclCompileSyntaxError(interp, envPtr); @@ -1076,11 +1075,11 @@ /* * Process the line of code. */ if (parsePtr->numWords > 0) { - size_t instLen = parsePtr->commandSize; + int instLen = parsePtr->commandSize; /* Length in bytes of the current command */ if (parsePtr->term == parsePtr->commandStart + instLen - 1) { --instLen; } @@ -1089,12 +1088,12 @@ * If tracing, show each line assembled as it happens. */ #ifdef TCL_COMPILE_DEBUG if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) { - printf(" %4" TCL_Z_MODIFIER "d Assembling: ", - envPtr->codeNext - envPtr->codeStart); + printf(" %4ld Assembling: ", + (long)(envPtr->codeNext - envPtr->codeStart)); TclPrintSource(stdout, parsePtr->commandStart, TclMin(instLen, 55)); printf("\n"); } #endif @@ -1151,13 +1150,13 @@ * generation*/ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */ { Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ - AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv)); + AssemblyEnv* assemEnvPtr = (AssemblyEnv*)TclStackAlloc(interp, sizeof(AssemblyEnv)); /* Assembler environment under construction */ - Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse* parsePtr = (Tcl_Parse*)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Parse of one line of assembly code */ assemEnvPtr->envPtr = envPtr; assemEnvPtr->parsePtr = parsePtr; assemEnvPtr->cmdLine = 1; @@ -1216,18 +1215,18 @@ for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) { if (thisBB->jumpTarget != NULL) { Tcl_DecrRefCount(thisBB->jumpTarget); } if (thisBB->foreignExceptions != NULL) { - Tcl_Free(thisBB->foreignExceptions); + ckfree(thisBB->foreignExceptions); } nextBB = thisBB->successor1; if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } - Tcl_Free(thisBB); + ckfree(thisBB); } /* * Dispose what's left. */ @@ -1269,11 +1268,11 @@ * instruction */ enum TalInstType instType; /* Type of the instruction */ Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ - size_t operand1Len; /* String length of the operand */ + int operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ int localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ @@ -1542,11 +1541,11 @@ } if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } - jtPtr = Tcl_Alloc(sizeof(JumptableInfo)); + jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n", @@ -1705,13 +1704,11 @@ } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } { - int flags = TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0); - - BBEmitInstInt1(assemEnvPtr, tblIdx, flags, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0), 0); } break; case ASSEM_REVERSE: if (parsePtr->numWords != 2) { @@ -1816,11 +1813,10 @@ * code. */ int savedStackDepth = envPtr->currStackDepth; int savedMaxStackDepth = envPtr->maxStackDepth; - int savedCodeIndex = envPtr->codeNext - envPtr->codeStart; int savedExceptArrayNext = envPtr->exceptArrayNext; envPtr->currStackDepth = 0; envPtr->maxStackDepth = 0; @@ -1849,12 +1845,11 @@ /* * Save any exception ranges that were pushed by the compiler; they will * need to be fixed up once the stack depth is known. */ - MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex, - savedExceptArrayNext); + MoveExceptionRangesToBasicBlock(assemEnvPtr, savedExceptArrayNext); /* * Flush the current basic block. */ @@ -1909,11 +1904,10 @@ */ static void MoveExceptionRangesToBasicBlock( AssemblyEnv* assemEnvPtr, /* Assembly environment */ - int savedCodeIndex, /* Start of the embedded code */ int savedExceptArrayNext) /* Saved index of the end of the exception * range array */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -1941,11 +1935,11 @@ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n", curr_bb, exceptionCount, savedExceptArrayNext); curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = - Tcl_Alloc(exceptionCount * sizeof(ExceptionRange)); + (ExceptionRange*)ckalloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, envPtr->exceptArrayPtr + savedExceptArrayNext, exceptionCount * sizeof(ExceptionRange)); for (i = 0; i < exceptionCount; ++i) { curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth; @@ -2006,11 +2000,11 @@ /* * Allocate the jumptable. */ - jtPtr = Tcl_Alloc(sizeof(JumptableInfo)); + jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); jtHashPtr = &jtPtr->hashTable; Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); /* * Fill the keys and labels into the table. @@ -2066,16 +2060,16 @@ Tcl_Obj* label; /* Jump label from the hash table */ for (entry = Tcl_FirstHashEntry(jtHashPtr, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { - label = Tcl_GetHashValue(entry); + label = (Tcl_Obj*)Tcl_GetHashValue(entry); Tcl_DecrRefCount(label); Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); - Tcl_Free(jtPtr); + ckfree(jtPtr); } /* *----------------------------------------------------------------------------- * @@ -2237,11 +2231,11 @@ * Results: * Returns a standard Tcl result: TCL_OK if the parse is successful and * TCL_ERROR (with an appropriate error message) if the parse fails. * * Side effects: - * Stores the list index at '*index'. Values between -1 and 0x7fffffff + * Stores the list index at '*index'. Values between -1 and 0x7FFFFFFF * have their natural meaning; values between -2 and -0x80000000 * represent 'end-2-N'. * *----------------------------------------------------------------------------- */ @@ -2314,11 +2308,11 @@ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; - size_t varNameLen; + int varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return -1; } @@ -2400,11 +2394,11 @@ Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ - if (value < 0 || value > 0xff) { + if (value < 0 || value > 0xFF) { result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; } @@ -2435,11 +2429,11 @@ Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ - if (value > 0x7f || value < -0x80) { + if (value > 0x7F || value < -0x80) { result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; } @@ -2654,11 +2648,11 @@ static BasicBlock * AllocBB( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; - BasicBlock *bb = Tcl_Alloc(sizeof(BasicBlock)); + BasicBlock *bb = (BasicBlock*)ckalloc(sizeof(BasicBlock)); bb->originalStartOffset = bb->startOffset = envPtr->codeNext - envPtr->codeStart; bb->startLine = assemEnvPtr->cmdLine + 1; bb->jumpOffset = -1; @@ -2845,15 +2839,15 @@ /* * If the instruction is a JUMP1, turn it into a JUMP4 if its * target is out of range. */ - jumpTarget = Tcl_GetHashValue(entry); + jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); if (bbPtr->flags & BB_JUMP1) { offset = jumpTarget->startOffset - (bbPtr->jumpOffset + motion); - if (offset < -0x80 || offset > 0x7f) { + if (offset < -0x80 || offset > 0x7F) { opcode = TclGetUInt1AtPtr(envPtr->codeStart + bbPtr->jumpOffset); ++opcode; TclStoreInt1AtPtr(opcode, envPtr->codeStart + bbPtr->jumpOffset); @@ -2912,11 +2906,11 @@ DEBUG_PRINT("check jump table labels %p {\n", bbPtr); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { - symbolObj = Tcl_GetHashValue(symEntryPtr); + symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), TclGetString(symbolObj), (valEntryPtr != NULL)); @@ -3041,11 +3035,11 @@ bbPtr != NULL; bbPtr = bbPtr->successor1) { if (bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(bbPtr->jumpTarget)); - jumpTarget = Tcl_GetHashValue(entry); + jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); fromOffset = bbPtr->jumpOffset; targetOffset = jumpTarget->startOffset; if (bbPtr->flags & BB_JUMP1) { TclStoreInt1AtPtr(targetOffset - fromOffset, envPtr->codeStart + fromOffset + 1); @@ -3100,11 +3094,11 @@ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); - realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex); + realJumpTablePtr = (JumptableInfo*)TclFetchAuxData(envPtr, auxDataIndex); realJumpHashPtr = &realJumpTablePtr->hashTable; /* * Look up every jump target in the jump hash. */ @@ -3111,16 +3105,16 @@ DEBUG_PRINT("resolve jump table {\n"); for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { - symbolObj = Tcl_GetHashValue(symEntryPtr); + symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr); DEBUG_PRINT(" symbol %s\n", TclGetString(symbolObj)); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(symbolObj)); - jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr); + jumpTargetBBPtr = (BasicBlock*)Tcl_GetHashValue(valEntryPtr); realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr, Tcl_GetHashKey(symHash, symEntryPtr), &junk); DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), @@ -3495,11 +3489,11 @@ } if (result == TCL_OK && blockPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(blockPtr->jumpTarget)); - jumpTarget = Tcl_GetHashValue(entry); + jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } /* @@ -3509,14 +3503,14 @@ if (blockPtr->flags & BB_JUMPTABLE) { for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable, &jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { - targetLabel = Tcl_GetHashValue(jtEntry); + targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(targetLabel)); - jumpTarget = Tcl_GetHashValue(entry); + jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } } @@ -3817,11 +3811,11 @@ fallThruEnclosing, fallThruState, catchDepth); } if (result == TCL_OK && bbPtr->jumpTarget != NULL) { entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(bbPtr->jumpTarget)); - jumpTarget = Tcl_GetHashValue(entry); + jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, jumpEnclosing, jumpState, catchDepth); } /* @@ -3830,14 +3824,14 @@ if (bbPtr->flags & BB_JUMPTABLE) { for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { - targetLabel = Tcl_GetHashValue(jtEntry); + targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(targetLabel)); - jumpTarget = Tcl_GetHashValue(entry); + jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, jumpEnclosing, jumpState, catchDepth); } } @@ -3932,12 +3926,12 @@ /* * Allocate memory for a stack of active catches. */ - catches = Tcl_Alloc(maxCatchDepth * sizeof(BasicBlock*)); - catchIndices = Tcl_Alloc(maxCatchDepth * sizeof(int)); + catches = (BasicBlock**)ckalloc(maxCatchDepth * sizeof(BasicBlock*)); + catchIndices = (int *)ckalloc(maxCatchDepth * sizeof(int)); for (i = 0; i < maxCatchDepth; ++i) { catches[i] = NULL; catchIndices[i] = -1; } @@ -3972,12 +3966,12 @@ "tclAssembly.c:BuildExceptionRanges, can't happen"); } /* Free temp storage */ - Tcl_Free(catchIndices); - Tcl_Free(catches); + ckfree(catchIndices); + ckfree(catches); return TCL_OK; } /* @@ -4001,11 +3995,11 @@ BasicBlock** catches, /* Array of catch contexts */ int* catchIndices) /* Indices of the exception ranges * corresponding to the catch contexts */ { ExceptionRange* range; /* Exception range for a specific catch */ - BasicBlock* catch; /* Catch block being examined */ + BasicBlock* block; /* Catch block being examined */ BasicBlockCatchState catchState; /* State of the code relative to the catch * block being examined ("in catch" or * "caught"). */ @@ -4029,22 +4023,22 @@ * either because they are no longer part of the context, or because the * context has changed from INCATCH to CAUGHT. */ catchState = bbPtr->catchState; - catch = bbPtr->enclosingCatch; + block = bbPtr->enclosingCatch; while (catchDepth > 0) { --catchDepth; if (catches[catchDepth] != NULL) { - if (catches[catchDepth] != catch || catchState >= BBCS_CAUGHT) { + if (catches[catchDepth] != block || catchState >= BBCS_CAUGHT) { range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; catchIndices[catchDepth] = -1; } - catchState = catch->catchState; - catch = catch->enclosingCatch; + catchState = block->catchState; + block = block->enclosingCatch; } } } /* @@ -4069,23 +4063,23 @@ * entered */ { BasicBlockCatchState catchState; /* State ("in catch" or "caught") of the * current catch. */ - BasicBlock* catch; /* Current enclosing catch */ + BasicBlock* block; /* Current enclosing catch */ int catchDepth; /* Nesting depth of the current catch */ catchState = bbPtr->catchState; - catch = bbPtr->enclosingCatch; + block = bbPtr->enclosingCatch; catchDepth = bbPtr->catchDepth; while (catchDepth > 0) { --catchDepth; - if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) { - catches[catchDepth] = catch; + if (catches[catchDepth] != block && catchState < BBCS_CAUGHT) { + catches[catchDepth] = block; } - catchState = catch->catchState; - catch = catch->enclosingCatch; + catchState = block->catchState; + block = block->enclosingCatch; } } /* *----------------------------------------------------------------------------- @@ -4109,11 +4103,11 @@ * corresponding to the catch contexts */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ ExceptionRange* range; /* Exception range for a specific catch */ - BasicBlock* catch; /* Catch block being examined */ + BasicBlock* block; /* Catch block being examined */ BasicBlock* errorExit; /* Error exit from the catch block */ Tcl_HashEntry* entryPtr; catchDepth = 0; @@ -4126,27 +4120,27 @@ if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) { /* * Create an exception range for a block that needs one. */ - catch = catches[catchDepth]; + block = catches[catchDepth]; catchIndices[catchDepth] = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->nestingLevel = envPtr->exceptDepth + catchDepth; envPtr->maxExceptDepth = TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth); range->codeOffset = bbPtr->startOffset; entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, - TclGetString(catch->jumpTarget)); + TclGetString(block->jumpTarget)); if (entryPtr == NULL) { Tcl_Panic("undefined label in tclAssembly.c:" "BuildExceptionRanges, can't happen"); } - errorExit = Tcl_GetHashValue(entryPtr); + errorExit = (BasicBlock*)Tcl_GetHashValue(entryPtr); range->catchOffset = errorExit->startOffset; } } } @@ -4315,12 +4309,12 @@ *----------------------------------------------------------------------------- */ static void DupAssembleCodeInternalRep( - Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr) + TCL_UNUSED(Tcl_Obj *), + TCL_UNUSED(Tcl_Obj *)) { return; } /* Index: generic/tclAsync.c ================================================================== --- generic/tclAsync.c +++ generic/tclAsync.c @@ -116,11 +116,11 @@ ClientData clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - asyncPtr = Tcl_Alloc(sizeof(AsyncHandler)); + asyncPtr = (AsyncHandler*)ckalloc(sizeof(AsyncHandler)); asyncPtr->ready = 0; asyncPtr->nextPtr = NULL; asyncPtr->proc = proc; asyncPtr->clientData = clientData; asyncPtr->originTsd = tsdPtr; @@ -308,11 +308,11 @@ if (asyncPtr == tsdPtr->lastHandler) { tsdPtr->lastHandler = prevPtr; } } Tcl_MutexUnlock(&tsdPtr->asyncMutex); - Tcl_Free(asyncPtr); + ckfree(asyncPtr); } /* *---------------------------------------------------------------------- * Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -18,11 +18,11 @@ */ #include "tclInt.h" #include "tclOOInt.h" #include "tclCompile.h" -#include "tommath.h" +#include "tclTomMath.h" #include #include /* * TCL_FPCLASSIFY_MODE: @@ -31,24 +31,37 @@ * 2 - simulate * 3 - __builtin_fpclassify */ #ifndef TCL_FPCLASSIFY_MODE +#if defined(__MINGW32__) && defined(_X86_) /* mingw 32-bit */ /* * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, - * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to _fpclass + * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to using a + * version using a compiler built-in. */ -# if ( defined(__MINGW32__) && defined(_X86_) ) /* mingw 32-bit */ -# define TCL_FPCLASSIFY_MODE 1 -# elif defined(fpclassify) /* fpclassify */ -# include -# define TCL_FPCLASSIFY_MODE 0 -# elif defined(_FPCLASS_NN) /* _fpclass */ -# define TCL_FPCLASSIFY_MODE 1 -# else /* !fpclassify && !_fpclass (older MSVC), simulate */ -# define TCL_FPCLASSIFY_MODE 2 -# endif /* !fpclassify */ +#define TCL_FPCLASSIFY_MODE 1 +#elif defined(fpclassify) /* fpclassify */ +/* + * This is the C99 standard. + */ +#include +#define TCL_FPCLASSIFY_MODE 0 +#elif defined(_FPCLASS_NN) /* _fpclass */ +/* + * This case handles newer MSVC on Windows, which doesn't have the standard + * operation but does have something that can tell us the same thing. + */ +#define TCL_FPCLASSIFY_MODE 1 +#else /* !fpclassify && !_fpclass (older MSVC), simulate */ +/* + * Older MSVC on Windows. So broken that we just have to do it our way. This + * assumes that we're on x86 (or at least a system with classic little-endian + * double layout and a 32-bit 'int' type). + */ +#define TCL_FPCLASSIFY_MODE 2 +#endif /* !fpclassify */ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ #define INTERP_STACK_INITIAL_SIZE 2000 @@ -62,10 +75,22 @@ # define IEEE_FLOATING_POINT /* Largest odd integer that can be represented exactly in a double */ # define MAX_EXACT 9007199254740991.0 #endif +/* + * The following structure defines the client data for a math function + * registered with Tcl_CreateMathFunc + */ + +typedef struct OldMathFuncData { + Tcl_MathProc *proc; /* Handler function */ + int numArgs; /* Number of args expected */ + Tcl_ValueType *argTypes; /* Types of the args */ + ClientData clientData; /* Client data for the handler function */ +} OldMathFuncData; + /* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments @@ -78,12 +103,12 @@ Tcl_Interp *interp; /* Interp this struct belongs to. */ Tcl_AsyncHandler async; /* Async handler token for script * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ - size_t length; /* Length of the above error message. */ - ClientData clientData; /* Ignored */ + int length; /* Length of the above error message. */ + ClientData clientData; /* Not used. */ int flags; /* Additional flags */ } CancelInfo; static Tcl_HashTable cancelTable; static int cancelTableInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(cancelLock); @@ -163,10 +188,14 @@ int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; +#if !defined(TCL_NO_DEPRECATED) +static Tcl_ObjCmdProc OldMathFuncProc; +static void OldMathFuncDeleteProc(ClientData clientData); +#endif /* !defined(TCL_NO_DEPRECATED) */ static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, @@ -257,10 +286,13 @@ */ {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, +#endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, 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}, @@ -419,49 +451,49 @@ typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - ClientData clientData; /* Client data for the function */ + double (*fn)(double x); /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, - { "acos", ExprUnaryFunc, (ClientData) acos }, - { "asin", ExprUnaryFunc, (ClientData) asin }, - { "atan", ExprUnaryFunc, (ClientData) atan }, - { "atan2", ExprBinaryFunc, (ClientData) atan2 }, + { "acos", ExprUnaryFunc, acos }, + { "asin", ExprUnaryFunc, asin }, + { "atan", ExprUnaryFunc, atan }, + { "atan2", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) atan2}, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, (ClientData) cos }, - { "cosh", ExprUnaryFunc, (ClientData) cosh }, + { "cos", ExprUnaryFunc, cos }, + { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, (ClientData) exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, (ClientData) fmod }, - { "hypot", ExprBinaryFunc, (ClientData) hypot }, + { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, + { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, { "int", ExprIntFunc, NULL }, { "isfinite", ExprIsFiniteFunc, NULL }, { "isinf", ExprIsInfinityFunc, NULL }, { "isnan", ExprIsNaNFunc, NULL }, { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, { "issubnormal", ExprIsSubnormalFunc, NULL, }, { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, (ClientData) log }, - { "log10", ExprUnaryFunc, (ClientData) log10 }, + { "log", ExprUnaryFunc, log }, + { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, (ClientData) pow }, + { "pow", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) pow}, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, (ClientData) sin }, - { "sinh", ExprUnaryFunc, (ClientData) sinh }, + { "sin", ExprUnaryFunc, sin }, + { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, (ClientData) tan }, - { "tanh", ExprUnaryFunc, (ClientData) tanh }, + { "tan", ExprUnaryFunc, tan }, + { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } }; /* @@ -611,30 +643,30 @@ ByteCodeStats *statsPtr; #endif /* TCL_COMPILE_STATS */ char mathFuncName[32]; CallFrame *framePtr; - TclInitSubsystems(); + Tcl_InitSubsystems(); /* * Panic if someone updated the CallFrame structure without also updating * the Tcl_CallFrame structure (or vice versa). */ if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) { - /*NOTREACHED*/ Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } -#if defined(_WIN32) && !defined(_WIN64) - if (sizeof(time_t) != 4) { - /*NOTREACHED*/ - Tcl_Panic(" is not compatible with MSVC"); - } +#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) + /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T + * the result is a binary incompatible with the 'standard' build of + * Tcl: All extensions using Tcl_StatBuf need to be recompiled in + * the same way. Therefore, this is not officially supported. + * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet) + */ if ((offsetof(Tcl_StatBuf,st_atime) != 32) || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { - /*NOTREACHED*/ Tcl_Panic(" is not compatible with MSVC"); } #endif if (cancelTableInitialized == 0) { @@ -664,27 +696,29 @@ * Initialize support for namespaces and create the global namespace * (whose name is ""; an alias is "::"). This also initializes the Tcl * object type table and other object management code. */ - iPtr = Tcl_Alloc(sizeof(Interp)); + iPtr = (Interp *)ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; - iPtr->legacyResult = NULL; - /* Special invalid value: Any attempt to free the legacy result - * will cause a crash. */ - iPtr->legacyFreeProc = (void (*) (void))-1; +#ifdef TCL_NO_DEPRECATED + iPtr->result = &tclEmptyString; +#else + iPtr->result = iPtr->resultSpace; +#endif + iPtr->freeProc = NULL; iPtr->errorLine = 0; - iPtr->stubTable = &tclStubs; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; - iPtr->optimizer = TclOptimizeBytecode; + TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); + iPtr->extra.optimizer = TclOptimizeBytecode; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ @@ -693,14 +727,14 @@ * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc * structures. */ iPtr->cmdFramePtr = NULL; - iPtr->linePBodyPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); - iPtr->lineBCPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); - iPtr->lineLAPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); - iPtr->lineLABCPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->linePBodyPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + iPtr->lineBCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + iPtr->lineLAPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + iPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); iPtr->scriptCLLocPtr = NULL; @@ -728,10 +762,16 @@ iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; + +#ifndef TCL_NO_DEPRECATED + iPtr->appendResult = NULL; + iPtr->appendAvl = 0; + iPtr->appendUsed = 0; +#endif Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; /* TIP #268 */ @@ -757,10 +797,13 @@ iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); +#ifndef TCL_NO_DEPRECATED + iPtr->resultSpace[0] = 0; +#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ #ifdef TCL_INTERP_DEBUG_FRAME iPtr->flags |= INTERP_DEBUG_FRAME; @@ -790,11 +833,11 @@ * Initialise the rootCallframe. It cannot be allocated on the stack, as * it has to be in place before TclCreateExecEnv tries to use a variable. */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - framePtr = Tcl_Alloc(sizeof(CallFrame)); + framePtr = (CallFrame *)ckalloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; iPtr->framePtr = framePtr; @@ -820,11 +863,11 @@ * TIP #285, Script cancellation support. */ iPtr->asyncCancelMsg = Tcl_NewObj(); - cancelInfo = Tcl_Alloc(sizeof(CancelInfo)); + cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); cancelInfo->async = iPtr->asyncCancel; cancelInfo->result = NULL; @@ -866,10 +909,16 @@ statsPtr->totalLitStringBytes = 0.0; statsPtr->currentLitStringBytes = 0.0; memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount)); #endif /* TCL_COMPILE_STATS */ + /* + * Initialise the stub table pointer. + */ + + iPtr->stubTable = &tclStubs; + /* * Initialize the ensemble error message rewriting support. */ TclResetRewriteEnsemble(interp, 1); @@ -884,11 +933,11 @@ * Initialise the thread-specific data ekeko. Note that the thread's alloc * cache was already initialised by the call to alloc the interp struct. */ #if TCL_THREADS && defined(USE_THREAD_ALLOC) - iPtr->allocCache = TclpGetAllocCache(); + iPtr->allocCache = (AllocCache *)TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); @@ -913,11 +962,11 @@ } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { - cmdPtr = Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *)ckalloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = cmdInfoPtr->compileProc; @@ -1027,11 +1076,11 @@ memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, - builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL); + builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); } /* * Register the mathematical "operator" commands. [TIP #174] @@ -1043,11 +1092,11 @@ } Tcl_Export(interp, nsPtr, "*", 1); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ - TclOpCmdClientData *occdPtr = Tcl_Alloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)ckalloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; occdPtr->expected = opcmdInfoPtr->expected; strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name); @@ -1101,10 +1150,15 @@ * Set up other variables such as tcl_version and tcl_library */ Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + Tcl_TraceVar2(interp, "tcl_precision", NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + TclPrecTraceProc, NULL); +#endif /* !TCL_NO_DEPRECATED */ TclpSetVariables(interp); #if TCL_THREADS /* * The existence of the "threaded" element of the tcl_platform array @@ -1122,28 +1176,28 @@ */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); if (TclTommath_Init(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetStringResult(interp)); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } if (TclOOInit(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetStringResult(interp)); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } /* * Only build in zlib support if we've successfully detected a library to * compile and link against. */ #ifdef HAVE_ZLIB if (TclZlibInit(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetStringResult(interp)); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } if (TclZipfs_Init(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetStringResult(interp)); + Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } #endif TOP_CB(iPtr) = NULL; return interp; @@ -1151,13 +1205,13 @@ static void DeleteOpCmdClientData( ClientData clientData) { - TclOpCmdClientData *occdPtr = clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; - Tcl_Free(occdPtr); + ckfree(occdPtr); } /* * --------------------------------------------------------------------- * @@ -1202,11 +1256,11 @@ const char * TclGetCommandTypeName( Tcl_Command command) { Command *cmdPtr = (Command *) command; - void *procPtr = cmdPtr->objProc; + Tcl_ObjCmdProc *procPtr = cmdPtr->objProc; const char *name = "native"; if (procPtr == NULL) { procPtr = cmdPtr->nreProc; } @@ -1241,12 +1295,12 @@ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { - register const CmdInfo *cmdInfoPtr; - register const UnsafeEnsembleInfo *unsafePtr; + const CmdInfo *cmdInfoPtr; + const UnsafeEnsembleInfo *unsafePtr; if (interp == NULL) { return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { @@ -1271,14 +1325,14 @@ "___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_GetString(Tcl_GetObjResult(interp))); } Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (ClientData) unsafePtr, NULL); + BadEnsembleSubcommand, (void *)unsafePtr, NULL); TclDecrRefCount(cmdName); TclDecrRefCount(hideName); } else { /* * Hide an ensemble main command (for compatibility). @@ -1286,11 +1340,11 @@ if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, unsafePtr->ensembleNsName) != TCL_OK) { Tcl_Panic("problem making '%s' safe: %s", unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); + Tcl_GetString(Tcl_GetObjResult(interp))); } } } return TCL_OK; @@ -1316,14 +1370,14 @@ static int BadEnsembleSubcommand( ClientData clientData, Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /* objv */) { - const UnsafeEnsembleInfo *infoPtr = clientData; + const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "not allowed to invoke subcommand %s of %s", infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); @@ -1359,21 +1413,21 @@ ClientData clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = - Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); + (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; - AssocData *dPtr = Tcl_Alloc(sizeof(AssocData)); + AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { - iPtr->assocData = Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); dPtr->proc = proc; dPtr->clientData = clientData; @@ -1416,13 +1470,13 @@ if (hTablePtr == NULL) { return; } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - dPtr = Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { - Tcl_Free(dPtr); + ckfree(dPtr); Tcl_DeleteHashEntry(hPtr); return; } } } @@ -1458,18 +1512,18 @@ AssocData *dPtr; Tcl_HashEntry *hPtr; int isNew; if (iPtr->assocData == NULL) { - iPtr->assocData = Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { - dPtr = Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); } else { - dPtr = Tcl_Alloc(sizeof(AssocData)); + dPtr = (AssocData *)ckalloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; Tcl_SetHashValue(hPtr, dPtr); @@ -1506,15 +1560,15 @@ } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return; } - dPtr = Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - Tcl_Free(dPtr); + ckfree(dPtr); Tcl_DeleteHashEntry(hPtr); } /* *---------------------------------------------------------------------- @@ -1551,11 +1605,11 @@ } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return NULL; } - dPtr = Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (procPtr != NULL) { *procPtr = dPtr->proc; } return dPtr->clientData; } @@ -1702,17 +1756,17 @@ */ Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr); if (hPtr != NULL) { - CancelInfo *cancelInfo = Tcl_GetHashValue(hPtr); + CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { - Tcl_Free(cancelInfo->result); + ckfree(cancelInfo->result); } - Tcl_Free(cancelInfo); + ckfree(cancelInfo); } Tcl_DeleteHashEntry(hPtr); } @@ -1760,14 +1814,14 @@ * hiddenCmdTablePtr. */ hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr)); + Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); - Tcl_Free(hTablePtr); + ckfree(hTablePtr); } /* * Invoke deletion callbacks; note that a callback can create new * callbacks, so we iterate. @@ -1779,19 +1833,19 @@ hTablePtr = iPtr->assocData; iPtr->assocData = NULL; for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { - dPtr = Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - Tcl_Free(dPtr); + ckfree(dPtr); } Tcl_DeleteHashTable(hTablePtr); - Tcl_Free(hTablePtr); + ckfree(hTablePtr); } /* * Pop the root frame pointer and finish deleting the global * namespace. The order is important [Bug 1658572]. @@ -1799,20 +1853,23 @@ if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) { Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top"); } Tcl_PopCallFrame(interp); - Tcl_Free(iPtr->rootFramePtr); + ckfree(iPtr->rootFramePtr); iPtr->rootFramePtr = NULL; Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr); /* * Free up the result *after* deleting variables, since variable deletion * could have transferred ownership of the result string to Tcl. */ +#ifndef TCL_NO_DEPRECATED Tcl_FreeResult(interp); + iPtr->result = NULL; +#endif Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); if (iPtr->errorCode) { Tcl_DecrRefCount(iPtr->errorCode); @@ -1830,10 +1887,16 @@ Tcl_DecrRefCount(iPtr->innerLiteral); Tcl_DecrRefCount(iPtr->innerContext); if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } +#ifndef TCL_NO_DEPRECATED + if (iPtr->appendResult != NULL) { + ckfree(iPtr->appendResult); + iPtr->appendResult = NULL; + } +#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); } if (iPtr->execEnvPtr != NULL) { @@ -1847,12 +1910,12 @@ iPtr->emptyObjPtr = NULL; resPtr = iPtr->resolverPtr; while (resPtr) { nextResPtr = resPtr->nextPtr; - Tcl_Free(resPtr->name); - Tcl_Free(resPtr); + ckfree(resPtr->name); + ckfree(resPtr); resPtr = nextResPtr; } /* * Free up literal objects created for scripts compiled by the @@ -1867,52 +1930,52 @@ */ for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); + CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; if (cfPtr) { if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); } - Tcl_Free(cfPtr->line); - Tcl_Free(cfPtr); + ckfree(cfPtr->line); + ckfree(cfPtr); } Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); - Tcl_Free(iPtr->linePBodyPtr); + ckfree(iPtr->linePBodyPtr); iPtr->linePBodyPtr = NULL; /* * See also tclCompile.c, TclCleanupByteCode */ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr); + ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0; i< eclPtr->nuloc; i++) { - Tcl_Free(eclPtr->loc[i].line); + ckfree(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - Tcl_Free(eclPtr->loc); + ckfree(eclPtr->loc); } - Tcl_Free(eclPtr); + ckfree(eclPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->lineBCPtr); - Tcl_Free(iPtr->lineBCPtr); + ckfree(iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; /* * Location stack for uplevel/eval/... scripts which were passed through * proc arguments. Actually we track all arguments as we do not and cannot @@ -1927,11 +1990,11 @@ Tcl_Panic("Argument location tracking table not empty"); } Tcl_DeleteHashTable(iPtr->lineLAPtr); - Tcl_Free(iPtr->lineLAPtr); + ckfree(iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { /* * When the interp goes away we have nothing on the stack, so there @@ -1940,11 +2003,11 @@ Tcl_Panic("Argument location tracking table not empty"); } Tcl_DeleteHashTable(iPtr->lineLABCPtr); - Tcl_Free(iPtr->lineLABCPtr); + ckfree(iPtr->lineLABCPtr); iPtr->lineLABCPtr = NULL; /* * Squelch the tables of traces on variables and searches over arrays in * the in the interpreter. @@ -1951,11 +2014,11 @@ */ Tcl_DeleteHashTable(&iPtr->varTraces); Tcl_DeleteHashTable(&iPtr->varSearches); - Tcl_Free(iPtr); + ckfree(iPtr); } /* *--------------------------------------------------------------------------- * @@ -2055,11 +2118,11 @@ * Initialize the hidden command table if necessary. */ hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { - hiddenCmdTablePtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + hiddenCmdTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } /* @@ -2195,11 +2258,11 @@ "unknown hidden command \"%s\"", hiddenCmdToken)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", hiddenCmdToken, NULL); return TCL_ERROR; } - cmdPtr = Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Check that we have a true global namespace command (enforced by * Tcl_HideCommand but let's double check. (If it was not, we would not * really know how to handle it). @@ -2391,11 +2454,11 @@ /* * An existing command conflicts. Try to delete it... */ - cmdPtr = Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore * them down below. That way, you can redefine a command and its * import status will remain intact. @@ -2421,11 +2484,11 @@ * If the deletion callback recreated the command, just throw away the * new command (if we try to delete it again, we could get stuck in an * infinite loop). */ - Tcl_Free(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); } if (!deleted) { /* * Command resolvers (per-interp, per-namespace) might have resolved @@ -2446,11 +2509,11 @@ */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *)ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; @@ -2473,11 +2536,11 @@ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = refCmdPtr->objClientData; + dataPtr = (ImportedCmdData *)refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } } @@ -2504,10 +2567,11 @@ * future calls to Tcl_GetCommandName. * * Side effects: * If a command named "cmdName" already exists for interp, it is * first deleted. Then the new command is created from the arguments. + * [***] (See below for exception). * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details @@ -2571,11 +2635,11 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace * components. */ - Tcl_Namespace *namespace, /* The namespace to create the command in */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ ClientData clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) @@ -2585,11 +2649,11 @@ int deleted = 0, isNew = 0; Command *cmdPtr; ImportRef *oldRefPtr = NULL; ImportedCmdData *dataPtr; Tcl_HashEntry *hPtr; - Namespace *nsPtr = (Namespace *) namespace; + Namespace *nsPtr = (Namespace *) namesp; /* * If the command name we seek to create already exists, we need to delete * that first. That can be tricky in the presence of traces. Loop until we * no longer find an existing command in the way, or until we've deleted @@ -2609,14 +2673,31 @@ /* * An existing command conflicts. Try to delete it... */ - cmdPtr = Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + + /* + * [***] This is wrong. See Tcl Bug a16752c252. + * However, this buggy behavior is kept under particular circumstances + * to accommodate deployed binaries of the "tclcompiler" program + * that crash if the bug is + * fixed. + */ + + if (cmdPtr->objProc == TclInvokeStringCommand + && cmdPtr->clientData == clientData + && cmdPtr->deleteData == clientData + && cmdPtr->deleteProc == deleteProc) { + cmdPtr->objProc = proc; + cmdPtr->objClientData = clientData; + return (Tcl_Command) cmdPtr; + } /* - * Command already exists; delete it. Be careful to preserve any + * Otherwise, we delete the old command. Be careful to preserve any * existing import links so we can restore them down below. That way, * you can redefine a command and its import status will remain * intact. */ @@ -2648,11 +2729,11 @@ * If the deletion callback recreated the command, just throw away the * new command (if we try to delete it again, we could get stuck in an * infinite loop). */ - Tcl_Free(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); } if (!deleted) { /* * Command resolvers (per-interp, per-namespace) might have resolved @@ -2673,11 +2754,11 @@ */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *)ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; @@ -2701,11 +2782,11 @@ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = refCmdPtr->objClientData; + dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } } @@ -2743,16 +2824,16 @@ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Command *cmdPtr = clientData; + Command *cmdPtr = (Command *)clientData; int i, result; - const char **argv = + const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { argv[i] = TclGetString(objv[i]); } @@ -2792,16 +2873,16 @@ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - register const char **argv) /* Argument strings. */ + const char **argv) /* Argument strings. */ { - Command *cmdPtr = clientData; + Command *cmdPtr = ( Command *) clientData; Tcl_Obj *objPtr; int i, length, result; - Tcl_Obj **objv = + Tcl_Obj **objv = (Tcl_Obj **) TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *))); for (i = 0; i < argc; i++) { length = strlen(argv[i]); TclNewStringObj(objPtr, argv[i], length); @@ -2818,10 +2899,17 @@ } else { result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, cmdPtr->objClientData, argc, objv); } + /* + * Move the interpreter's object result to the string result, then reset + * the object result. + */ + + (void) Tcl_GetStringResult(interp); + /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ @@ -3225,11 +3313,11 @@ *---------------------------------------------------------------------- */ const char * Tcl_GetCommandName( - Tcl_Interp *interp, /* Interpreter containing the command. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Command command) /* Token for command returned by a previous * call to Tcl_CreateCommand. The command must * not have been deleted. */ { Command *cmdPtr = (Command *) command; @@ -3242,11 +3330,11 @@ */ return ""; } - return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); } /* *---------------------------------------------------------------------- * @@ -3276,11 +3364,11 @@ Tcl_Obj *objPtr) /* Points to the object onto which the * command's full name is appended. */ { Interp *iPtr = (Interp *) interp; - register Command *cmdPtr = (Command *) command; + Command *cmdPtr = (Command *) command; char *name; /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. @@ -3292,11 +3380,11 @@ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (cmdPtr->hPtr != NULL) { - name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } } @@ -3428,11 +3516,11 @@ tracePtr = cmdPtr->tracePtr; while (tracePtr != NULL) { CommandTrace *nextPtr = tracePtr->nextPtr; if (tracePtr->refCount-- <= 1) { - Tcl_Free(tracePtr); + ckfree(tracePtr); } tracePtr = nextPtr; } cmdPtr->tracePtr = NULL; } @@ -3467,14 +3555,14 @@ * the "real" command that this imported command refers to. * * If you are getting a crash during the call to deleteProc and * cmdPtr->deleteProc is a pointer to the function free(), the most * likely cause is that your extension allocated memory for the - * clientData argument to Tcl_CreateObjCommand with the Tcl_Alloc() + * clientData argument to Tcl_CreateObjCommand with the ckalloc() * macro and you are now trying to deallocate this memory with free() - * instead of Tcl_Free(). You should pass a pointer to your own method - * that calls Tcl_Free(). + * instead of ckfree(). You should pass a pointer to your own method + * that calls ckfree(). */ cmdPtr->deleteProc(cmdPtr->deleteData); } @@ -3560,11 +3648,11 @@ * is not being renamed */ int flags) /* Flags indicating the type of traces to * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { - register CommandTrace *tracePtr; + CommandTrace *tracePtr; ActiveCommandTrace active; char *result; Tcl_Obj *oldNamePtr = NULL; Tcl_InterpState state = NULL; @@ -3622,11 +3710,11 @@ } tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; if (tracePtr->refCount-- <= 1) { - Tcl_Free(tracePtr); + ckfree(tracePtr); } } if (state) { Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); @@ -3673,14 +3761,14 @@ */ static int CancelEvalProc( ClientData clientData, /* Interp to cancel the script in progress. */ - Tcl_Interp *interp, /* Ignored */ + TCL_UNUSED(Tcl_Interp *), int code) /* Current return code from command. */ { - CancelInfo *cancelInfo = clientData; + CancelInfo *cancelInfo = (CancelInfo *)clientData; Interp *iPtr; if (cancelInfo != NULL) { Tcl_MutexLock(&cancelLock); iPtr = (Interp *) cancelInfo->interp; @@ -3750,18 +3838,379 @@ *---------------------------------------------------------------------- */ void TclCleanupCommand( - register Command *cmdPtr) /* Points to the Command structure to + Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { - Tcl_Free(cmdPtr); + ckfree(cmdPtr); } } +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateMathFunc -- + * + * Creates a new math function for expressions in a given interpreter. + * + * Results: + * None. + * + * Side effects: + * The Tcl function defined by "name" is created or redefined. If the + * function already exists then its definition is replaced; this includes + * the builtin functions. Redefining a builtin function forces all + * existing code to be invalidated since that code may be compiled using + * an instruction specific to the replaced function. In addition, + * redefioning a non-builtin function will force existing code to be + * invalidated if the number of arguments has changed. + * + *---------------------------------------------------------------------- + */ + +#if !defined(TCL_NO_DEPRECATED) +void +Tcl_CreateMathFunc( + Tcl_Interp *interp, /* Interpreter in which function is to be + * available. */ + const char *name, /* Name of function (e.g. "sin"). */ + int numArgs, /* Nnumber of arguments required by + * function. */ + Tcl_ValueType *argTypes, /* Array of types acceptable for each + * argument. */ + Tcl_MathProc *proc, /* C function that implements the math + * function. */ + ClientData clientData) /* Additional value to pass to the + * function. */ +{ + Tcl_DString bigName; + OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData)); + + data->proc = proc; + data->numArgs = numArgs; + data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType)); + memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); + data->clientData = clientData; + + Tcl_DStringInit(&bigName); + TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); + Tcl_DStringAppend(&bigName, name, -1); + + Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), + OldMathFuncProc, data, OldMathFuncDeleteProc); + Tcl_DStringFree(&bigName); +} + +/* + *---------------------------------------------------------------------- + * + * OldMathFuncProc -- + * + * Dispatch to a math function created with Tcl_CreateMathFunc + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * Whatever the math function does. + * + *---------------------------------------------------------------------- + */ + +static int +OldMathFuncProc( + ClientData clientData, /* Pointer to OldMathFuncData describing the + * function being called */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Actual parameter count */ + Tcl_Obj *const *objv) /* Parameter vector */ +{ + Tcl_Obj *valuePtr; + OldMathFuncData *dataPtr = (OldMathFuncData *)clientData; + Tcl_Value funcResult, *args; + int result; + int j, k; + double d; + + /* + * Check argument count. + */ + + if (objc != dataPtr->numArgs + 1) { + MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv); + return TCL_ERROR; + } + + /* + * Convert arguments from Tcl_Obj's to Tcl_Value's. + */ + + args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value)); + for (j = 1, k = 0; j < objc; ++j, ++k) { + /* TODO: Convert to TclGetNumberFromObj? */ + valuePtr = objv[j]; + result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); +#ifdef ACCEPT_NAN + if (result != TCL_OK) { + const Tcl_ObjIntRep *irPtr + = TclFetchIntRep(valuePtr, &tclDoubleType); + + if (irPtr) { + d = irPtr->doubleValue; + result = TCL_OK; + } + } +#endif + if (result != TCL_OK) { + /* + * We have a non-numeric argument. + */ + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "argument to math function didn't have numeric value", + -1)); + TclCheckBadOctal(interp, TclGetString(valuePtr)); + ckfree(args); + return TCL_ERROR; + } + + /* + * Copy the object's numeric value to the argument record, converting + * it if necessary. + * + * NOTE: no bignum support; use the new mathfunc interface for that. + */ + + args[k].type = dataPtr->argTypes[k]; + switch (args[k].type) { + case TCL_EITHER: + if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue) + == TCL_OK) { + args[k].type = TCL_INT; + break; + } + if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue) + == TCL_OK) { + args[k].type = TCL_WIDE_INT; + break; + } + args[k].type = TCL_DOUBLE; + /* FALLTHROUGH */ + + case TCL_DOUBLE: + args[k].doubleValue = d; + break; + case TCL_INT: + if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { + ckfree(args); + return TCL_ERROR; + } + valuePtr = Tcl_GetObjResult(interp); + Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); + Tcl_ResetResult(interp); + break; + case TCL_WIDE_INT: + if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { + ckfree(args); + return TCL_ERROR; + } + valuePtr = Tcl_GetObjResult(interp); + TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); + Tcl_ResetResult(interp); + break; + } + } + + /* + * Call the function. + */ + + errno = 0; + result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult); + ckfree(args); + if (result != TCL_OK) { + return result; + } + + /* + * Return the result of the call. + */ + + if (funcResult.type == TCL_INT) { + TclNewIntObj(valuePtr, funcResult.intValue); + } else if (funcResult.type == TCL_WIDE_INT) { + valuePtr = Tcl_NewWideIntObj(funcResult.wideValue); + } else { + return CheckDoubleResult(interp, funcResult.doubleValue); + } + Tcl_SetObjResult(interp, valuePtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * OldMathFuncDeleteProc -- + * + * Cleans up after deleting a math function registered with + * Tcl_CreateMathFunc + * + * Results: + * None. + * + * Side effects: + * Frees allocated memory. + * + *---------------------------------------------------------------------- + */ + +static void +OldMathFuncDeleteProc( + ClientData clientData) +{ + OldMathFuncData *dataPtr = (OldMathFuncData *)clientData; + + ckfree(dataPtr->argTypes); + ckfree(dataPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetMathFuncInfo -- + * + * Discovers how a particular math function was created in a given + * interpreter. + * + * Results: + * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the + * interpreter result if that happens.) + * + * Side effects: + * If this function succeeds, the variables pointed to by the numArgsPtr + * and argTypePtr arguments will be updated to detail the arguments + * allowed by the function. The variable pointed to by the procPtr + * argument will be set to NULL if the function is a builtin function, + * and will be set to the address of the C function used to implement the + * math function otherwise (in which case the variable pointed to by the + * clientDataPtr argument will also be updated.) + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetMathFuncInfo( + Tcl_Interp *interp, + const char *name, + int *numArgsPtr, + Tcl_ValueType **argTypesPtr, + Tcl_MathProc **procPtr, + ClientData *clientDataPtr) +{ + Tcl_Obj *cmdNameObj; + Command *cmdPtr; + + /* + * Get the command that implements the math function. + */ + + TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::"); + Tcl_AppendToObj(cmdNameObj, name, -1); + Tcl_IncrRefCount(cmdNameObj); + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj); + Tcl_DecrRefCount(cmdNameObj); + + /* + * Report unknown functions. + */ + + if (cmdPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown math function \"%s\"", name)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); + *numArgsPtr = -1; + *argTypesPtr = NULL; + *procPtr = NULL; + *clientDataPtr = NULL; + return TCL_ERROR; + } + + /* + * Retrieve function info for user defined functions; return dummy + * information for builtins. + */ + + if (cmdPtr->objProc == &OldMathFuncProc) { + OldMathFuncData *dataPtr = (OldMathFuncData *)cmdPtr->clientData; + + *procPtr = dataPtr->proc; + *numArgsPtr = dataPtr->numArgs; + *argTypesPtr = dataPtr->argTypes; + *clientDataPtr = dataPtr->clientData; + } else { + *procPtr = NULL; + *numArgsPtr = -1; + *argTypesPtr = NULL; + *procPtr = NULL; + *clientDataPtr = NULL; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_ListMathFuncs -- + * + * Produces a list of all the math functions defined in a given + * interpreter. + * + * Results: + * A pointer to a Tcl_Obj structure with a reference count of zero, or + * NULL in the case of an error (in which case a suitable error message + * will be left in the interpreter result.) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_ListMathFuncs( + Tcl_Interp *interp, + const char *pattern) +{ + Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1); + Tcl_Obj *result; + Tcl_InterpState state; + + if (pattern) { + Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1); + Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj); + + Tcl_AppendObjToObj(script, arg); + Tcl_DecrRefCount(arg); /* Should tear down patternObj too */ + } + + state = Tcl_SaveInterpState(interp, TCL_OK); + Tcl_IncrRefCount(script); + if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { + result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); + } else { + result = Tcl_NewObj(); + } + Tcl_DecrRefCount(script); + Tcl_RestoreInterpState(interp, state); + + return result; +} +#endif /* !defined(TCL_NO_DEPRECATED) */ + /* *---------------------------------------------------------------------- * * TclInterpReady -- * @@ -3771,24 +4220,24 @@ * Results: * The return value is TCL_OK if it the interpreter is ready, TCL_ERROR * otherwise. * * Side effects: - * The interpreter's result is cleared. + * The interpreters object and string results are cleared. * *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; /* - * Reset the interpreter's result and clear out any previous error - * information. + * Reset both the interpreter's string and object results and clear out + * any previous error information. */ Tcl_ResetResult(interp); /* @@ -3852,11 +4301,11 @@ int TclResetCancellation( Tcl_Interp *interp, int force) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return TCL_ERROR; } @@ -3894,11 +4343,11 @@ int Tcl_Canceled( Tcl_Interp *interp, int flags) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; /* * Has the current script in progress for this interpreter been canceled * or is the stack being unwound due to the previous script cancellation? */ @@ -3933,11 +4382,11 @@ * interp's result; otherwise, we leave it alone. */ if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; - size_t length; + int length; /* * Setup errorCode variables so that we can differentiate between * being canceled and unwound. */ @@ -4029,11 +4478,11 @@ * No CancelInfo record for this interpreter. */ goto done; } - cancelInfo = Tcl_GetHashValue(hPtr); + cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); /* * Populate information needed by the interpreter thread to fulfill the * cancellation request. Currently, clientData is ignored. If the * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not @@ -4041,11 +4490,11 @@ * for the interp is completely unwound. */ if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = Tcl_Realloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { cancelInfo->result = NULL; cancelInfo->length = 0; @@ -4159,16 +4608,16 @@ static int EvalObjvCore( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { - Command *cmdPtr = NULL, *preCmdPtr = data[0]; + Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; int flags = PTR2INT(data[1]); int objc = PTR2INT(data[2]); - Tcl_Obj **objv = data[3]; + Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; /* @@ -4319,16 +4768,16 @@ static int Dispatch( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { - Tcl_ObjCmdProc *objProc = data[0]; + Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; ClientData clientData = data[1]; int objc = PTR2INT(data[2]); - Tcl_Obj **objv = data[3]; + Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; @@ -4368,10 +4817,34 @@ int result, struct NRE_callback *rootPtr) /* All callbacks down to rootPtr not inclusive * are to be run. */ { +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + Interp *iPtr = (Interp *) interp; +#endif /* !defined(TCL_NO_DEPRECATED) */ + + /* + * If the interpreter has a non-empty string result, the result object is + * either empty or stale because some function set interp->result + * directly. If so, move the string result to the result object, then + * reset the string result. + * + * This only needs to be done for the first item in the list: all other + * are for NR function calls, and those are Tcl_Obj based. + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + if (*(iPtr->result) != 0) { + (void) Tcl_GetObjResult(interp); + } +#endif /* !defined(TCL_NO_DEPRECATED) */ + + /* + * This is the trampoline. + */ + while (TOP_CB(interp) != rootPtr) { NRE_callback *callbackPtr = TOP_CB(interp); Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; @@ -4485,11 +4958,11 @@ TEOV_RestoreVarFrame( ClientData data[], Tcl_Interp *interp, int result) { - ((Interp *) interp)->varFramePtr = data[0]; + ((Interp *) interp)->varFramePtr = (CallFrame *)data[0]; return result; } static int TEOV_Exception( @@ -4527,13 +5000,13 @@ int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; - size_t cmdLen; + int cmdLen; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = data[1]; + Tcl_Obj **objv = (Tcl_Obj **)data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the @@ -4591,11 +5064,11 @@ */ Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; - newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); + newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's * full argument list. Note that we only use memcpy() once because we have * to increment the reference count of all the handler arguments anyway. @@ -4652,12 +5125,12 @@ Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = data[1]; - Namespace *savedNsPtr = data[2]; + Tcl_Obj **objv = (Tcl_Obj **)data[1]; + Namespace *savedNsPtr = (Namespace *)data[2]; int i; if (savedNsPtr) { iPtr->varFramePtr->nsPtr = savedNsPtr; @@ -4683,12 +5156,12 @@ int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; - int traceCode = TCL_OK; + unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + int length, traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); /* * Call trace functions. * Execute any command or execution traces. Note that we bump up the @@ -4733,14 +5206,14 @@ int result) { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); - Tcl_Obj *commandPtr = data[1]; - Command *cmdPtr = data[2]; - Tcl_Obj **objv = data[3]; - size_t length; + Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; + Command *cmdPtr = (Command *)data[2]; + Tcl_Obj **objv = (Tcl_Obj **)data[3]; + int length; const char *command = TclGetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) { traceCode = TclCheckExecutionTraces(interp, command, length, @@ -4819,16 +5292,66 @@ Tcl_Interp *interp, /* Interpreter in which to lookup variables, * execute nested commands, and report * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - size_t count) /* Number of tokens to consider at tokenPtr. + int count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +/* + *---------------------------------------------------------------------- + * + * Tcl_EvalTokens -- + * + * Given an array of tokens parsed from a Tcl command (e.g., the tokens + * that make up a word or the index for an array variable) this function + * evaluates the tokens and concatenates their values to form a single + * result value. + * + * Results: + * The return value is a pointer to a newly allocated Tcl_Obj containing + * the value of the array of tokens. The reference count of the returned + * object has been incremented. If an error occurs in evaluating the + * tokens then a NULL value is returned and an error message is left in + * interp's result. + * + * Side effects: + * A new object is allocated to hold the result. + * + *---------------------------------------------------------------------- + * + * This uses a non-standard return convention; its use is now deprecated. It + * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used + * in the core any longer. It is only kept for backward compatibility. + */ + +Tcl_Obj * +Tcl_EvalTokens( + Tcl_Interp *interp, /* Interpreter in which to lookup variables, + * execute nested commands, and report + * errors. */ + Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to + * evaluate and concatenate. */ + int count) /* Number of tokens to consider at tokenPtr. + * Must be at least 1. */ +{ + Tcl_Obj *resPtr; + + if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) { + return NULL; + } + resPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(resPtr); + Tcl_ResetResult(interp); + return resPtr; +} +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_EvalEx, TclEvalEx -- @@ -4852,11 +5375,11 @@ int Tcl_EvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ - size_t numBytes, /* Number of bytes in script. If -1, the + int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ @@ -4867,11 +5390,11 @@ int TclEvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ - size_t numBytes, /* Number of bytes in script. If -1, the + int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first NUL character. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ @@ -4898,27 +5421,26 @@ const char *p, *next; const unsigned int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; - int bytesLeft, expandRequested, code = TCL_OK; - size_t commandLength; + int commandLength, bytesLeft, expandRequested, code = TCL_OK; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; unsigned int i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); - CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); - Tcl_Obj **stackObjArray = + 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 *)); - int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int)); - int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int)); + int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); + int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); /* TIP #280 Structures for tracking of command * locations. */ int *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to @@ -4933,11 +5455,11 @@ } else { clNext = &iPtr->scriptCLLocPtr->loc[0]; } } - if (numBytes == TCL_AUTO_LENGTH) { + if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); savedVarFramePtr = iPtr->varFramePtr; @@ -5050,13 +5572,13 @@ /* * Generate an array of objects for the words of the command. */ if (numWords > minObjs) { - expand = Tcl_Alloc(numWords * sizeof(int)); - objvSpace = Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = Tcl_Alloc(numWords * sizeof(int)); + expand = (int *)ckalloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **)ckalloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (int *)ckalloc(numWords * sizeof(int)); } expandRequested = 0; objv = objvSpace; lines = lineSpace; @@ -5138,12 +5660,12 @@ int wordIdx = numWords; int objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { objv = objvSpace = - Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = Tcl_Alloc(objectsNeeded * sizeof(int)); + (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (int *)ckalloc(objectsNeeded * sizeof(int)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { @@ -5166,14 +5688,14 @@ } } objv += objIdx+1; if (copy != stackObjArray) { - Tcl_Free(copy); + ckfree(copy); } if (lcopy != linesStack) { - Tcl_Free(lcopy); + ckfree(lcopy); } } /* * Execute the command and free the objects for its words. @@ -5214,23 +5736,23 @@ for (i = 0; i < objectsUsed; i++) { Tcl_DecrRefCount(objv[i]); } objectsUsed = 0; if (objvSpace != stackObjArray) { - Tcl_Free(objvSpace); + ckfree(objvSpace); objvSpace = stackObjArray; - Tcl_Free(lineSpace); + ckfree(lineSpace); lineSpace = linesStack; } /* * Free expand separately since objvSpace could have been * reallocated above. */ if (expand != expandStack) { - Tcl_Free(expand); + ckfree(expand); expand = expandStack; } } /* @@ -5292,15 +5814,15 @@ } if (gotParse) { Tcl_FreeParse(parsePtr); } if (objvSpace != stackObjArray) { - Tcl_Free(objvSpace); - Tcl_Free(lineSpace); + ckfree(objvSpace); + ckfree(lineSpace); } if (expand != expandStack) { - Tcl_Free(expand); + ckfree(expand); } iPtr->varFramePtr = savedVarFramePtr; cleanup_return: /* @@ -5342,11 +5864,11 @@ TclAdvanceLines( int *line, const char *start, const char *end) { - register const char *p; + const char *p; for (p = start; p < end; p++) { if (*p == '\n') { (*line)++; } @@ -5437,11 +5959,11 @@ Tcl_Obj **objv, int objc, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; - int new, i; + int isNew, i; Tcl_HashEntry *hPtr; CFWord *cfwPtr; for (i = 1; i < objc; i++) { /* @@ -5453,18 +5975,18 @@ */ if (cfPtr->line[i] < 0) { continue; } - hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new); - if (new) { + hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew); + if (isNew) { /* * The word is not on the stack yet, remember the current location * and initialize references. */ - cfwPtr = Tcl_Alloc(sizeof(CFWord)); + cfwPtr = (CFWord *)ckalloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; Tcl_SetHashValue(hPtr, cfwPtr); } else { @@ -5471,11 +5993,11 @@ /* * The word is already on the stack, its current location is not * relevant. Just remember the reference to prevent early removal. */ - cfwPtr = Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); cfwPtr->refCount++; } } } @@ -5514,17 +6036,17 @@ Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]); if (!hPtr) { continue; } - cfwPtr = Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); if (cfwPtr->refCount-- > 1) { continue; } - Tcl_Free(cfwPtr); + ckfree(cfwPtr); Tcl_DeleteHashEntry(hPtr); } } /* @@ -5553,11 +6075,11 @@ Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, - size_t pc) + int pc) { ExtCmdLoc *eclPtr; int word; ECL *ePtr; CFWordBC *lastPtr = NULL; @@ -5566,11 +6088,11 @@ Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); if (!hePtr) { return; } - eclPtr = Tcl_GetHashValue(hePtr); + eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); ePtr = &eclPtr->loc[cmd]; /* * ePtr->nline is the number of words originally parsed. * @@ -5599,23 +6121,23 @@ * have to save them at compile time. */ for (word = 1; word < objc; word++) { if (ePtr->line[word] >= 0) { - int isnew; + int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isnew); - CFWordBC *cfwPtr = Tcl_Alloc(sizeof(CFWordBC)); + objv[word], &isNew); + CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; cfwPtr->pc = pc; cfwPtr->word = word; cfwPtr->nextPtr = lastPtr; lastPtr = cfwPtr; - if (isnew) { + if (isNew) { /* * The word is not on the stack yet, remember the current * location and initialize references. */ @@ -5626,11 +6148,11 @@ * a different location now (literal sharing may map * multiple location to a single Tcl_Obj*. Save the old * information in the new structure. */ - cfwPtr->prevPtr = Tcl_GetHashValue(hPtr); + cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, cfwPtr); } } /* for */ @@ -5668,11 +6190,11 @@ while (cfwPtr) { CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj); - CFWordBC *xPtr = Tcl_GetHashValue(hPtr); + CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); if (xPtr != cfwPtr) { Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); } @@ -5680,11 +6202,11 @@ Tcl_SetHashValue(hPtr, cfwPtr->prevPtr); } else { Tcl_DeleteHashEntry(hPtr); } - Tcl_Free(cfwPtr); + ckfree(cfwPtr); cfwPtr = nextPtr; } cfPtr->litarg = NULL; } @@ -5734,11 +6256,11 @@ * stack. That is nearest. */ hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj); if (hPtr) { - CFWord *cfwPtr = Tcl_GetHashValue(hPtr); + CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); *wordPtr = cfwPtr->word; *cfPtrPtr = cfwPtr->framePtr; return; } @@ -5748,11 +6270,11 @@ * that stack. */ hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj); if (hPtr) { - CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr); + CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; framePtr->data.tebc.pc = (char *) (((ByteCode *) framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc); *cfPtrPtr = cfwPtr->framePtr; @@ -5759,10 +6281,87 @@ *wordPtr = cfwPtr->word; return; } } +/* + *---------------------------------------------------------------------- + * + * Tcl_Eval -- + * + * Execute a Tcl command in a string. This function executes the script + * directly, rather than compiling it to bytecodes. Before the arrival of + * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used + * for executing Tcl commands, but nowadays it isn't used much. + * + * Results: + * The return value is one of the return codes defined in tcl.h (such as + * TCL_OK), and interp's result contains a value to supplement the return + * code. The value of the result will persist only until the next call to + * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it! + * + * Side effects: + * Can be almost arbitrary, depending on the commands in the script. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_Eval +int +Tcl_Eval( + Tcl_Interp *interp, /* Token for command interpreter (returned by + * previous call to Tcl_CreateInterp). */ + const char *script) /* Pointer to TCL command to execute. */ +{ + int code = Tcl_EvalEx(interp, script, -1, 0); + + /* + * For backwards compatibility with old C code that predates the object + * system in Tcl 8.0, we have to mirror the object result back into the + * string result (some callers may expect it there). + */ + + (void) Tcl_GetStringResult(interp); + return code; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_EvalObj, Tcl_GlobalEvalObj -- + * + * These functions are deprecated but we keep them around for backwards + * compatibility reasons. + * + * Results: + * See the functions they call. + * + * Side effects: + * See the functions they call. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_EvalObj +int +Tcl_EvalObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + return Tcl_EvalObjEx(interp, objPtr, 0); +} +#undef Tcl_GlobalEvalObj +int +Tcl_GlobalEvalObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_EvalObjEx, TclEvalObjEx -- * @@ -5791,11 +6390,11 @@ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - register 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 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { @@ -5804,11 +6403,11 @@ int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - register 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 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ @@ -5823,11 +6422,11 @@ int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - register 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 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ @@ -5887,11 +6486,11 @@ * * Note that we use (word==INTMIN) to signal that no command frame * should be pushed, as needed by alias and ensemble redirections. */ - eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); + eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; eoFramePtr->type = TCL_LOCATION_EVAL; eoFramePtr->level = (iPtr->cmdFramePtr == NULL? @@ -5952,11 +6551,11 @@ * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). */ const char *script; - size_t numSrcBytes; + int numSrcBytes; /* * Now we check if we have data about invisible continuation lines for * the script, and make it available to the direct script parser and * evaluator we are about to call, if so. @@ -5996,21 +6595,21 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - CallFrame *savedVarFramePtr = data[0]; - Tcl_Obj *objPtr = data[1]; + CallFrame *savedVarFramePtr = (CallFrame *)data[0]; + Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; int allowExceptions = PTR2INT(data[2]); if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; - size_t numSrcBytes; + int numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; script = TclGetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); @@ -6042,13 +6641,13 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = data[0]; - CmdFrame *eoFramePtr = data[1]; - Tcl_Obj *objPtr = data[2]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; + CmdFrame *eoFramePtr = (CmdFrame *)data[1]; + Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; /* * Remove the cmdFrame */ @@ -6131,11 +6730,11 @@ Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { - register Tcl_Obj *exprPtr; + Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ @@ -6144,10 +6743,13 @@ } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); + if (result != TCL_OK) { + (void) Tcl_GetStringResult(interp); + } } return result; } int @@ -6155,11 +6757,11 @@ Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { - register Tcl_Obj *exprPtr; + Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. @@ -6170,10 +6772,13 @@ exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ + if (result != TCL_OK) { + (void) Tcl_GetStringResult(interp); + } } return result; } int @@ -6195,10 +6800,18 @@ Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); + if (result != TCL_OK) { + /* + * Move the interpreter's object result to the string result, then + * reset the object result. + */ + + (void) Tcl_GetStringResult(interp); + } return result; } } /* @@ -6224,11 +6837,11 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; int result, type; double d; @@ -6251,12 +6864,12 @@ Tcl_DecrRefCount(resultPtr); if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewBignumObj(&big); - /* FALLTHROUGH */ } + /* FALLTHRU */ case TCL_NUMBER_INT: case TCL_NUMBER_BIG: result = TclGetLongFromObj(interp, resultPtr, ptr); break; @@ -6271,11 +6884,11 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; int result, type; ClientData internalPtr; @@ -6307,11 +6920,11 @@ int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; int result; @@ -6414,16 +7027,16 @@ return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv); } int TclNRInvoke( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ const char *cmdName; /* Name of the command from objv[0]. */ Tcl_HashEntry *hPtr = NULL; Command *cmdPtr; @@ -6437,11 +7050,11 @@ "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, NULL); return TCL_ERROR; } - cmdPtr = Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 */ @@ -6457,15 +7070,16 @@ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr); } static int NRPostInvoke( - ClientData clientData[], + TCL_UNUSED(ClientData *), Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *)interp; + iPtr->numLevels--; return result; } /* @@ -6511,10 +7125,16 @@ if (code == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); } } + + /* + * Force the string rep of the interp result. + */ + + (void) Tcl_GetStringResult(interp); return code; } /* *---------------------------------------------------------------------- @@ -6533,30 +7153,108 @@ * message in the interpreter's result. * *---------------------------------------------------------------------- */ +#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - size_t length; - const char *message = TclGetStringFromObj(objPtr, &length); - register Interp *iPtr = (Interp *) interp; + const char *message = TclGetString(objPtr); Tcl_IncrRefCount(objPtr); + Tcl_AddObjErrorInfo(interp, message, objPtr->length); + Tcl_DecrRefCount(objPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AddErrorInfo -- + * + * Add information to the errorInfo field that describes the current + * error. + * + * Results: + * None. + * + * Side effects: + * The contents of message are appended to the errorInfo field. If we are + * just starting to log an error, errorInfo is initialized from the error + * message in the interpreter's result. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_AddErrorInfo +void +Tcl_AddErrorInfo( + Tcl_Interp *interp, /* Interpreter to which error information + * pertains. */ + const char *message) /* Message to record. */ +{ + Tcl_AddObjErrorInfo(interp, message, -1); +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_AddObjErrorInfo -- + * + * Add information to the errorInfo field that describes the current + * error. This routine differs from Tcl_AddErrorInfo by taking a byte + * pointer and length. + * + * Results: + * None. + * + * Side effects: + * "length" bytes from "message" are appended to the errorInfo field. If + * "length" is negative, use bytes up to the first NULL byte. If we are + * just starting to log an error, errorInfo is initialized from the error + * message in the interpreter's result. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AddObjErrorInfo( + Tcl_Interp *interp, /* Interpreter to which error information + * pertains. */ + const char *message, /* Points to the first byte of an array of + * bytes of the message. */ + int length) /* The number of bytes in the message. If < 0, + * then append all bytes up to a NULL byte. */ +{ + Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. */ iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { - iPtr->errorInfo = iPtr->objResultPtr; +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + if (*(iPtr->result) != 0) { + /* + * The interp's string result is set, apparently by some extension + * making a deprecated direct write to it. That extension may + * expect interp->result to continue to be set, so we'll take + * special pains to avoid clearing it, until we drop support for + * interp->result completely. + */ + + iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); + } else +#endif /* !defined(TCL_NO_DEPRECATED) */ + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); } } @@ -6571,46 +7269,43 @@ iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo); Tcl_IncrRefCount(iPtr->errorInfo); } Tcl_AppendToObj(iPtr->errorInfo, message, length); } - Tcl_DecrRefCount(objPtr); } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * - * Tcl_VarEval -- + * Tcl_VarEvalVA -- * * Given a variable number of string arguments, concatenate them all * together and execute the result as a Tcl command. * * Results: * A standard Tcl return result. An error message or other result may be - * left in the interp. + * left in the interp's result. * * Side effects: * Depends on what was done by the command. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ - /* ARGSUSED */ + int -Tcl_VarEval( - Tcl_Interp *interp, - ...) +Tcl_VarEvalVA( + Tcl_Interp *interp, /* Interpreter in which to evaluate command */ + va_list argList) /* Variable argument list. */ { - va_list argList; - int result; Tcl_DString buf; char *string; + int result; - va_start(argList, interp); /* * Copy the strings one after the other into a single larger string. Use * stack-allocated space for small commands, but if the command gets too - * large than call Tcl_Alloc to create the space. + * large than call ckalloc to create the space. */ Tcl_DStringInit(&buf); while (1) { string = va_arg(argList, char *); @@ -6623,10 +7318,81 @@ result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); Tcl_DStringFree(&buf); return result; } +/* + *---------------------------------------------------------------------- + * + * Tcl_VarEval -- + * + * Given a variable number of string arguments, concatenate them all + * together and execute the result as a Tcl command. + * + * Results: + * A standard Tcl return result. An error message or other result may be + * left in interp->result. + * + * Side effects: + * Depends on what was done by the command. + * + *---------------------------------------------------------------------- + */ +int +Tcl_VarEval( + Tcl_Interp *interp, + ...) +{ + va_list argList; + int result; + + va_start(argList, interp); + result = Tcl_VarEvalVA(interp, argList); + va_end(argList); + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GlobalEval -- + * + * Evaluate a command at global level in an interpreter. + * + * Results: + * A standard Tcl result is returned, and the interp's result is modified + * accordingly. + * + * Side effects: + * The command string is executed in interp, and the execution is carried + * out in the variable context of global level (no functions active), + * just as if an "uplevel #0" command were being executed. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_GlobalEval +int +Tcl_GlobalEval( + Tcl_Interp *interp, /* Interpreter in which to evaluate + * command. */ + const char *command) /* Command to evaluate. */ +{ + Interp *iPtr = (Interp *) interp; + int result; + CallFrame *savedVarFramePtr; + + savedVarFramePtr = iPtr->varFramePtr; + iPtr->varFramePtr = iPtr->rootFramePtr; + result = Tcl_EvalEx(interp, command, -1, 0); + iPtr->varFramePtr = savedVarFramePtr; + return result; +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_SetRecursionLimit -- * @@ -6743,11 +7509,11 @@ *---------------------------------------------------------------------- */ static int ExprCeilFunc( - ClientData clientData, /* Ignored */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { @@ -6783,11 +7549,11 @@ return TCL_OK; } static int ExprFloorFunc( - ClientData clientData, /* Ignored */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { @@ -6823,11 +7589,11 @@ return TCL_OK; } static int ExprIsqrtFunc( - ClientData clientData, /* Ignored */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { ClientData ptr; @@ -6877,11 +7643,11 @@ break; case TCL_NUMBER_BIG: if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) { return TCL_ERROR; } - if (big.sign != MP_ZPOS) { + if (mp_isneg(&big)) { mp_clear(&big); goto negarg; } break; default: @@ -6905,14 +7671,20 @@ if (exact) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d))); } else { mp_int root; + mp_err err; - mp_init(&root); - mp_sqrt(&big, &root); + err = mp_init(&root); + if (err == MP_OKAY) { + err = mp_sqrt(&big, &root); + } mp_clear(&big); + if (err != MP_OKAY) { + return TCL_ERROR; + } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: @@ -6923,11 +7695,11 @@ return TCL_ERROR; } static int ExprSqrtFunc( - ClientData clientData, /* Ignored */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter list. */ { @@ -6954,14 +7726,21 @@ return TCL_ERROR; } if ((d >= 0.0) && TclIsInfinite(d) && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) { mp_int root; + mp_err err; - mp_init(&root); - mp_sqrt(&big, &root); + err = mp_init(&root); + if (err == MP_OKAY) { + err = mp_sqrt(&big, &root); + } mp_clear(&big); + if (err != MP_OKAY) { + mp_clear(&root); + return TCL_ERROR; + } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root))); mp_clear(&root); } else { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d))); } @@ -7084,11 +7863,11 @@ return CheckDoubleResult(interp, func(d1, d2)); } static int ExprAbsFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { @@ -7110,11 +7889,11 @@ if (l > 0) { goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { - size_t numBytes; + int numBytes; const char *bytes = TclGetStringFromObj(objv[1], &numBytes); while (numBytes) { if (*bytes == '-') { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); @@ -7123,11 +7902,13 @@ bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { - TclInitBignumFromWideInt(&big, l); + if (mp_init_i64(&big, l) != MP_OKAY) { + return TCL_ERROR; + } goto tooLarge; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l)); return TCL_OK; } @@ -7151,14 +7932,16 @@ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); return TCL_OK; } if (type == TCL_NUMBER_BIG) { - if (((const mp_int *) ptr)->sign != MP_ZPOS) { + if (mp_isneg((const mp_int *) ptr)) { Tcl_GetBignumFromObj(NULL, objv[1], &big); tooLarge: - mp_neg(&big, &big); + if (mp_neg(&big, &big) != MP_OKAY) { + return TCL_ERROR; + } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); } else { unChanged: Tcl_SetObjResult(interp, objv[1]); } @@ -7179,11 +7962,11 @@ return TCL_OK; } static int ExprBoolFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { @@ -7200,11 +7983,11 @@ return TCL_OK; } static int ExprDoubleFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { @@ -7227,11 +8010,11 @@ return TCL_OK; } static int ExprIntFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { @@ -7283,11 +8066,11 @@ return TCL_ERROR; } static int ExprWideFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { @@ -7304,11 +8087,11 @@ /* * Common implmentation of max() and min(). */ static int ExprMaxMinFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv, /* Actual parameter vector. */ int op) /* Comparison direction */ @@ -7344,33 +8127,33 @@ return TCL_OK; } static int ExprMaxFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { - return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT); + return ExprMaxMinFunc(NULL, interp, objc, objv, MP_GT); } static int ExprMinFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { - return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT); + return ExprMaxMinFunc(NULL, interp, objc, objv, MP_LT); } static int ExprRandFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { @@ -7397,12 +8180,12 @@ /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. */ - iPtr->randSeed &= 0x7fffffff; - if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { + iPtr->randSeed &= 0x7FFFFFFF; + if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) { iPtr->randSeed ^= 123459876; } } /* @@ -7459,11 +8242,11 @@ return TCL_OK; } static int ExprRoundFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { @@ -7490,19 +8273,23 @@ } else if (fractPart >= 0.5) { max--; } if ((intPart >= (double)max) || (intPart <= (double)min)) { mp_int big; + mp_err err = MP_OKAY; if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } if (fractPart <= -0.5) { - mp_sub_d(&big, 1, &big); + err = mp_sub_d(&big, 1, &big); } else if (fractPart >= 0.5) { - mp_add_d(&big, 1, &big); + err = mp_add_d(&big, 1, &big); + } + if (err != MP_OKAY) { + return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { Tcl_WideInt result = (Tcl_WideInt)intPart; @@ -7534,18 +8321,18 @@ return TCL_ERROR; } static int ExprSrandFunc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { Interp *iPtr = (Interp *) interp; - Tcl_WideInt w = 0; /* Initialized to avoid compiler warning. */ + Tcl_WideInt w = 0; /* Initialized to avoid compiler warning. */ /* * Convert argument and use it to reset the seed. */ @@ -7562,22 +8349,22 @@ * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in * ExprRandFunc for more details. */ iPtr->flags |= RAND_SEED_INITIALIZED; - iPtr->randSeed = (long) w & 0x7fffffff; - if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { + iPtr->randSeed = (long) w & 0x7FFFFFFF; + if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) { iPtr->randSeed ^= 123459876; } /* * To avoid duplicating the random number generation code we simply clean * up our state and call the real random number function. That function * will always succeed. */ - return ExprRandFunc(clientData, interp, 1, objv); + return ExprRandFunc(NULL, interp, 1, objv); } /* *---------------------------------------------------------------------- * @@ -7613,26 +8400,27 @@ ClassifyDouble( double d) { #if TCL_FPCLASSIFY_MODE == 0 return fpclassify(d); -#else /* !fpclassify */ +#else /* TCL_FPCLASSIFY_MODE != 0 */ /* * If we don't have fpclassify(), we also don't have the values it returns. * Hence we define those here. */ -# ifndef FP_NAN +#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 */ -#endif +#endif /* !FP_NAN */ -# if TCL_FPCLASSIFY_MODE == 3 - return __builtin_fpclassify(FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); -# elif TCL_FPCLASSIFY_MODE == 2 +#if TCL_FPCLASSIFY_MODE == 3 + return __builtin_fpclassify( + 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. * Specifically, x86 running Windows. It's fairly easy to enable for * others if they need it (because their libc/libm is broken) but we'll * jump that hurdle when requred. We can solve the word ordering then. @@ -7655,13 +8443,13 @@ /* * 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 * totally ignore the sign bit. */ @@ -7694,11 +8482,11 @@ * Everything else is a NORMAL double precision float. */ return FP_NORMAL; } -# elif TCL_FPCLASSIFY_MODE == 1 +#elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: return FP_ZERO; case _FPCLASS_NN: @@ -7714,19 +8502,19 @@ Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: return FP_NAN; } -# else /* unknown TCL_FPCLASSIFY_MODE */ -# error "unknown or unexpected TCL_FPCLASSIFY_MODE" -# endif /* TCL_FPCLASSIFY_MODE */ +#else /* TCL_FPCLASSIFY_MODE not in (0..3) */ +#error "unknown or unexpected TCL_FPCLASSIFY_MODE" +#endif /* TCL_FPCLASSIFY_MODE */ #endif /* !fpclassify */ } static int ExprIsFiniteFunc( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -7753,11 +8541,11 @@ return TCL_OK; } static int ExprIsInfinityFunc( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -7783,11 +8571,11 @@ return TCL_OK; } static int ExprIsNaNFunc( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -7813,11 +8601,11 @@ return TCL_OK; } static int ExprIsNormalFunc( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -7843,11 +8631,11 @@ return TCL_OK; } static int ExprIsSubnormalFunc( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -7873,11 +8661,11 @@ return TCL_OK; } static int ExprIsUnorderedFunc( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -7914,11 +8702,11 @@ return TCL_OK; } static int FloatClassifyObjCmd( - ClientData ignored, + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count */ Tcl_Obj *const *objv) /* Actual parameter list */ { @@ -8023,12 +8811,12 @@ *---------------------------------------------------------------------- */ static int DTraceObjCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (TCL_DTRACE_TCL_PROBE_ENABLED()) { char *a[10]; @@ -8407,11 +9195,11 @@ *---------------------------------------------------------------------- */ int TclNRTailcallObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; @@ -8477,11 +9265,11 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = data[0], *nsObjPtr; + Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; int objc; Tcl_Obj **objv; Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); @@ -8512,14 +9300,15 @@ } int TclNRReleaseValues( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { int i = 0; + while (i < 4) { if (data[i]) { Tcl_DecrRefCount((Tcl_Obj *) data[i]); } else { break; @@ -8599,11 +9388,11 @@ return TCL_OK; } int TclNRYieldToObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; @@ -8653,13 +9442,13 @@ static int RewindCoroutineCallback( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { - return Tcl_RestoreInterpState(interp, data[0]); + return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]); } static int RewindCoroutine( CoroutineData *corPtr, @@ -8680,11 +9469,11 @@ static void DeleteCoroutine( ClientData clientData) { - CoroutineData *corPtr = clientData; + CoroutineData *corPtr = (CoroutineData *)clientData; Tcl_Interp *interp = corPtr->eePtr->interp; NRE_callback *rootPtr = TOP_CB(interp); if (COR_IS_SUSPENDED(corPtr)) { TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr); @@ -8695,11 +9484,11 @@ NRCoroutineCallerCallback( ClientData data[], Tcl_Interp *interp, int result) { - CoroutineData *corPtr = data[0]; + CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* * This is the last callback in the caller execEnv, right before switching * to the coroutine's @@ -8714,11 +9503,11 @@ */ NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr); NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr); NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr); - Tcl_Free(corPtr); + ckfree(corPtr); return result; } NRE_ASSERT(COR_IS_SUSPENDED(corPtr)); SAVE_CONTEXT(corPtr->running); @@ -8741,11 +9530,11 @@ NRCoroutineExitCallback( ClientData data[], Tcl_Interp *interp, int result) { - CoroutineData *corPtr = data[0]; + CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* * This runs at the bottom of the Coroutine's execEnv: it will be executed * when the coroutine returns or is wound down, but not when it yields. It @@ -8773,11 +9562,11 @@ * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal * command arguments in bytecode. */ Tcl_DeleteHashTable(corPtr->lineLABCPtr); - Tcl_Free(corPtr->lineLABCPtr); + ckfree(corPtr->lineLABCPtr); corPtr->lineLABCPtr = NULL; RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; iPtr->numLevels++; @@ -8804,13 +9593,13 @@ int TclNRCoroutineActivateCallback( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = data[0]; + CoroutineData *corPtr = (CoroutineData *)data[0]; int type = PTR2INT(data[1]); int numLevels, unused; int *stackLevel = &unused; if (!corPtr->stackLevel) { @@ -8883,15 +9672,15 @@ static int TclNREvalList( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { int objc; Tcl_Obj **objv; - Tcl_Obj *listPtr = data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); @@ -8909,11 +9698,11 @@ *---------------------------------------------------------------------- */ static int CoroTypeObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Command *cmdPtr; @@ -8940,11 +9729,11 @@ /* * An active coroutine is "active". Can't tell what it might do in the * future. */ - corPtr = cmdPtr->objClientData; + corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); return TCL_OK; } @@ -8994,16 +9783,16 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objPtr), NULL); return NULL; } - return cmdPtr->objClientData; + return (CoroutineData *)cmdPtr->objClientData; } static int TclNRCoroInjectObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; @@ -9044,11 +9833,11 @@ return TCL_OK; } static int TclNRCoroProbeObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; @@ -9143,14 +9932,14 @@ static int InjectHandler( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = data[0]; - Tcl_Obj *listPtr = data[1]; + CoroutineData *corPtr = (CoroutineData *)data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; int nargs = PTR2INT(data[2]); ClientData isProbe = data[3]; int objc; Tcl_Obj **objv; @@ -9191,12 +9980,12 @@ InjectHandlerPostCall( ClientData data[], Tcl_Interp *interp, int result) { - CoroutineData *corPtr = data[0]; - Tcl_Obj *listPtr = data[1]; + CoroutineData *corPtr = (CoroutineData *)data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; int nargs = PTR2INT(data[2]); ClientData isProbe = data[3]; int numLevels; /* @@ -9237,11 +10026,11 @@ *---------------------------------------------------------------------- */ static int NRInjectObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; @@ -9287,11 +10076,11 @@ ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - CoroutineData *corPtr = clientData; + CoroutineData *corPtr = (CoroutineData *)clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "coroutine \"%s\" is already running", TclGetString(objv[0]))); @@ -9346,11 +10135,11 @@ *---------------------------------------------------------------------- */ int TclNRCoroutineObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr; @@ -9387,11 +10176,11 @@ /* * We ARE creating the coroutine command: allocate the corresponding * struct and create the corresponding command. */ - corPtr = Tcl_Alloc(sizeof(CoroutineData)); + corPtr = (CoroutineData *)ckalloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); @@ -9409,11 +10198,11 @@ { Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; - corPtr->lineLABCPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + corPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) { int isNew; @@ -9479,11 +10268,11 @@ * This is used in the [info] ensemble */ int TclInfoCoroutineCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; Index: generic/tclBinary.c ================================================================== --- generic/tclBinary.c +++ generic/tclBinary.c @@ -10,22 +10,22 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" #include #include /* * The following constants are used by GetFormatSpec to indicate various * special conditions in the parsing of a format specifier. */ -#define BINARY_ALL ((size_t)-1) /* Use all elements in the argument. */ -#define BINARY_NOCOUNT ((size_t)-2) /* No count was specified in format. */ +#define BINARY_ALL -1 /* Use all elements in the argument. */ +#define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* * The following flags may be ORed together and returned by GetFormatSpec */ @@ -62,20 +62,20 @@ static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); static void FreeByteArrayInternalRep(Tcl_Obj *objPtr); static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(const char **formatPtr, char *cmdPtr, - size_t *countPtr, int *flagsPtr); + int *countPtr, int *flagsPtr); static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, int flags, Tcl_HashTable **numberCachePtr); static int SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, - size_t length, int type); + unsigned length, int type); /* Binary ensemble commands */ static int BinaryFormatCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int BinaryScanCmd(ClientData clientData, @@ -264,14 +264,17 @@ * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ -typedef struct { - size_t used; /* The number of bytes used in the byte +typedef struct ByteArray { + unsigned int bad; /* Index of the character that is a nonbyte. + * If all characters are bytes, bad = used, + * though then we should never read it. */ + unsigned int used; /* The number of bytes used in the byte * array. */ - size_t allocated; /* The amount of space actually allocated + unsigned int allocated; /* The amount of space actually allocated * minus 1 byte. */ unsigned char bytes[1]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; @@ -278,12 +281,12 @@ #define BYTEARRAY_SIZE(len) \ (offsetof(ByteArray, bytes) + (len)) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ - (irPtr)->twoPtrValue.ptr1 = (baPtr) - + (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) + int TclIsPureByteArray( Tcl_Obj * objPtr) { return TclHasIntRep(objPtr, &properByteArrayType); @@ -311,11 +314,12 @@ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - size_t length) /* Length of the array of bytes */ + int length) /* Length of the array of bytes, which must be + * >= 0. */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); #else /* if not TCL_MEM_DEBUG */ Tcl_Obj *objPtr; @@ -349,30 +353,41 @@ * Memory allocated for new object and copy of byte array argument. * *---------------------------------------------------------------------- */ +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - size_t length, /* Length of the array of bytes. */ + int length, /* Length of the array of bytes, which must be + * >= 0. */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { -#ifdef TCL_MEM_DEBUG Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetByteArrayObj(objPtr, bytes, length); return objPtr; +} #else /* if not TCL_MEM_DEBUG */ +Tcl_Obj * +Tcl_DbNewByteArrayObj( + const unsigned char *bytes, /* The array of bytes used to initialize the + * new object. */ + int length, /* Length of the array of bytes, which must be + * >= 0. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ return Tcl_NewByteArrayObj(bytes, length); -#endif /* TCL_MEM_DEBUG */ } +#endif /* TCL_MEM_DEBUG */ /* *--------------------------------------------------------------------------- * * Tcl_SetByteArrayObj -- @@ -393,11 +408,11 @@ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if length > 0. */ - size_t length) /* Length of the array of bytes, which must + int length) /* Length of the array of bytes, which must * be >= 0. */ { ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; @@ -404,11 +419,15 @@ if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } TclInvalidateStringRep(objPtr); - byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); + if (length < 0) { + length = 0; + } + byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + byteArrayPtr->bad = length; byteArrayPtr->used = length; byteArrayPtr->allocated = length; if ((bytes != NULL) && (length > 0)) { memcpy(byteArrayPtr->bytes, bytes, length); @@ -415,10 +434,66 @@ } SET_BYTEARRAY(&ir, byteArrayPtr); Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir); } + +/* + *---------------------------------------------------------------------- + * + * TclGetBytesFromObj -- + * + * Attempt to extract the value from objPtr in the representation + * of a byte sequence. On success return the extracted byte sequence. + * On failures, return NULL and record error message and code in + * interp (if not NULL). + * + * Results: + * Pointer to array of bytes, or NULL. representing the ByteArray object. + * Writes number of bytes in array to *lengthPtr. + * + *---------------------------------------------------------------------- + */ + +unsigned char * +TclGetBytesFromObj( + Tcl_Interp *interp, /* For error reporting */ + Tcl_Obj *objPtr, /* Value to extract from */ + int *lengthPtr) /* If non-NULL, filled with length of the + * array of bytes in the ByteArray object. */ +{ + ByteArray *baPtr; + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); + + if (irPtr == NULL) { + SetByteArrayFromAny(NULL, objPtr); + irPtr = TclFetchIntRep(objPtr, &properByteArrayType); + if (irPtr == NULL) { + if (interp) { + const char *nonbyte; + int ucs4; + + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); + baPtr = GET_BYTEARRAY(irPtr); + nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad); + TclUtfToUCS4(nonbyte, &ucs4); + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected byte sequence but character %d " + "was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL); + } + return NULL; + } + } + baPtr = GET_BYTEARRAY(irPtr); + + if (lengthPtr != NULL) { + *lengthPtr = baPtr->used; + } + return baPtr->bytes; +} /* *---------------------------------------------------------------------- * * Tcl_GetByteArrayFromObj -- @@ -441,22 +516,20 @@ Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; - const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); - - if (irPtr == NULL) { - irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); - if (irPtr == NULL) { - SetByteArrayFromAny(NULL, objPtr); - irPtr = TclFetchIntRep(objPtr, &properByteArrayType); - if (irPtr == NULL) { - irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); - } - } - } + const Tcl_ObjIntRep *irPtr; + unsigned char *result = TclGetBytesFromObj(NULL, objPtr, lengthPtr); + + if (result) { + return result; + } + + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); + assert(irPtr != NULL); + baPtr = GET_BYTEARRAY(irPtr); if (lengthPtr != NULL) { *lengthPtr = baPtr->used; } @@ -486,15 +559,19 @@ */ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ - size_t length) /* New length for internal byte array. */ + int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; + unsigned newLength; Tcl_ObjIntRep *irPtr; + assert(length >= 0); + newLength = (unsigned int)length; + if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } irPtr = TclFetchIntRep(objPtr, &properByteArrayType); @@ -508,17 +585,19 @@ } } } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (length > byteArrayPtr->allocated) { - byteArrayPtr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length)); - byteArrayPtr->allocated = length; + if (newLength > byteArrayPtr->allocated) { + byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength)); + byteArrayPtr->allocated = newLength; SET_BYTEARRAY(irPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); - byteArrayPtr->used = length; + objPtr->typePtr = &properByteArrayType; + byteArrayPtr->bad = newLength; + byteArrayPtr->used = newLength; return byteArrayPtr->bytes; } /* *---------------------------------------------------------------------- @@ -536,15 +615,14 @@ *---------------------------------------------------------------------- */ static int SetByteArrayFromAny( - Tcl_Interp *interp, /* Not used. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { - size_t length; - int improper = 0; + size_t length, bad; const char *src, *srcEnd; unsigned char *dst; Tcl_UniChar ch = 0; ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; @@ -554,26 +632,35 @@ } if (TclHasIntRep(objPtr, &tclByteArrayType)) { return TCL_OK; } - src = TclGetStringFromObj(objPtr, &length); + src = TclGetString(objPtr); + length = bad = objPtr->length; srcEnd = src + length; - byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); + byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += TclUtfToUniChar(src, &ch); - improper = improper || (ch > 255); + if ((bad == length) && (ch > 255)) { + bad = dst - byteArrayPtr->bytes; + } *dst++ = UCHAR(ch); } - byteArrayPtr->used = dst - byteArrayPtr->bytes; + SET_BYTEARRAY(&ir, byteArrayPtr); byteArrayPtr->allocated = length; + byteArrayPtr->used = dst - byteArrayPtr->bytes; - SET_BYTEARRAY(&ir, byteArrayPtr); - Tcl_StoreIntRep(objPtr, - improper ? &tclByteArrayType : &properByteArrayType, &ir); + if (bad == length) { + byteArrayPtr->bad = byteArrayPtr->used; + Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir); + } else { + byteArrayPtr->bad = bad; + Tcl_StoreIntRep(objPtr, &tclByteArrayType, &ir); + } + return TCL_OK; } /* *---------------------------------------------------------------------- @@ -594,18 +681,18 @@ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); + ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); } static void FreeProperByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); + ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); } /* *---------------------------------------------------------------------- * @@ -626,18 +713,19 @@ static void DupByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - size_t length; + unsigned int length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); + copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + copyArrayPtr->bad = srcArrayPtr->bad; copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); SET_BYTEARRAY(&ir, copyArrayPtr); @@ -654,11 +742,12 @@ Tcl_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); + copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + copyArrayPtr->bad = length; copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); SET_BYTEARRAY(&ir, copyArrayPtr); @@ -688,22 +777,25 @@ * update. */ { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; - size_t i, length = byteArrayPtr->used; - size_t size = length; + unsigned int i, length = byteArrayPtr->used; + unsigned int size = length; /* * How much space will string rep need? */ - for (i = 0; i < length; i++) { + for (i = 0; i < length && size <= INT_MAX; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } + if (size > INT_MAX) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } if (size == length) { char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); TclOOM(dst, size); @@ -739,20 +831,20 @@ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, - size_t len) + int len) { ByteArray *byteArrayPtr; - size_t needed; + unsigned int length, needed; Tcl_ObjIntRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } - if (len == TCL_AUTO_LENGTH) { + if (len < 0) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* @@ -759,10 +851,12 @@ * Append zero bytes is a no-op. */ return; } + + length = (unsigned int) len; irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { @@ -773,61 +867,62 @@ } } } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (len > UINT_MAX - byteArrayPtr->used) { - Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX); + if (length > INT_MAX - byteArrayPtr->used) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } - needed = byteArrayPtr->used + len; + needed = byteArrayPtr->used + length; /* * If we need to, resize the allocated space in the byte array. */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; - size_t attempt; + unsigned int attempt; if (needed <= INT_MAX/2) { /* * Try to allocate double the total space that is needed. */ attempt = 2 * needed; - ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Try to allocate double the increment that is needed (plus). */ - size_t limit = UINT_MAX - needed; - size_t extra = len + TCL_MIN_GROWTH; - size_t growth = (extra > limit) ? limit : extra; + unsigned int limit = INT_MAX - needed; + unsigned int extra = length + TCL_MIN_GROWTH; + int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; - ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Last chance: Try to allocate exactly what is needed. */ attempt = needed; - ptr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; SET_BYTEARRAY(irPtr, byteArrayPtr); } if (bytes) { - memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len); + memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length); } - byteArrayPtr->used += len; + byteArrayPtr->used += length; TclInvalidateStringRep(objPtr); + objPtr->typePtr = &properByteArrayType; } /* *---------------------------------------------------------------------- * @@ -873,20 +968,20 @@ *---------------------------------------------------------------------- */ static int BinaryFormatCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - size_t count; /* Count associated with current format + int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ @@ -894,12 +989,11 @@ unsigned char *cursor; /* Current position within result buffer. */ unsigned char *maxPos; /* Greatest position within result buffer that * cursor has visited.*/ const char *errorString; const char *errorValue, *str; - int offset, size; - size_t length; + int offset, size, length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); return TCL_ERROR; } @@ -934,11 +1028,11 @@ if (arg >= objc) { goto badIndex; } if (count == BINARY_ALL) { - (void)TclGetByteArrayFromObj(objv[arg], &count); + Tcl_GetByteArrayFromObj(objv[arg], &count); } else if (count == BINARY_NOCOUNT) { count = 1; } arg++; if (cmd == 'a' || cmd == 'A') { @@ -1006,11 +1100,11 @@ } arg++; if (count == BINARY_ALL) { count = listc; - } else if (count > (size_t)listc) { + } else if (count > listc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number of elements in list does not match count", -1)); return TCL_ERROR; } @@ -1030,20 +1124,20 @@ break; case 'X': if (count == BINARY_NOCOUNT) { count = 1; } - if ((count > (size_t)offset) || (count == BINARY_ALL)) { + if ((count > offset) || (count == BINARY_ALL)) { count = offset; } - if (offset > (int)length) { + if (offset > length) { length = offset; } offset -= count; break; case '@': - if (offset > (int)length) { + if (offset > length) { length = offset; } if (count == BINARY_ALL) { offset = length; } else if (count == BINARY_NOCOUNT) { @@ -1055,11 +1149,11 @@ default: errorString = str; goto badField; } } - if (offset > (int)length) { + if (offset > length) { length = offset; } if (length == 0) { return TCL_OK; } @@ -1098,12 +1192,12 @@ case 'a': case 'A': { char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; - bytes = TclGetByteArrayFromObj(objv[arg], &length); - arg++; + bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); + if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { count = 1; } @@ -1132,11 +1226,11 @@ count = length; } value = 0; errorString = "binary"; if (cmd == 'B') { - for (offset = 0; (size_t)offset < count; offset++) { + for (offset = 0; offset < count; offset++) { value <<= 1; if (str[offset] == '1') { value |= 1; } else if (str[offset] != '0') { errorValue = str; @@ -1147,11 +1241,11 @@ *cursor++ = UCHAR(value); value = 0; } } } else { - for (offset = 0; (size_t)offset < count; offset++) { + for (offset = 0; offset < count; offset++) { value >>= 1; if (str[offset] == '1') { value |= 128; } else if (str[offset] != '0') { errorValue = str; @@ -1194,11 +1288,11 @@ count = length; } value = 0; errorString = "hexadecimal"; if (cmd == 'H') { - for (offset = 0; (size_t)offset < count; offset++) { + for (offset = 0; offset < count; offset++) { value <<= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; Tcl_DecrRefCount(resultPtr); goto badValue; @@ -1208,18 +1302,18 @@ c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } - value |= (c & 0xf); + value |= (c & 0xF); if (offset % 2) { *cursor++ = (char) value; value = 0; } } } else { - for (offset = 0; (size_t)offset < count; offset++) { + for (offset = 0; offset < count; offset++) { value >>= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; Tcl_DecrRefCount(resultPtr); @@ -1230,13 +1324,13 @@ c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } - value |= ((c << 4) & 0xf0); + value |= ((c << 4) & 0xF0); if (offset % 2) { - *cursor++ = UCHAR(value & 0xff); + *cursor++ = UCHAR(value & 0xFF); value = 0; } } } if (offset % 2) { @@ -1286,11 +1380,11 @@ if (count == BINARY_ALL) { count = listc; } } arg++; - for (i = 0; (size_t)i < count; i++) { + for (i = 0; i < count; i++) { if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } @@ -1308,11 +1402,11 @@ maxPos = cursor; } if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > (size_t)(cursor - buffer))) { + if ((count == BINARY_ALL) || (count > (cursor - buffer))) { cursor = buffer; } else { cursor -= count; } break; @@ -1347,11 +1441,11 @@ goto error; badField: { Tcl_UniChar ch = 0; - char buf[TCL_UTF_MAX + 1] = ""; + char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); @@ -1379,32 +1473,30 @@ *---------------------------------------------------------------------- */ int BinaryScanCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - size_t count; /* Count associated with current format + int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; - int offset, size; - size_t length = 0; + int offset, size, length, i; - int i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; Tcl_HashTable *numberCachePtr; if (objc < 3) { @@ -1412,11 +1504,11 @@ "value formatString ?varName ...?"); return TCL_ERROR; } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); - buffer = TclGetByteArrayFromObj(objv[1], &length); + buffer = Tcl_GetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); arg = 3; offset = 0; while (*format != '\0') { str = format; @@ -1437,11 +1529,11 @@ count = length - offset; } else { if (count == BINARY_NOCOUNT) { count = 1; } - if (count > length - offset) { + if (count > (length - offset)) { goto done; } } src = buffer + offset; @@ -1496,30 +1588,30 @@ count = (length - offset) * 8; } else { if (count == BINARY_NOCOUNT) { count = 1; } - if (count > (size_t)(length - offset) * 8) { + if (count > (length - offset) * 8) { goto done; } } src = buffer + offset; valuePtr = Tcl_NewObj(); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); if (cmd == 'b') { - for (i = 0; (size_t)i < count; i++) { + for (i = 0; i < count; i++) { if (i % 8) { value >>= 1; } else { value = *src++; } *dest++ = (char) ((value & 1) ? '1' : '0'); } } else { - for (i = 0; (size_t)i < count; i++) { + for (i = 0; i < count; i++) { if (i % 8) { value <<= 1; } else { value = *src++; } @@ -1561,26 +1653,26 @@ valuePtr = Tcl_NewObj(); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); if (cmd == 'h') { - for (i = 0; (size_t)i < count; i++) { + for (i = 0; i < count; i++) { if (i % 2) { value >>= 4; } else { value = *src++; } - *dest++ = hexdigit[value & 0xf]; + *dest++ = hexdigit[value & 0xF]; } } else { - for (i = 0; (size_t)i < count; i++) { + for (i = 0; i < count; i++) { if (i % 2) { value <<= 4; } else { value = *src++; } - *dest++ = hexdigit[(value >> 4) & 0xf]; + *dest++ = hexdigit[(value >> 4) & 0xF]; } } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); @@ -1627,11 +1719,11 @@ if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_NOCOUNT) { - if ((length - offset) < (size_t)size) { + if ((length - offset) < size) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, &numberCachePtr); offset += size; @@ -1642,11 +1734,11 @@ if ((length - offset) < (count * size)) { goto done; } valuePtr = Tcl_NewObj(); src = buffer + offset; - for (i = 0; (size_t)i < count; i++) { + for (i = 0; i < count; i++) { elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr); src += size; Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); } offset += count * size; @@ -1663,21 +1755,21 @@ } case 'x': if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > length - offset)) { + if ((count == BINARY_ALL) || (count > (length - offset))) { offset = length; } else { offset += count; } break; case 'X': if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > (size_t)offset)) { + if ((count == BINARY_ALL) || (count > offset)) { offset = 0; } else { offset -= count; } break; @@ -1718,11 +1810,11 @@ goto error; badField: { Tcl_UniChar ch = 0; - char buf[TCL_UTF_MAX + 1] = ""; + char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); @@ -1757,11 +1849,11 @@ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ - size_t *countPtr, /* Pointer to repeat count value. */ + int *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* * Skip any leading blanks. */ @@ -1923,20 +2015,20 @@ static void CopyNumber( const void *from, /* source */ void *to, /* destination */ - size_t length, /* Number of bytes to copy */ + unsigned length, /* Number of bytes to copy */ int type) /* What type of thing are we copying? */ { switch (NeedReversing(type)) { case 0: memcpy(to, from, length); break; case 1: { - const unsigned char *fromPtr = from; - unsigned char *toPtr = to; + const unsigned char *fromPtr = (const unsigned char *)from; + unsigned char *toPtr = (unsigned char *)to; switch (length) { case 4: toPtr[0] = fromPtr[3]; toPtr[1] = fromPtr[2]; @@ -1955,12 +2047,12 @@ break; } break; } case 2: { - const unsigned char *fromPtr = from; - unsigned char *toPtr = to; + const unsigned char *fromPtr = (const unsigned char *)from; + unsigned char *toPtr = (unsigned char *)to; toPtr[0] = fromPtr[4]; toPtr[1] = fromPtr[5]; toPtr[2] = fromPtr[6]; toPtr[3] = fromPtr[7]; @@ -1969,12 +2061,12 @@ toPtr[6] = fromPtr[2]; toPtr[7] = fromPtr[3]; break; } case 3: { - const unsigned char *fromPtr = from; - unsigned char *toPtr = to; + const unsigned char *fromPtr = (const unsigned char *)from; + unsigned char *toPtr = (unsigned char *)to; toPtr[0] = fromPtr[3]; toPtr[1] = fromPtr[2]; toPtr[2] = fromPtr[1]; toPtr[3] = fromPtr[0]; @@ -2273,20 +2365,20 @@ returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { - register Tcl_HashTable *tablePtr = *numberCachePtrPtr; - register Tcl_HashEntry *hPtr; + Tcl_HashTable *tablePtr = *numberCachePtrPtr; + Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew); if (!isNew) { - return Tcl_GetHashValue(hPtr); + return (Tcl_Obj *)Tcl_GetHashValue(hPtr); } if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { - register Tcl_Obj *objPtr = Tcl_NewWideIntObj(value); + Tcl_Obj *objPtr = Tcl_NewWideIntObj(value); Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, objPtr); return objPtr; } @@ -2334,12 +2426,13 @@ } if (flags & BINARY_UNSIGNED) { Tcl_Obj *bigObj = NULL; mp_int big; - TclInitBignumFromWideUInt(&big, uwvalue); - bigObj = Tcl_NewBignumObj(&big); + if (mp_init_u64(&big, uwvalue) == MP_OKAY) { + bigObj = Tcl_NewBignumObj(&big); + } return bigObj; } return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); /* @@ -2401,11 +2494,11 @@ return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { - register Tcl_Obj *value = Tcl_GetHashValue(hEntry); + Tcl_Obj *value = (Tcl_Obj *)Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); } hEntry = Tcl_NextHashEntry(&search); @@ -2447,31 +2540,31 @@ *---------------------------------------------------------------------- */ static int BinaryEncodeHex( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; - size_t offset = 0, count = 0; + int offset = 0, count = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; } TclNewObj(resultObj); - data = TclGetByteArrayFromObj(objv[1], &count); + data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { - *cursor++ = HexDigits[(data[offset] >> 4) & 0x0f]; - *cursor++ = HexDigits[data[offset] & 0x0f]; + *cursor++ = HexDigits[(data[offset] >> 4) & 0x0F]; + *cursor++ = HexDigits[data[offset] & 0x0F]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -2491,20 +2584,20 @@ *---------------------------------------------------------------------- */ static int BinaryDecodeHex( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; - int i, index, value, size, cut = 0, strict = 0; - size_t count = 0; + int i, index, value, size, pure = 1, count = 0, cut = 0, strict = 0; + int ucs4; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); @@ -2521,12 +2614,16 @@ break; } } TclNewObj(resultObj); - datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc - 1], &count); + data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); + if (data == NULL) { + pure = 0; + data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); + } + datastart = data; dataend = data + count; size = (count + 1) / 2; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { value = 0; @@ -2551,11 +2648,11 @@ c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } - value |= c & 0xf; + value |= c & 0xF; } if (i < 2) { cut++; } *cursor++ = UCHAR(value); @@ -2567,32 +2664,32 @@ Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); Tcl_SetObjResult(interp, resultObj); return TCL_OK; badChar: + if (pure) { + ucs4 = c; + } else { + TclUtfToUCS4((const char *)(data - 1), &ucs4); + } TclDecrRefCount(resultObj); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hexadecimal digit \"%c\" at position %" TCL_Z_MODIFIER "u", - c, data - datastart - 1)); + "invalid hexadecimal digit \"%c\" (U+%06X) at position %d", + ucs4, ucs4, (int) (data - datastart - 1))); + Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * BinaryEncode64 -- * - * This implements a generic 6 bit binary encoding. Input is broken into - * 6 bit chunks and a lookup table passed in via clientData is used to - * turn these values into output characters. This is used to implement - * base64 binary encodings. + * This procedure implements the "binary encode base64" Tcl command. * * Results: - * Interp result set to an encoded byte array object - * - * Side effects: - * None + * The base64 encoded value prescribed by the input arguments. * *---------------------------------------------------------------------- */ #define OUTPUT(c) \ @@ -2611,22 +2708,21 @@ } \ } while (0) static int BinaryEncode64( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; - unsigned char *data, *cursor, *limit; + unsigned char *data, *limit; int maxlen = 0; const char *wrapchar = "\n"; - size_t wrapcharlen = 1; - int i, index, size, outindex = 0; - size_t offset, count = 0; + int wrapcharlen = 1; + int offset, i, index, size, outindex = 0, count = 0, purewrap = 1; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, @@ -2650,31 +2746,47 @@ "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: - wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); - if (wrapcharlen == 0) { - maxlen = 0; + wrapchar = (const char *)TclGetBytesFromObj(NULL, + objv[i + 1], &wrapcharlen); + if (wrapchar == NULL) { + purewrap = 0; + wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); } break; } } + if (wrapcharlen == 0) { + maxlen = 0; + } resultObj = Tcl_NewObj(); - data = TclGetByteArrayFromObj(objv[objc - 1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { + unsigned char *cursor = NULL; + size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { int adjusted = size + (wrapcharlen * (size / maxlen)); if (size % maxlen == 0) { adjusted -= wrapcharlen; } size = adjusted; + + if (purewrap == 0) { + /* Wrapchar is (possibly) non-byte, so build result as + * general string, not bytearray */ + Tcl_SetObjLength(resultObj, size); + cursor = (unsigned char *) TclGetString(resultObj); + } } - cursor = Tcl_SetByteArrayLength(resultObj, size); + if (cursor == NULL) { + cursor = Tcl_SetByteArrayLength(resultObj, size); + } limit = cursor + size; for (offset = 0; offset < count; offset += 3) { unsigned char d[3] = {0, 0, 0}; for (i = 0; i < 3 && offset + i < count; ++i) { @@ -2681,16 +2793,16 @@ d[i] = data[offset + i]; } OUTPUT(B64Digits[d[0] >> 2]); OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); if (offset + 1 < count) { - OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); + OUTPUT(B64Digits[((d[1] & 0x0F) << 2) | (d[2] >> 6)]); } else { OUTPUT(B64Digits[64]); } if (offset+2 < count) { - OUTPUT(B64Digits[d[2] & 0x3f]); + OUTPUT(B64Digits[d[2] & 0x3F]); } else { OUTPUT(B64Digits[64]); } } } @@ -2718,22 +2830,22 @@ *---------------------------------------------------------------------- */ static int BinaryEncodeUu( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int rawLength, n, i, bits, index; + int offset, count, rawLength, n, i, j, bits, index; int lineLength = 61; - const unsigned char SingleNewline[] = { (unsigned char) '\n' }; + const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; - size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); + int wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, @@ -2749,20 +2861,51 @@ case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &lineLength) != TCL_OK) { return TCL_ERROR; } - if (lineLength < 3 || lineLength > 85) { + if (lineLength < 5 || lineLength > 85) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } + lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ break; case OPT_WRAPCHAR: - wrapchar = TclGetByteArrayFromObj(objv[i + 1], &wrapcharlen); + wrapchar = (const unsigned char *) TclGetStringFromObj( + objv[i + 1], &wrapcharlen); + { + const unsigned char *p = wrapchar; + int numBytes = wrapcharlen; + + while (numBytes) { + switch (*p) { + case '\t': + case '\v': + case '\f': + case '\r': + p++; numBytes--; + continue; + case '\n': + numBytes--; + break; + default: + badwrap: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid wrapchar; will defeat decoding", + -1)); + Tcl_SetErrorCode(interp, "TCL", "BINARY", + "ENCODE", "WRAPCHAR", NULL); + return TCL_ERROR; + } + } + if (numBytes) { + goto badwrap; + } + } break; } } /* @@ -2770,11 +2913,11 @@ * enough". */ resultObj = Tcl_NewObj(); offset = 0; - data = TclGetByteArrayFromObj(objv[objc - 1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * ((count + (rawLength - 1)) / rawLength)); n = bits = 0; @@ -2795,16 +2938,16 @@ *cursor++ = UueDigits[lineLen]; for (i = 0 ; i < lineLen ; i++) { n <<= 8; n |= data[offset++]; for (bits += 8; bits > 6 ; bits -= 6) { - *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f]; + *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3F]; } } if (bits > 0) { n <<= 8; - *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f]; + *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3F]; bits = 0; } for (j = 0 ; j < wrapcharlen ; ++j) { *cursor++ = wrapchar[j]; } @@ -2835,21 +2978,21 @@ *---------------------------------------------------------------------- */ static int BinaryDecodeUu( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; - int i, index, size, strict = 0, lineLen; - size_t count = 0; + int i, index, size, pure = 1, count = 0, strict = 0, lineLen; unsigned char c; + int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); @@ -2866,12 +3009,16 @@ break; } } TclNewObj(resultObj); - datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc - 1], &count); + data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); + if (data == NULL) { + pure = 0; + data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); + } + datastart = data; dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); lineLen = -1; @@ -2892,11 +3039,11 @@ goto badUu; } i--; continue; } - lineLen = (c - 32) & 0x3f; + lineLen = (c - 32) & 0x3F; } /* * Now we read a four-character grouping. */ @@ -2921,18 +3068,18 @@ /* * Translate that grouping into (up to) three binary bytes output. */ if (lineLen > 0) { - *cursor++ = (((d[0] - 0x20) & 0x3f) << 2) - | (((d[1] - 0x20) & 0x3f) >> 4); - if (--lineLen > 0) { - *cursor++ = (((d[1] - 0x20) & 0x3f) << 4) - | (((d[2] - 0x20) & 0x3f) >> 2); - if (--lineLen > 0) { - *cursor++ = (((d[2] - 0x20) & 0x3f) << 6) - | (((d[3] - 0x20) & 0x3f)); + *cursor++ = (((d[0] - 0x20) & 0x3F) << 2) + | (((d[1] - 0x20) & 0x3F) >> 4); + if (--lineLen > 0) { + *cursor++ = (((d[1] - 0x20) & 0x3F) << 4) + | (((d[2] - 0x20) & 0x3F) >> 2); + if (--lineLen > 0) { + *cursor++ = (((d[2] - 0x20) & 0x3F) << 6) + | (((d[3] - 0x20) & 0x3F)); lineLen--; } } } @@ -2973,13 +3120,18 @@ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; badUu: + if (pure) { + ucs4 = c; + } else { + TclUtfToUCS4((const char *)(data - 1), &ucs4); + } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid uuencode character \"%c\" at position %" TCL_Z_MODIFIER "u", - c, data - datastart - 1)); + "invalid uuencode character \"%c\" (U+%06X) at position %d", + ucs4, ucs4, (int) (data - datastart - 1))); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } @@ -2999,22 +3151,22 @@ *---------------------------------------------------------------------- */ static int BinaryDecode64( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend, c = '\0'; unsigned char *begin = NULL; unsigned char *cursor = NULL; - int strict = 0; - int i, index, size, cut = 0; - size_t count = 0; + int pure = 1, strict = 0; + int i, index, size, cut = 0, count = 0; + int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); @@ -3031,12 +3183,16 @@ break; } } TclNewObj(resultObj); - datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc - 1], &count); + data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); + if (data == NULL) { + pure = 0; + data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); + } + datastart = data; dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { unsigned long value = 0; @@ -3082,43 +3238,43 @@ if (cut) { if (c == '=' && i > 1) { value <<= 6; cut++; - } else if (!strict && TclIsSpaceProc(c)) { + } else if (!strict) { i--; } else { goto bad64; } } else if (c >= 'A' && c <= 'Z') { - value = (value << 6) | ((c - 'A') & 0x3f); + value = (value << 6) | ((c - 'A') & 0x3F); } else if (c >= 'a' && c <= 'z') { - value = (value << 6) | ((c - 'a' + 26) & 0x3f); + value = (value << 6) | ((c - 'a' + 26) & 0x3F); } else if (c >= '0' && c <= '9') { - value = (value << 6) | ((c - '0' + 52) & 0x3f); + value = (value << 6) | ((c - '0' + 52) & 0x3F); } else if (c == '+') { - value = (value << 6) | 0x3e; + value = (value << 6) | 0x3E; } else if (c == '/') { - value = (value << 6) | 0x3f; + value = (value << 6) | 0x3F; } else if (c == '=' && (!strict || i > 1)) { /* * "=" and "a=" is rather bad64 error case in strict mode. */ value <<= 6; if (i) { cut++; } - } else if (strict || !TclIsSpaceProc(c)) { + } else if (strict) { goto bad64; } else { i--; } } - *cursor++ = UCHAR((value >> 16) & 0xff); - *cursor++ = UCHAR((value >> 8) & 0xff); - *cursor++ = UCHAR(value & 0xff); + *cursor++ = UCHAR((value >> 16) & 0xFF); + *cursor++ = UCHAR((value >> 8) & 0xFF); + *cursor++ = UCHAR(value & 0xFF); /* * Since = is only valid within the final block, if it was encountered * but there are still more input characters, confirm that strict mode * is off and all subsequent characters are whitespace. @@ -3125,26 +3281,33 @@ */ if (cut && data < dataend) { if (strict) { goto bad64; - } - for (; data < dataend; data++) { - if (!TclIsSpaceProc(*data)) { - goto bad64; - } } } } Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); Tcl_SetObjResult(interp, resultObj); return TCL_OK; bad64: + if (pure) { + ucs4 = c; + } else { + /* The decoder is byte-oriented. If we saw a byte that's not a + * valid member of the base64 alphabet, it could be the lead byte + * of a multi-byte character. */ + + /* Safe because we know data is NUL-terminated */ + TclUtfToUCS4((const char *)(data - 1), &ucs4); + } + Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid base64 character \"%c\" at position %" TCL_Z_MODIFIER "u", - (char) c, data - datastart - 1)); + "invalid base64 character \"%c\" (U+%06X) at position %d", + ucs4, ucs4, (int) (data - datastart - 1))); + Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } /* Index: generic/tclCkalloc.c ================================================================== --- generic/tclCkalloc.c +++ generic/tclCkalloc.c @@ -18,11 +18,13 @@ #include "tclInt.h" #define FALSE 0 #define TRUE 1 +#undef Tcl_Alloc #undef Tcl_Free +#undef Tcl_Realloc #undef Tcl_AttemptAlloc #undef Tcl_AttemptRealloc #ifdef TCL_MEM_DEBUG @@ -29,11 +31,11 @@ /* * One of the following structures is allocated each time the * "memory tag" command is invoked, to hold the current tag. */ -typedef struct { +typedef struct MemTag { size_t refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as * needed for actual tag. This must be the * last field in the structure. */ @@ -117,24 +119,26 @@ * information. */ /* * Mutex to serialize allocations. This is a low-level mutex that must be * explicitly initialized. This is necessary because the self initializing - * mutexes use Tcl_Alloc... + * mutexes use ckalloc... */ static Tcl_Mutex *ckallocMutexPtr; static int ckallocInit = 0; /* * Prototypes for procedures defined in this file: */ -static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char *argv[]); -static int MemoryCmd(ClientData clientData, Tcl_Interp *interp, - int argc, const char *argv[]); +static int CheckmemCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int MemoryCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static void ValidateMemory(struct mem_header *memHeaderP, const char *file, int line, int nukeGuards); /* *---------------------------------------------------------------------- @@ -141,11 +145,11 @@ * * TclInitDbCkalloc -- * * Initialize the locks used by the allocator. This is only appropriate * to call in a single threaded environment, such as during - * TclInitSubsystems. + * Tcl_InitSubsystems. * *---------------------------------------------------------------------- */ void @@ -240,17 +244,17 @@ for (idx = 0; idx < LOW_GUARD_SIZE; idx++) { byte = *(memHeaderP->low_guard + idx); if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); - byte &= 0xff; - fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, + byte &= 0xFF; + fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { - TclDumpMemoryInfo(stderr, 0); + TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "low guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); @@ -261,18 +265,18 @@ for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) { byte = *(hiPtr + idx); if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); - byte &= 0xff; - fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, + byte &= 0xFF; + fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { - TclDumpMemoryInfo(stderr, 0); + TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "high guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, @@ -372,28 +376,28 @@ } /* *---------------------------------------------------------------------- * - * Tcl_DbCkalloc - debugging Tcl_Alloc + * Tcl_DbCkalloc - debugging ckalloc * * Allocate the requested amount of space plus some extra for guard bands * at both ends of the request, plus a size, panicing if there isn't * enough space, then write in the guard bands and return the address of * the space in the middle that the user asked for. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent - * by the Tcl_Alloc macro; it uses the preprocessor autodefines __FILE__ + * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ * and __LINE__. * *---------------------------------------------------------------------- */ -void * +char * Tcl_DbCkalloc( - size_t size, + unsigned int size, const char *file, int line) { struct mem_header *result = NULL; @@ -406,12 +410,12 @@ result = (struct mem_header *) TclpAlloc(size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { fflush(stdout); - TclDumpMemoryInfo(stderr, 0); - Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", size, file, line); + TclDumpMemoryInfo((ClientData) stderr, 0); + Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } /* * Fill in guard zones and size. Also initialize the contents of the block * with bogus bytes to detect uses of initialized data. Link into @@ -453,11 +457,11 @@ alloc_tracing = TRUE; trace_on_at_malloc = 0; } if (alloc_tracing) { - fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr,"ckalloc %p %u %s %d\n", result->body, size, file, line); } if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; @@ -477,13 +481,13 @@ Tcl_MutexUnlock(ckallocMutexPtr); return result->body; } -void * +char * Tcl_AttemptDbCkalloc( - size_t size, + unsigned int size, const char *file, int line) { struct mem_header *result = NULL; @@ -496,11 +500,11 @@ result = (struct mem_header *) TclpAlloc(size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { fflush(stdout); - TclDumpMemoryInfo(stderr, 0); + TclDumpMemoryInfo((ClientData) stderr, 0); return NULL; } /* * Fill in guard zones and size. Also initialize the contents of the block @@ -542,11 +546,11 @@ alloc_tracing = TRUE; trace_on_at_malloc = 0; } if (alloc_tracing) { - fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr,"ckalloc %p %u %s %d\n", result->body, size, file, line); } if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; @@ -569,28 +573,28 @@ } /* *---------------------------------------------------------------------- * - * Tcl_DbCkfree - debugging Tcl_Free + * Tcl_DbCkfree - debugging ckfree * * Verify that the low and high guards are intact, and if so then free * the buffer else Tcl_Panic. * * The guards are erased after being checked to catch duplicate frees. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent - * by the Tcl_Free macro; it uses the preprocessor autodefines __FILE__ and + * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and * __LINE__. * *---------------------------------------------------------------------- */ void Tcl_DbCkfree( - void *ptr, + char *ptr, const char *file, int line) { struct mem_header *memp; @@ -607,11 +611,11 @@ */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { - fprintf(stderr, "Tcl_Free %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n", memp->body, memp->length, file, line); } if (validate_memory) { Tcl_ValidateAllMemory(file, line); @@ -627,11 +631,11 @@ current_malloc_packets--; current_bytes_malloced -= memp->length; if (memp->tagPtr != NULL) { if ((memp->tagPtr->refCount-- <= 1) && (curTagPtr != memp->tagPtr)) { - TclpFree((char *) memp->tagPtr); + TclpFree(memp->tagPtr); } } /* * Delink from allocated list @@ -644,31 +648,31 @@ memp->blink->flink = memp->flink; } if (allocHead == memp) { allocHead = memp->flink; } - TclpFree((char *) memp); + TclpFree(memp); Tcl_MutexUnlock(ckallocMutexPtr); } /* *-------------------------------------------------------------------- * - * Tcl_DbCkrealloc - debugging Tcl_Realloc + * Tcl_DbCkrealloc - debugging ckrealloc * * Reallocate a chunk of memory by allocating a new one of the right * size, copying the old data to the new location, and then freeing the * old memory space, using all the memory checking features of this * package. * *-------------------------------------------------------------------- */ -void * +char * Tcl_DbCkrealloc( - void *ptr, - size_t size, + char *ptr, + unsigned int size, const char *file, int line) { char *newPtr; size_t copySize; @@ -692,14 +696,14 @@ memcpy(newPtr, ptr, copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; } -void * +char * Tcl_AttemptDbCkrealloc( - void *ptr, - size_t size, + char *ptr, + unsigned int size, const char *file, int line) { char *newPtr; size_t copySize; @@ -730,10 +734,63 @@ /* *---------------------------------------------------------------------- * + * Tcl_Alloc, et al. -- + * + * These functions are defined in terms of the debugging versions when + * TCL_MEM_DEBUG is set. + * + * Results: + * Same as the debug versions. + * + * Side effects: + * Same as the debug versions. + * + *---------------------------------------------------------------------- + */ + +char * +Tcl_Alloc( + unsigned int size) +{ + return Tcl_DbCkalloc(size, "unknown", 0); +} + +char * +Tcl_AttemptAlloc( + unsigned int size) +{ + return Tcl_AttemptDbCkalloc(size, "unknown", 0); +} + +void +Tcl_Free( + char *ptr) +{ + Tcl_DbCkfree(ptr, "unknown", 0); +} + +char * +Tcl_Realloc( + char *ptr, + unsigned int size) +{ + return Tcl_DbCkrealloc(ptr, size, "unknown", 0); +} +char * +Tcl_AttemptRealloc( + char *ptr, + unsigned int size) +{ + return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); +} + +/* + *---------------------------------------------------------------------- + * * MemoryCmd -- * * Implements the Tcl "memory" command, which provides Tcl-level control * of Tcl memory debugging information. * memory active $file @@ -749,85 +806,80 @@ * Results: * Standard TCL results. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int MemoryCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - int argc, - const char *argv[]) + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Obj values of arguments. */ { const char *fileName; FILE *fileP; Tcl_DString buffer; int result; size_t len; - if (argc < 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s option [args..]\"", argv[0])); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option [args..]"); return TCL_ERROR; } - if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s %s file\"", - argv[0], argv[1])); + if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer); if (fileName == NULL) { return TCL_ERROR; } result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", - argv[2], Tcl_PosixError(interp))); + TclGetString(objv[2]), Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } - if (strcmp(argv[1],"break_on_malloc") == 0) { + if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { int value; - if (argc != 3) { + if (objc != 3) { goto argError; } - if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } break_on_malloc = (unsigned int) value; return TCL_OK; } - if (strcmp(argv[1],"info") == 0) { + if (strcmp(TclGetString(objv[1]),"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, "maximum bytes allocated", maximum_bytes_malloced)); return TCL_OK; } - if (strcmp(argv[1], "init") == 0) { - if (argc != 3) { + if (strcmp(TclGetString(objv[1]), "init") == 0) { + if (objc != 3) { goto bad_suboption; } - init_malloced_bodies = (strcmp(argv[2],"on") == 0); + init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } - if (strcmp(argv[1], "objs") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s objs file\"", argv[0])); + if (strcmp(TclGetString(objv[1]), "objs") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer); if (fileName == NULL) { return TCL_ERROR; } fileP = fopen(fileName, "w"); if (fileP == NULL) { @@ -839,81 +891,77 @@ TclDbDumpActiveObjects(fileP); fclose(fileP); Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(argv[1],"onexit") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s onexit file\"", argv[0])); + if (strcmp(TclGetString(objv[1]),"onexit") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer); if (fileName == NULL) { return TCL_ERROR; } onExitMemDumpFileName = dumpFile; strcpy(onExitMemDumpFileName,fileName); Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(argv[1],"tag") == 0) { - if (argc != 3) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s tag string\"", argv[0])); - return TCL_ERROR; - } - if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { - TclpFree((char *) curTagPtr); - } - len = strlen(argv[2]); - curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len)); - curTagPtr->refCount = 0; - memcpy(curTagPtr->string, argv[2], len + 1); - return TCL_OK; - } - if (strcmp(argv[1],"trace") == 0) { - if (argc != 3) { - goto bad_suboption; - } - alloc_tracing = (strcmp(argv[2],"on") == 0); - return TCL_OK; - } - - if (strcmp(argv[1],"trace_on_at_malloc") == 0) { - int value; - if (argc != 3) { - goto argError; - } - if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { + if (strcmp(TclGetString(objv[1]),"tag") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "file"); + return TCL_ERROR; + } + if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { + TclpFree(curTagPtr); + } + len = strlen(TclGetString(objv[2])); + curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len)); + curTagPtr->refCount = 0; + memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1); + return TCL_OK; + } + if (strcmp(TclGetString(objv[1]),"trace") == 0) { + if (objc != 3) { + goto bad_suboption; + } + alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0); + return TCL_OK; + } + + if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) { + int value; + if (objc != 3) { + goto argError; + } + if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } trace_on_at_malloc = value; return TCL_OK; } - if (strcmp(argv[1],"validate") == 0) { - if (argc != 3) { + if (strcmp(TclGetString(objv[1]),"validate") == 0) { + if (objc != 3) { goto bad_suboption; } - validate_memory = (strcmp(argv[2],"on") == 0); + validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": should be active, break_on_malloc, info, " "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", - argv[1])); + TclGetString(objv[1]))); return TCL_ERROR; argError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s %s count\"", argv[0], argv[1])); + Tcl_WrongNumArgs(interp, 2, objv, "count"); return TCL_ERROR; bad_suboption: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1])); + Tcl_WrongNumArgs(interp, 2, objv, "on|off"); return TCL_ERROR; } /* *---------------------------------------------------------------------- @@ -930,25 +978,27 @@ * Side effects: * None. * *---------------------------------------------------------------------- */ +static int CheckmemCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int CheckmemCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter for evaluation. */ - int argc, /* Number of arguments. */ - const char *argv[]) /* String values of arguments. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Obj values of arguments. */ { - if (argc != 2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "wrong # args: should be \"%s fileName\"", argv[0])); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "fileName"); return TCL_ERROR; } tclMemDumpFileName = dumpFile; - strcpy(tclMemDumpFileName, argv[1]); + strcpy(tclMemDumpFileName, TclGetString(objv[1])); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -970,12 +1020,12 @@ Tcl_InitMemory( Tcl_Interp *interp) /* Interpreter in which commands should be * added */ { TclInitDbCkalloc(); - Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL); - Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } #else /* TCL_MEM_DEBUG */ @@ -995,18 +1045,15 @@ * that memory was actually allocated. * *---------------------------------------------------------------------- */ -#undef Tcl_Alloc -void * +char * Tcl_Alloc( - size_t size) + unsigned int size) { - void *result; - - result = TclpAlloc(size); + char *result = (char *)TclpAlloc(size); /* * Most systems will not alloc(0), instead bumping it to one so that NULL * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning * NULL, so we have to check that the NULL we get is not in response to @@ -1015,29 +1062,26 @@ * The ANSI spec actually says that systems either return NULL *or* a * special pointer on failure, but we only check for NULL */ if ((result == NULL) && size) { - Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size); + Tcl_Panic("unable to alloc %u bytes", size); } return result; } -void * +char * Tcl_DbCkalloc( - size_t size, + unsigned int size, const char *file, int line) { - void *result; - - result = TclpAlloc(size); + char *result = (char *)TclpAlloc(size); if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", - size, file, line); + Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } return result; } /* @@ -1049,30 +1093,24 @@ * check that memory was actually allocated. * *---------------------------------------------------------------------- */ -void * +char * Tcl_AttemptAlloc( - size_t size) + unsigned int size) { - void *result; - - result = TclpAlloc(size); - return result; + return (char *)TclpAlloc(size); } -void * +char * Tcl_AttemptDbCkalloc( - size_t size, - const char *file, - int line) -{ - void *result; - - result = TclpAlloc(size); - return result; + unsigned int size, + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ + return (char *)TclpAlloc(size); } /* *---------------------------------------------------------------------- * @@ -1082,41 +1120,35 @@ * that memory was actually allocated. * *---------------------------------------------------------------------- */ -#undef Tcl_Realloc -void * +char * Tcl_Realloc( - void *ptr, - size_t size) + char *ptr, + unsigned int size) { - char *result; - - result = TclpRealloc(ptr, size); + char *result = (char *)TclpRealloc(ptr, size); if ((result == NULL) && size) { - Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size); + Tcl_Panic("unable to realloc %u bytes", size); } return result; } -void * +char * Tcl_DbCkrealloc( - void *ptr, - size_t size, + char *ptr, + unsigned int size, const char *file, int line) { - void *result; - - result = TclpRealloc(ptr, size); + char *result = (char *)TclpRealloc(ptr, size); if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes, %s line %d", - size, file, line); + Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); } return result; } /* @@ -1128,32 +1160,26 @@ * check that memory was actually allocated. * *---------------------------------------------------------------------- */ -void * +char * Tcl_AttemptRealloc( - void *ptr, - size_t size) + char *ptr, + unsigned int size) { - void *result; - - result = TclpRealloc(ptr, size); - return result; + return (char *)TclpRealloc(ptr, size); } -void * +char * Tcl_AttemptDbCkrealloc( - void *ptr, - size_t size, - const char *file, - int line) -{ - void *result; - - result = TclpRealloc(ptr, size); - return result; + char *ptr, + unsigned int size, + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ + return (char *)TclpRealloc(ptr, size); } /* *---------------------------------------------------------------------- * @@ -1164,23 +1190,22 @@ * TCL_MEM_DEBUG enabled and some with it disabled. * *---------------------------------------------------------------------- */ -#undef Tcl_Free void Tcl_Free( - void *ptr) + char *ptr) { TclpFree(ptr); } void Tcl_DbCkfree( - void *ptr, - const char *file, - int line) + char *ptr, + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { TclpFree(ptr); } /* @@ -1191,35 +1216,34 @@ * Dummy initialization for memory command, which is only available if * TCL_MEM_DEBUG is on. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ void Tcl_InitMemory( - Tcl_Interp *interp) + TCL_UNUSED(Tcl_Interp *) /*interp*/) { } int Tcl_DumpActiveMemory( - const char *fileName) + TCL_UNUSED(const char *) /*fileName*/) { return TCL_OK; } void Tcl_ValidateAllMemory( - const char *file, - int line) + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { } int TclDumpMemoryInfo( - ClientData clientData, - int flags) + TCL_UNUSED(ClientData), + TCL_UNUSED(int) /*flags*/) { return 1; } #endif /* TCL_MEM_DEBUG */ @@ -1254,11 +1278,11 @@ } Tcl_MutexLock(ckallocMutexPtr); if (curTagPtr != NULL) { - TclpFree((char *) curTagPtr); + TclpFree(curTagPtr); curTagPtr = NULL; } allocHead = NULL; Tcl_MutexUnlock(ckallocMutexPtr); Index: generic/tclClock.c ================================================================== --- generic/tclClock.c +++ generic/tclClock.c @@ -98,20 +98,20 @@ /* * Structure containing the fields used in [clock format] and [clock scan] */ -typedef struct { +typedef struct TclDateFields { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds * from the Posix epoch */ int tzOffset; /* Time zone offset in seconds east of * Greenwich */ Tcl_Obj *tzName; /* Time zone name */ int julianDay; /* Julian Day Number in local time zone */ - enum {BCE=1, CE=0} era; /* Era */ + int isBce; /* 1 if BCE */ int gregorian; /* Flag == 1 if the date is Gregorian */ int year; /* Year of the era */ int dayOfYear; /* Day of the year (1 January == 1) */ int month; /* Month number */ int dayOfMonth; /* Day of the month */ @@ -273,13 +273,13 @@ /* * Create the client data, which is a refcounted literal pool. */ - data = Tcl_Alloc(sizeof(ClockClientData)); + data = (ClockClientData *)ckalloc(sizeof(ClockClientData)); data->refCount = 0; - data->literals = Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*)); + data->literals = (Tcl_Obj **)ckalloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { data->literals[i] = Tcl_NewStringObj(literals[i], -1); Tcl_IncrRefCount(data->literals[i]); } @@ -334,12 +334,12 @@ ClientData clientData, /* Client data */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { - ClockClientData *data = clientData; - Tcl_Obj *const *literals = data->literals; + ClockClientData *data = (ClockClientData *)clientData; + Tcl_Obj *const *lit = data->literals; Tcl_Obj *secondsObj; Tcl_Obj *dict; int changeover; TclDateFields fields; int created = 0; @@ -352,11 +352,11 @@ if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); return TCL_ERROR; } dict = objv[1]; - if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS], + if (Tcl_DictObjGet(interp, dict, lit[LIT_LOCALSECONDS], &secondsObj)!= TCL_OK) { return TCL_ERROR; } if (secondsObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not " @@ -378,11 +378,11 @@ if (Tcl_IsShared(dict)) { dict = Tcl_DuplicateObj(dict); created = 1; Tcl_IncrRefCount(dict); } - status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS], + status = Tcl_DictObjPut(interp, dict, lit[LIT_SECONDS], Tcl_NewWideIntObj(fields.seconds)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } if (created) { @@ -428,12 +428,12 @@ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; - ClockClientData *data = clientData; - Tcl_Obj *const *literals = data->literals; + ClockClientData *data = (ClockClientData *)clientData; + Tcl_Obj *const *lit = data->literals; int changeover; /* * Check params. */ @@ -451,11 +451,11 @@ * fields.seconds could be an unsigned number that overflowed. Make sure * that it isn't. */ if (TclHasIntRep(objv[1], &tclBignumType)) { - Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]); + Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; } /* * Convert UTC time to local. @@ -479,37 +479,37 @@ GetGregorianEraYearDay(&fields, changeover); GetMonthDay(&fields); GetYearWeekDay(&fields, changeover); dict = Tcl_NewDictObj(); - Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS], + Tcl_DictObjPut(NULL, dict, lit[LIT_LOCALSECONDS], Tcl_NewWideIntObj(fields.localSeconds)); - Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS], + Tcl_DictObjPut(NULL, dict, lit[LIT_SECONDS], Tcl_NewWideIntObj(fields.seconds)); - Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName); + Tcl_DictObjPut(NULL, dict, lit[LIT_TZNAME], fields.tzName); Tcl_DecrRefCount(fields.tzName); - Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET], + Tcl_DictObjPut(NULL, dict, lit[LIT_TZOFFSET], Tcl_NewWideIntObj(fields.tzOffset)); - Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY], + Tcl_DictObjPut(NULL, dict, lit[LIT_JULIANDAY], Tcl_NewWideIntObj(fields.julianDay)); - Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN], + Tcl_DictObjPut(NULL, dict, lit[LIT_GREGORIAN], Tcl_NewWideIntObj(fields.gregorian)); - Tcl_DictObjPut(NULL, dict, literals[LIT_ERA], - literals[fields.era ? LIT_BCE : LIT_CE]); - Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR], + Tcl_DictObjPut(NULL, dict, lit[LIT_ERA], + lit[fields.isBce ? LIT_BCE : LIT_CE]); + Tcl_DictObjPut(NULL, dict, lit[LIT_YEAR], Tcl_NewWideIntObj(fields.year)); - Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR], + Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFYEAR], Tcl_NewWideIntObj(fields.dayOfYear)); - Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH], + Tcl_DictObjPut(NULL, dict, lit[LIT_MONTH], Tcl_NewWideIntObj(fields.month)); - Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH], + Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFMONTH], Tcl_NewWideIntObj(fields.dayOfMonth)); - Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601YEAR], + Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601YEAR], Tcl_NewWideIntObj(fields.iso8601Year)); - Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK], + Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601WEEK], Tcl_NewWideIntObj(fields.iso8601Week)); - Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK], + Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFWEEK], Tcl_NewWideIntObj(fields.dayOfWeek)); Tcl_SetObjResult(interp, dict); return TCL_OK; } @@ -582,16 +582,16 @@ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; - ClockClientData *data = clientData; - Tcl_Obj *const *literals = data->literals; + ClockClientData *data = (ClockClientData *)clientData; + Tcl_Obj *const *lit = data->literals; int changeover; int copied = 0; int status; - int era = 0; + int isBce = 0; /* * Check params. */ @@ -598,21 +598,21 @@ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); return TCL_ERROR; } dict = objv[1]; - if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK - || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year) + if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK + || FetchIntField(interp, dict, lit[LIT_YEAR], &fields.year) != TCL_OK - || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month) + || FetchIntField(interp, dict, lit[LIT_MONTH], &fields.month) != TCL_OK - || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH], + || FetchIntField(interp, dict, lit[LIT_DAYOFMONTH], &fields.dayOfMonth) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } - fields.era = era; + fields.isBce = isBce; /* * Get Julian day. */ @@ -625,11 +625,11 @@ if (Tcl_IsShared(dict)) { dict = Tcl_DuplicateObj(dict); Tcl_IncrRefCount(dict); copied = 1; } - status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY], + status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY], Tcl_NewWideIntObj(fields.julianDay)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } if (copied) { @@ -666,16 +666,16 @@ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { TclDateFields fields; Tcl_Obj *dict; - ClockClientData *data = clientData; - Tcl_Obj *const *literals = data->literals; + ClockClientData *data = (ClockClientData *)clientData; + Tcl_Obj *const *lit = data->literals; int changeover; int copied = 0; int status; - int era = 0; + int isBce = 0; /* * Check params. */ @@ -682,21 +682,21 @@ if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); return TCL_ERROR; } dict = objv[1]; - if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK - || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR], + if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK + || FetchIntField(interp, dict, lit[LIT_ISO8601YEAR], &fields.iso8601Year) != TCL_OK - || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK], + || FetchIntField(interp, dict, lit[LIT_ISO8601WEEK], &fields.iso8601Week) != TCL_OK - || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK], + || FetchIntField(interp, dict, lit[LIT_DAYOFWEEK], &fields.dayOfWeek) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } - fields.era = era; + fields.isBce = isBce; /* * Get Julian day. */ @@ -709,11 +709,11 @@ if (Tcl_IsShared(dict)) { dict = Tcl_DuplicateObj(dict); Tcl_IncrRefCount(dict); copied = 1; } - status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY], + status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY], Tcl_NewWideIntObj(fields.julianDay)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } if (copied) { @@ -1050,11 +1050,11 @@ int changeover) /* Julian Day of the Gregorian transition */ { time_t tock; struct tm *timeVal; /* Time after conversion */ int diff; /* Time zone diff local-Greenwich */ - char buffer[8]; /* Buffer for time zone name */ + char buffer[16]; /* Buffer for time zone name */ /* * Use 'localtime' to determine local year, month, day, time of day. */ @@ -1077,11 +1077,11 @@ /* * Fill in the date in 'fields' and use it to derive Julian Day. */ - fields->era = CE; + fields->isBce = 0; fields->year = timeVal->tm_year + 1900; fields->month = timeVal->tm_mon + 1; fields->dayOfMonth = timeVal->tm_mday; GetJulianDayFromEraYearMonthDay(fields, changeover); @@ -1215,11 +1215,11 @@ * iso8601 year is an upper bound on the ISO8601 year of the given date. */ temp.julianDay = fields->julianDay - 3; GetGregorianEraYearDay(&temp, changeover); - if (temp.era == BCE) { + if (temp.isBce) { temp.iso8601Year = temp.year - 1; } else { temp.iso8601Year = temp.year + 1; } temp.iso8601Week = 1; @@ -1231,11 +1231,11 @@ * corresponding to the given date, or the one after. If we guessed high, * move one year earlier */ if (fields->julianDay < temp.julianDay) { - if (temp.era == BCE) { + if (temp.isBce) { temp.iso8601Year += 1; } else { temp.iso8601Year -= 1; } GetJulianDayFromEraYearWeekDay(&temp, changeover); @@ -1357,14 +1357,14 @@ /* * store era/year/day back into fields. */ if (year <= 0) { - fields->era = BCE; + fields->isBce = 1; fields->year = 1 - year; } else { - fields->era = CE; + fields->isBce = 0; fields->year = year; } fields->dayOfYear = day + 1; } @@ -1428,11 +1428,11 @@ /* * Find January 4 in the ISO8601 year, which will always be in week 1. */ - firstWeek.era = fields->era; + firstWeek.isBce = fields->isBce; firstWeek.year = fields->iso8601Year; firstWeek.month = 1; firstWeek.dayOfMonth = 4; GetJulianDayFromEraYearMonthDay(&firstWeek, changeover); @@ -1472,11 +1472,11 @@ TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ { int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400; - if (fields->era == BCE) { + if (fields->isBce) { year = 1 - fields->year; } else { year = fields->year; } @@ -1500,22 +1500,22 @@ * Adjust the year after reducing the month. */ fields->gregorian = 1; if (year < 1) { - fields->era = BCE; + fields->isBce = 1; fields->year = 1-year; } else { - fields->era = CE; + fields->isBce = 0; fields->year = year; } /* * Try an initial conversion in the Gregorian calendar. */ -#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */ +#if 0 /* BUG https://core.tcl-lang.org/tcl/tktview?name=da340d4f32 */ ym1o4 = ym1 / 4; #else /* * Have to make sure quotient is truncated towards 0 when negative. * See above bug for details. The casts are necessary. @@ -1578,11 +1578,11 @@ IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { int year = fields->year; - if (fields->era == BCE) { + if (fields->isBce) { year = 1 - year; } if (year%4 != 0) { return 0; } else if (!(fields->gregorian)) { @@ -1643,11 +1643,11 @@ *---------------------------------------------------------------------- */ int ClockGetenvObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *varName; @@ -1690,11 +1690,11 @@ { /* * Get a thread-local buffer to hold the returned time. */ - struct tm *tmPtr = Tcl_GetThreadData(&tmKey, sizeof(struct tm)); + struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm)); #ifdef HAVE_LOCALTIME_R localtime_r(timePtr, tmPtr); #else struct tm *sysTmPtr; @@ -1728,11 +1728,11 @@ *---------------------------------------------------------------------- */ int ClockClicksObjCmd( - ClientData clientData, /* Client data is unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { static const char *const clicksSwitches[] = { @@ -1798,11 +1798,11 @@ *---------------------------------------------------------------------- */ int ClockMillisecondsObjCmd( - ClientData clientData, /* Client data is unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; @@ -1835,11 +1835,11 @@ *---------------------------------------------------------------------- */ int ClockMicrosecondsObjCmd( - ClientData clientData, /* Client data is unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { if (objc != 1) { @@ -1873,11 +1873,11 @@ ClientData clientData, /* Client data containing literal pool */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { - ClockClientData *dataPtr = clientData; + ClockClientData *dataPtr = (ClockClientData *)clientData; Tcl_Obj **litPtr = dataPtr->literals; Tcl_Obj *results[3]; /* Format, locale and timezone */ #define formatObj results[0] #define localeObj results[1] #define timezoneObj results[2] @@ -1915,11 +1915,11 @@ timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - TclGetString(objv[i]), NULL); + Tcl_GetString(objv[i]), NULL); return TCL_ERROR; } switch (optionIndex) { case CLOCK_FORMAT_FORMAT: formatObj = objv[i+1]; @@ -1986,11 +1986,11 @@ *---------------------------------------------------------------------- */ int ClockSecondsObjCmd( - ClientData clientData, /* Client data is unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; @@ -2022,27 +2022,27 @@ */ static void TzsetIfNecessary(void) { - static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by + static char* tzWas = (char *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ const char *tzIsNow; /* Current value of TZ */ Tcl_MutexLock(&clockMutex); tzIsNow = getenv("TZ"); if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1) || strcmp(tzIsNow, tzWas) != 0)) { tzset(); if (tzWas != NULL && tzWas != INT2PTR(-1)) { - Tcl_Free(tzWas); + ckfree(tzWas); } - tzWas = Tcl_Alloc(strlen(tzIsNow) + 1); + tzWas = (char *)ckalloc(strlen(tzIsNow) + 1); strcpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); - if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas); + if (tzWas != INT2PTR(-1)) ckfree(tzWas); tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); } @@ -2062,19 +2062,19 @@ static void ClockDeleteCmdProc( ClientData clientData) /* Opaque pointer to the client data */ { - ClockClientData *data = clientData; + ClockClientData *data = (ClockClientData *)clientData; int i; if (data->refCount-- <= 1) { for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } - Tcl_Free(data->literals); - Tcl_Free(data); + ckfree(data->literals); + ckfree(data); } } /* * Local Variables: Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -13,11 +13,10 @@ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif -#include /* * The state structure used by [foreach]. Note that the actual structure has * all its working arrays appended afterwards so they can be allocated and * freed in a single step. @@ -44,25 +43,15 @@ * Prototypes for local procedures defined in this file: */ static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode); -static int EncodingConvertfromObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int EncodingConverttoObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int EncodingDirsObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int EncodingNamesObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int EncodingSystemObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc EncodingConvertfromObjCmd; +static Tcl_ObjCmdProc EncodingConverttoObjCmd; +static Tcl_ObjCmdProc EncodingDirsObjCmd; +static Tcl_ObjCmdProc EncodingNamesObjCmd; +static Tcl_ObjCmdProc EncodingSystemObjCmd; static inline int ForeachAssignments(Tcl_Interp *interp, struct ForeachState *statePtr); static inline void ForeachCleanup(Tcl_Interp *interp, struct ForeachState *statePtr); static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr, @@ -126,14 +115,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_BreakObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { @@ -141,10 +129,146 @@ return TCL_ERROR; } return TCL_BREAK; } +/* + *---------------------------------------------------------------------- + * + * Tcl_CaseObjCmd -- + * + * This procedure is invoked to process the "case" Tcl command. See the + * user documentation for details on what it does. THIS COMMAND IS + * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0. + * + * Results: + * A standard Tcl object result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +int +Tcl_CaseObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i; + int body, result, caseObjc; + const char *stringPtr, *arg; + Tcl_Obj *const *caseObjv; + Tcl_Obj *armPtr; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, + "string ?in? ?pattern body ...? ?default body?"); + return TCL_ERROR; + } + + stringPtr = TclGetString(objv[1]); + body = -1; + + arg = TclGetString(objv[2]); + if (strcmp(arg, "in") == 0) { + i = 3; + } else { + i = 2; + } + caseObjc = objc - i; + caseObjv = objv + i; + + /* + * If all of the pattern/command pairs are lumped into a single argument, + * split them out again. + */ + + if (caseObjc == 1) { + Tcl_Obj **newObjv; + + TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv); + caseObjv = newObjv; + } + + for (i = 0; i < caseObjc; i += 2) { + int patObjc, j; + const char **patObjv; + const char *pat, *p; + + if (i == caseObjc-1) { + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra case pattern with no body", -1)); + return TCL_ERROR; + } + + /* + * Check for special case of single pattern (no list) with no + * backslash sequences. + */ + + pat = TclGetString(caseObjv[i]); + for (p = pat; *p != '\0'; p++) { + if (TclIsSpaceProcM(*p) || (*p == '\\')) { + break; + } + } + if (*p == '\0') { + if ((*pat == 'd') && (strcmp(pat, "default") == 0)) { + body = i + 1; + } + if (Tcl_StringMatch(stringPtr, pat)) { + body = i + 1; + goto match; + } + continue; + } + + /* + * Break up pattern lists, then check each of the patterns in the + * list. + */ + + result = Tcl_SplitList(interp, pat, &patObjc, &patObjv); + if (result != TCL_OK) { + return result; + } + for (j = 0; j < patObjc; j++) { + if (Tcl_StringMatch(stringPtr, patObjv[j])) { + body = i + 1; + break; + } + } + ckfree(patObjv); + if (j < patObjc) { + break; + } + } + + match: + if (body != -1) { + armPtr = caseObjv[body - 1]; + result = Tcl_EvalObjEx(interp, caseObjv[body], 0); + if (result == TCL_ERROR) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"%.50s\" arm line %d)", + TclGetString(armPtr), Tcl_GetErrorLine(interp))); + } + return result; + } + + /* + * Nothing matched: return nothing. + */ + + return TCL_OK; +} +#endif /* !TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_CatchObjCmd -- * @@ -158,24 +282,23 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_CatchObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, clientData, objc, objv); } int TclNRCatchObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varNamePtr = NULL; @@ -211,12 +334,12 @@ Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); - Tcl_Obj *varNamePtr = data[1]; - Tcl_Obj *optionVarNamePtr = data[2]; + Tcl_Obj *varNamePtr = (Tcl_Obj *)data[1]; + Tcl_Obj *optionVarNamePtr = (Tcl_Obj *)data[2]; int rewind = iPtr->execEnvPtr->rewind; /* * We disable catch in interpreters where the limit has been exceeded. */ @@ -264,14 +387,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_CdObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *dir; @@ -320,14 +442,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ConcatObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc >= 2) { @@ -355,14 +476,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ContinueObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { @@ -418,19 +538,19 @@ *---------------------------------------------------------------------- */ int EncodingConvertfromObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - size_t length = 0; /* Length of the byte array being converted */ + int length; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ if (objc == 2) { encoding = Tcl_GetEncoding(interp, NULL); data = objv[1]; @@ -445,11 +565,11 @@ } /* * Convert the string into a byte array in 'ds' */ - bytesPtr = (char *) TclGetByteArrayFromObj(data, &length); + bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds); /* * Note that we cannot use Tcl_DStringResult here because it will * truncate the string at the first null byte. @@ -480,19 +600,19 @@ *---------------------------------------------------------------------- */ int EncodingConverttoObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ - size_t length; /* Length of the string being converted */ + int length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */ if (objc == 2) { @@ -544,11 +664,11 @@ *---------------------------------------------------------------------- */ int EncodingDirsObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *dirListObj; @@ -587,14 +707,15 @@ * *----------------------------------------------------------------------------- */ int -EncodingNamesObjCmd(ClientData dummy, /* Unused */ - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Number of command line args */ - Tcl_Obj* const objv[]) /* Vector of command line args */ +EncodingNamesObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj* const objv[]) /* Vector of command line args */ { if (objc > 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } @@ -617,14 +738,15 @@ * *----------------------------------------------------------------------------- */ int -EncodingSystemObjCmd(ClientData dummy, /* Unused */ - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Number of command line args */ - Tcl_Obj* const objv[]) /* Vector of command line args */ +EncodingSystemObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj* const objv[]) /* Vector of command line args */ { if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?encoding?"); return TCL_ERROR; } @@ -652,14 +774,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ErrorObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options, *optName; @@ -702,14 +823,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int EvalCmdErrMsg( - ClientData data[], + TCL_UNUSED(ClientData *), Tcl_Interp *interp, int result) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -718,26 +838,26 @@ return result; } int Tcl_EvalObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, clientData, objc, objv); } int TclNREvalObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; if (objc < 2) { @@ -785,14 +905,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ExitObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt value; @@ -806,11 +925,10 @@ value = 0; } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) { return TCL_ERROR; } Tcl_Exit((int)value); - /*NOTREACHED*/ return TCL_OK; /* Better not ever reach this! */ } /* *---------------------------------------------------------------------- @@ -834,24 +952,23 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ExprObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, clientData, objc, objv); } int TclNRExprObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr, *objPtr; @@ -878,12 +995,12 @@ ExprCallback( ClientData data[], Tcl_Interp *interp, int result) { - Tcl_Obj *resultPtr = data[0]; - Tcl_Obj *objPtr = data[1]; + Tcl_Obj *resultPtr = (Tcl_Obj *)data[0]; + Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; if (objPtr != NULL) { Tcl_DecrRefCount(objPtr); } @@ -983,11 +1100,11 @@ *---------------------------------------------------------------------- */ static int FileAttrAccessTimeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1000,11 +1117,11 @@ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the access time not available */ - if (buf.st_atime == 0) { + if (Tcl_GetAccessTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not get access time for file \"%s\"", TclGetString(objv[1]))); return TCL_ERROR; } @@ -1021,11 +1138,11 @@ if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) { return TCL_ERROR; } tval.actime = newTime; - tval.modtime = buf.st_mtime; + tval.modtime = Tcl_GetModificationTimeFromStat(&buf); if (Tcl_FSUtime(objv[1], &tval) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set access time for file \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); @@ -1041,11 +1158,11 @@ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((long) buf.st_atime)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(&buf))); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1065,11 +1182,11 @@ *---------------------------------------------------------------------- */ static int FileAttrModifyTimeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1082,11 +1199,11 @@ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the modification time not available */ - if (buf.st_mtime == 0) { + if (Tcl_GetModificationTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not get modification time for file \"%s\"", TclGetString(objv[1]))); return TCL_ERROR; } @@ -1101,11 +1218,11 @@ if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) { return TCL_ERROR; } - tval.actime = buf.st_atime; + tval.actime = Tcl_GetAccessTimeFromStat(&buf); tval.modtime = newTime; if (Tcl_FSUtime(objv[1], &tval) != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set modification time for file \"%s\": %s", @@ -1121,11 +1238,11 @@ if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((long) buf.st_mtime)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(&buf))); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1144,11 +1261,11 @@ *---------------------------------------------------------------------- */ static int FileAttrLinkStatCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1180,11 +1297,11 @@ *---------------------------------------------------------------------- */ static int FileAttrStatCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1216,11 +1333,11 @@ *---------------------------------------------------------------------- */ static int FileAttrTypeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1254,11 +1371,11 @@ *---------------------------------------------------------------------- */ static int FileAttrSizeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1291,11 +1408,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsDirectoryCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1329,11 +1446,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsExecutableCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { @@ -1360,11 +1477,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsExistingCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { @@ -1391,11 +1508,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsFileCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_StatBuf buf; @@ -1429,11 +1546,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsOwnedCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { #ifdef __CYGWIN__ @@ -1476,11 +1593,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsReadableCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { @@ -1507,11 +1624,11 @@ *---------------------------------------------------------------------- */ static int FileAttrIsWritableCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 2) { @@ -1538,11 +1655,11 @@ *---------------------------------------------------------------------- */ static int PathDirNameCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; @@ -1577,11 +1694,11 @@ *---------------------------------------------------------------------- */ static int PathExtensionCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; @@ -1616,11 +1733,11 @@ *---------------------------------------------------------------------- */ static int PathRootNameCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; @@ -1655,11 +1772,11 @@ *---------------------------------------------------------------------- */ static int PathTailCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirPtr; @@ -1694,11 +1811,11 @@ *---------------------------------------------------------------------- */ static int PathFilesystemCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *fsInfo; @@ -1709,11 +1826,11 @@ } fsInfo = Tcl_FSFileSystemInfo(objv[1]); if (fsInfo == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", - TclGetString(objv[1]), NULL); + Tcl_GetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, fsInfo); return TCL_OK; } @@ -1735,11 +1852,11 @@ *---------------------------------------------------------------------- */ static int PathJoinCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc < 2) { @@ -1767,11 +1884,11 @@ *---------------------------------------------------------------------- */ static int PathNativeNameCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_DString ds; @@ -1804,11 +1921,11 @@ *---------------------------------------------------------------------- */ static int PathNormalizeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *fileName; @@ -1842,11 +1959,11 @@ *---------------------------------------------------------------------- */ static int PathSplitCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *res; @@ -1885,11 +2002,11 @@ *---------------------------------------------------------------------- */ static int PathTypeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *typeName; @@ -1933,21 +2050,21 @@ *---------------------------------------------------------------------- */ static int FilesystemSeparatorCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc < 1 || objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } if (objc == 1) { - const char *separator = NULL; /* lint */ + const char *separator = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separator = "/"; break; @@ -1961,11 +2078,11 @@ if (separatorObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", - TclGetString(objv[1]), NULL); + Tcl_GetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, separatorObj); } return TCL_OK; @@ -1988,11 +2105,11 @@ *---------------------------------------------------------------------- */ static int FilesystemVolumesCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc != 1) { @@ -2115,11 +2232,11 @@ * to store stat results. */ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field, *value; - register unsigned short mode; + unsigned short mode; /* * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! * * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want @@ -2152,13 +2269,13 @@ STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); #endif #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif - STORE_ARY("atime", Tcl_NewWideIntObj((long)statPtr->st_atime)); - STORE_ARY("mtime", Tcl_NewWideIntObj((long)statPtr->st_mtime)); - STORE_ARY("ctime", Tcl_NewWideIntObj((long)statPtr->st_ctime)); + STORE_ARY("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); + STORE_ARY("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); + STORE_ARY("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; STORE_ARY("mode", Tcl_NewWideIntObj(mode)); STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); #undef STORE_ARY @@ -2246,24 +2363,23 @@ * |____________________| * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ForObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRForObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRForObjCmd, clientData, objc, objv); } int TclNRForObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -2294,11 +2410,11 @@ ForSetupCallback( ClientData data[], Tcl_Interp *interp, int result) { - ForIterData *iterPtr = data[0]; + ForIterData *iterPtr = (ForIterData *)data[0]; if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)"); } @@ -2313,11 +2429,11 @@ TclNRForIterCallback( ClientData data[], Tcl_Interp *interp, int result) { - ForIterData *iterPtr = data[0]; + ForIterData *iterPtr = (ForIterData *)data[0]; Tcl_Obj *boolObj; switch (result) { case TCL_OK: case TCL_CONTINUE: @@ -2349,12 +2465,12 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - ForIterData *iterPtr = data[0]; - Tcl_Obj *boolObj = data[1]; + ForIterData *iterPtr = (ForIterData *)data[0]; + Tcl_Obj *boolObj = (Tcl_Obj *)data[1]; int value; if (result != TCL_OK) { Tcl_DecrRefCount(boolObj); TclSmallFreeEx(interp, iterPtr); @@ -2387,11 +2503,11 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - ForIterData *iterPtr = data[0]; + ForIterData *iterPtr = (ForIterData *)data[0]; Tcl_Obj *next = iterPtr->next; if ((result == TCL_OK) || (result == TCL_CONTINUE)) { TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL, NULL); @@ -2411,11 +2527,11 @@ ForPostNextCallback( ClientData data[], Tcl_Interp *interp, int result) { - ForIterData *iterPtr = data[0]; + ForIterData *iterPtr = (ForIterData *)data[0]; if ((result != TCL_BREAK) && (result != TCL_OK)) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)"); TclSmallFreeEx(interp, iterPtr); @@ -2441,44 +2557,43 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ForeachObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRForeachCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRForeachCmd, clientData, objc, objv); } int TclNRForeachCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv); } int Tcl_LmapObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRLmapCmd, clientData, objc, objv); } int TclNRLmapCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv); @@ -2492,11 +2607,11 @@ * (TCL_EACH_*) */ int objc, /* The arguments being passed in... */ Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; - register struct ForeachState *statePtr; + struct ForeachState *statePtr; int i, j, result; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, "varList list ?varList list ...? command"); @@ -2516,11 +2631,11 @@ * The setting up of all of these pointers is moderately messy, but allows * the rest of this code to be simple and for us to use a single memory * allocation for better performance. */ - statePtr = TclStackAlloc(interp, + statePtr = (struct ForeachState *)TclStackAlloc(interp, sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); @@ -2617,11 +2732,11 @@ ForeachLoopStep( ClientData data[], Tcl_Interp *interp, int result) { - register struct ForeachState *statePtr = data[0]; + struct ForeachState *statePtr = (struct ForeachState *)data[0]; /* * Process the result code from this run of the [foreach] body. Note that * this switch uses fallthroughs in several places. Maintainer aware! */ @@ -2759,14 +2874,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_FormatObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr; /* Where result is stored finally. */ Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -33,11 +33,11 @@ double doubleValue; Tcl_Obj *objValuePtr; } collationKey; union { /* Object being sorted, or its index. */ Tcl_Obj *objPtr; - size_t index; + int index; } payload; struct SortElement *nextPtr;/* Next element in the list, or NULL for end * of list. */ } SortElement; @@ -97,53 +97,32 @@ * Forward declarations for procedures defined in this file: */ static int DictionaryCompare(const char *left, const char *right); static Tcl_NRPostProc IfConditionCallback; -static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc InfoArgsCmd; +static Tcl_ObjCmdProc InfoBodyCmd; +static Tcl_ObjCmdProc InfoCmdCountCmd; +static Tcl_ObjCmdProc InfoCommandsCmd; +static Tcl_ObjCmdProc InfoCompleteCmd; +static Tcl_ObjCmdProc InfoDefaultCmd; /* TIP #348 - New 'info' subcommand 'errorstack' */ -static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc InfoErrorStackCmd; /* TIP #280 - New 'info' subcommand 'frame' */ -static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoNameOfExecutableCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc InfoFrameCmd; +static Tcl_ObjCmdProc InfoFunctionsCmd; +static Tcl_ObjCmdProc InfoHostnameCmd; +static Tcl_ObjCmdProc InfoLevelCmd; +static Tcl_ObjCmdProc InfoLibraryCmd; +static Tcl_ObjCmdProc InfoLoadedCmd; +static Tcl_ObjCmdProc InfoNameOfExecutableCmd; +static Tcl_ObjCmdProc InfoPatchLevelCmd; +static Tcl_ObjCmdProc InfoProcsCmd; +static Tcl_ObjCmdProc InfoScriptCmd; +static Tcl_ObjCmdProc InfoSharedlibCmd; +static Tcl_ObjCmdProc InfoCmdTypeCmd; +static Tcl_ObjCmdProc InfoTclVersionCmd; static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr); static int SortCompare(SortElement *firstPtr, SortElement *second, SortInfo *infoPtr); static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, @@ -204,21 +183,21 @@ *---------------------------------------------------------------------- */ int Tcl_IfObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, clientData, objc, objv); } int TclNRIfObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *boolObj; @@ -249,13 +228,13 @@ Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); - Tcl_Obj *const *objv = data[1]; + Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1]; int i = PTR2INT(data[2]); - Tcl_Obj *boolObj = data[3]; + Tcl_Obj *boolObj = (Tcl_Obj *)data[3]; int value, thenScriptIndex = 0; const char *clause; if (result != TCL_OK) { TclDecrRefCount(boolObj); @@ -387,11 +366,11 @@ *---------------------------------------------------------------------- */ int Tcl_IncrObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *newValuePtr, *incrPtr; @@ -468,16 +447,16 @@ *---------------------------------------------------------------------- */ static int InfoArgsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; const char *name; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *listObjPtr; @@ -531,19 +510,19 @@ *---------------------------------------------------------------------- */ static int InfoBodyCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; - size_t numBytes; + int numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); return TCL_ERROR; } @@ -592,11 +571,11 @@ *---------------------------------------------------------------------- */ static int InfoCmdCountCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -634,26 +613,26 @@ *---------------------------------------------------------------------- */ static int InfoCommandsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; - size_t i; + int i; /* * Get the pattern and find the "effective namespace" in which to list * commands. */ @@ -709,15 +688,15 @@ */ entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { if (specificNsInPattern) { - cmd = Tcl_GetHashValue(entryPtr); + cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { - cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); Tcl_SetObjResult(interp, listPtr); return TCL_OK; @@ -740,11 +719,11 @@ if (entryPtr == NULL) { tablePtr = &globalNsPtr->cmdTable; entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); } if (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(tablePtr, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -756,15 +735,15 @@ * old matching scheme is perfect. */ entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { - cmd = Tcl_GetHashValue(entryPtr); + cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } @@ -782,11 +761,11 @@ */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); @@ -813,11 +792,11 @@ Tcl_InitObjHashTable(&addedCommandsTable); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); (void) Tcl_CreateHashEntry(&addedCommandsTable, @@ -839,11 +818,11 @@ if (pathNsPtr == globalNsPtr) { foundGlobal = 1; } entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); @@ -866,11 +845,11 @@ */ if (!foundGlobal) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); if (Tcl_FindHashEntry(&addedCommandsTable, (char *) elemObjPtr) == NULL) { @@ -911,11 +890,11 @@ *---------------------------------------------------------------------- */ static int InfoCompleteCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { @@ -948,11 +927,11 @@ *---------------------------------------------------------------------- */ static int InfoDefaultCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1030,11 +1009,11 @@ *---------------------------------------------------------------------- */ static int InfoErrorStackCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; @@ -1079,11 +1058,11 @@ *---------------------------------------------------------------------- */ int TclInfoExistsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *varName; @@ -1124,11 +1103,11 @@ *---------------------------------------------------------------------- */ static int InfoFrameCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1311,11 +1290,11 @@ case TCL_LOCATION_BC: { /* * Execution of bytecode. Talk to the BC engine to fill out the frame. */ - CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *fPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *fPtr = *framePtr; /* * Note: @@ -1393,12 +1372,12 @@ TclNewObj(procNameObj); Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, procNameObj); ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { - ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; - size_t i; + ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; + int i; /* * This is a non-standard command. Luckily, it's told us how to * render extra information about its frame. */ @@ -1407,11 +1386,11 @@ lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); if (efiPtr->fields[i].proc) { lv[lc++] = efiPtr->fields[i].proc(efiPtr->fields[i].clientData); } else { - lv[lc++] = efiPtr->fields[i].clientData; + lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData; } } } } @@ -1464,11 +1443,11 @@ *---------------------------------------------------------------------- */ static int InfoFunctionsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *script; @@ -1529,11 +1508,11 @@ *---------------------------------------------------------------------- */ static int InfoHostnameCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name; @@ -1575,11 +1554,11 @@ *---------------------------------------------------------------------- */ static int InfoLevelCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1649,11 +1628,11 @@ *---------------------------------------------------------------------- */ static int InfoLibraryCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *libDirName; @@ -1696,11 +1675,11 @@ *---------------------------------------------------------------------- */ static int InfoLoadedCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *interpName, *packageName; @@ -1744,11 +1723,11 @@ *---------------------------------------------------------------------- */ static int InfoNameOfExecutableCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { @@ -1780,11 +1759,11 @@ *---------------------------------------------------------------------- */ static int InfoPatchLevelCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *patchlevel; @@ -1827,11 +1806,11 @@ *---------------------------------------------------------------------- */ static int InfoProcsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; @@ -1841,11 +1820,11 @@ Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; /* * Get the pattern and find the "effective namespace" in which to list @@ -1893,11 +1872,11 @@ listPtr = Tcl_NewListObj(0, NULL); #ifndef INFO_PROCS_SEARCH_GLOBAL_NS if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { @@ -1918,14 +1897,14 @@ } else #endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */ { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { @@ -1956,23 +1935,23 @@ #ifdef INFO_PROCS_SEARCH_GLOBAL_NS /* * If "info procs" worked like "info commands", returning the commands * also seen in the global namespace, then you would include this - * code. As this could break backwards compatibilty with 8.0-8.2, we + * code. As this could break backwards compatibility with 8.0-8.2, we * decided not to "fix" it in 8.3, leaving the behavior slightly * different. */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { - cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); + cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { @@ -2014,16 +1993,17 @@ *---------------------------------------------------------------------- */ static int InfoScriptCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; + if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?filename?"); return TCL_ERROR; } @@ -2061,11 +2041,11 @@ *---------------------------------------------------------------------- */ static int InfoSharedlibCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { @@ -2099,11 +2079,11 @@ *---------------------------------------------------------------------- */ static int InfoTclVersionCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *version; @@ -2142,11 +2122,11 @@ *---------------------------------------------------------------------- */ static int InfoCmdTypeCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Command command; @@ -2193,17 +2173,16 @@ *---------------------------------------------------------------------- */ int Tcl_JoinObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - size_t length; - int listLen; + int length, listLen; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?"); return TCL_ERROR; @@ -2279,11 +2258,11 @@ *---------------------------------------------------------------------- */ int Tcl_LassignObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listCopyPtr; @@ -2353,16 +2332,15 @@ *---------------------------------------------------------------------- */ int Tcl_LindexObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *elemPtr; /* Pointer to the element being extracted. */ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?"); return TCL_ERROR; @@ -2412,18 +2390,17 @@ *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - size_t index; - int len, result; + int index, len, result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); return TCL_ERROR; } @@ -2441,11 +2418,11 @@ result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index); if (result != TCL_OK) { return result; } - if (index + 1 > (size_t)len + 1) { + if (index > len) { index = len; } /* * If the list object is unshared we can modify it directly. Otherwise we @@ -2455,11 +2432,11 @@ listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { listPtr = TclListObjCopy(NULL, listPtr); } - if ((objc == 4) && (index == (size_t)len)) { + if ((objc == 4) && (index == len)) { /* * Special case: insert one element at the end of the list. */ Tcl_ListObjAppendElement(NULL, listPtr, objv[3]); @@ -2495,14 +2472,14 @@ *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. * Otherwise set the interpreter's result object to be a list object. @@ -2531,14 +2508,14 @@ *---------------------------------------------------------------------- */ int Tcl_LlengthObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; if (objc != 2) { @@ -2577,14 +2554,14 @@ *---------------------------------------------------------------------- */ int Tcl_LpopObjCmd( - ClientData notUsed, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; @@ -2608,10 +2585,18 @@ * First, extract the element to be returned. * TclLindexFlat adds a ref count which is handled. */ if (objc == 2) { + if (!listLen) { + /* empty list, throw the same error as with index "end" */ + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "index \"end\" out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" + "OUTOFRANGE", NULL); + return TCL_ERROR; + } elemPtr = elemPtrs[listLen - 1]; Tcl_IncrRefCount(elemPtr); } else { elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2); @@ -2670,18 +2655,17 @@ *---------------------------------------------------------------------- */ int Tcl_LrangeObjCmd( - ClientData notUsed, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, result; - size_t first, last; + int listLen, first, last, result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; } @@ -2727,12 +2711,12 @@ static int LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { - size_t idx1 = *((const size_t *) el1Ptr); - size_t idx2 = *((const size_t *) el2Ptr); + int idx1 = *((const int *) el1Ptr); + int idx2 = *((const int *) el2Ptr); /* * This will put the larger element first. */ @@ -2739,17 +2723,17 @@ return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0; } int Tcl_LremoveObjCmd( - ClientData notUsed, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, idxc, listLen, prevIdx, first, num; - size_t *idxv; + int i, idxc; + int listLen, *idxv, prevIdx, first, num; Tcl_Obj *listObj; /* * Parse the arguments. */ @@ -2767,15 +2751,15 @@ idxc = objc - 2; if (idxc == 0) { Tcl_SetObjResult(interp, listObj); return TCL_OK; } - idxv = Tcl_Alloc((objc - 2) * sizeof(size_t)); + idxv = (int *)ckalloc((objc - 2) * sizeof(int)); for (i = 2; i < objc; i++) { if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, &idxv[i - 2]) != TCL_OK) { - Tcl_Free(idxv); + ckfree(idxv); return TCL_ERROR; } } /* @@ -2782,11 +2766,11 @@ * Sort the indices, large to small so that when we remove an index we * don't change the indices still to be processed. */ if (idxc > 1) { - qsort(idxv, idxc, sizeof(size_t), LremoveIndexCompare); + qsort(idxv, idxc, sizeof(int), LremoveIndexCompare); } /* * Make our working copy, then do the actual removes piecemeal. */ @@ -2834,11 +2818,11 @@ } } if (num != 0) { (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); } - Tcl_Free(idxv); + ckfree(idxv); Tcl_SetObjResult(interp, listObj); return TCL_OK; } /* @@ -2858,14 +2842,14 @@ *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - register int objc, /* Number of arguments. */ - register Tcl_Obj *const objv[]) + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { int elementCount, i, totalElems; Tcl_Obj *listPtr, **dataArray = NULL; @@ -2926,11 +2910,11 @@ * number of times. */ CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { - register Tcl_Obj *tmpPtr = objv[0]; + Tcl_Obj *tmpPtr = objv[0]; tmpPtr->refCount += elementCount; for (i=0 ; i (size_t)listLen) { + } + if (first > listLen) { first = listLen; } - if (last + 1 > (size_t)listLen) { + if (last >= listLen) { last = listLen - 1; } - if (first + 1 <= last + 1) { + if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0; } @@ -3068,11 +3052,11 @@ *---------------------------------------------------------------------- */ int Tcl_LreverseObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; @@ -3147,21 +3131,20 @@ *---------------------------------------------------------------------- */ int Tcl_LsearchObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; - int i, match, index, result=TCL_OK, listc, bisect; - size_t length = 0, elemLen, start, groupSize, groupOffset, lower, upper; + int i, match, index, result=TCL_OK, listc, length, elemLen, bisect; int allocatedIndexVector = 0; - int dataType, isIncreasing; - Tcl_WideInt patWide, objWide, wide; + int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset; + Tcl_WideInt patWide, objWide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr; SortStrCmpFn_t strCmpFn = TclUtfCmp; @@ -3313,23 +3296,22 @@ "followed by stride length", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } - if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { result = TCL_ERROR; goto done; } - if (wide < 1) { + if (groupSize < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stride length must be at least 1", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", NULL); result = TCL_ERROR; goto done; } - groupSize = wide; i++; break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; int j; @@ -3365,11 +3347,11 @@ break; case 1: sortInfo.indexv = &sortInfo.singleIndex; break; default: - sortInfo.indexv = + sortInfo.indexv = (int *) TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); allocatedIndexVector = 1; /* Cannot use indexc field, as it * might be decreased by 1 later. */ } @@ -3385,12 +3367,12 @@ TCL_INDEX_NONE, &encoded) != TCL_OK) { result = TCL_ERROR; } if (encoded == (int)TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%s\" cannot select an element " - "from any list", TclGetString(indices[j]))); + "index \"%s\" out of range", + TclGetString(indices[j]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { @@ -3485,11 +3467,11 @@ * Use the first value in the list supplied to -index as the * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); - if (groupOffset >= groupSize) { + if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADINDEX", NULL); @@ -3525,11 +3507,11 @@ /* * If the search started past the end of the list, we just return a * "did not match anything at all" result straight away. [Bug 1374778] */ - if (start >= (size_t)listc) { + if (start > listc-1) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1)); } @@ -3656,15 +3638,15 @@ } if (match == 0) { /* * Normally, binary search is written to stop when it finds a * match. If there are duplicates of an element in the list, - * our first match might not be the first occurance. + * our first match might not be the first occurrence. * Consider: 0 0 0 1 1 1 2 2 2 * * To maintain consistancy with standard lsearch semantics, we - * must find the leftmost occurance of the pattern in the + * must find the leftmost occurrence of the pattern in the * list. Thus we don't just stop searching here. This * variation means that a search always makes log n * comparisons (normal binary search might "get lucky" with an * early comparison). * @@ -3733,11 +3715,12 @@ */ if (noCase) { match = (TclUtfCasecmp(bytes, patternBytes) == 0); } else { - match = (memcmp(bytes, patternBytes, length) == 0); + match = (memcmp(bytes, patternBytes, + (size_t) length) == 0); } } break; case DICTIONARY: @@ -3817,13 +3800,13 @@ Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } } else if (returnSubindices) { int j; - itemPtr = TclNewWideIntObjFromSize(i+groupOffset); + itemPtr = Tcl_NewWideIntObj(i+groupOffset); for (j=0 ; j= groupSize) { + if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADINDEX", NULL); @@ -4322,11 +4304,23 @@ /* * The following loop creates a SortElement for each list element and * begins sorting it into the sublists as it appears. */ - elementArray = Tcl_Alloc(length * sizeof(SortElement)); + elmArrSize = length * sizeof(SortElement); + if (elmArrSize <= MAXCALLOC) { + elementArray = (SortElement *)ckalloc(elmArrSize); + } else { + elementArray = (SortElement *)malloc(elmArrSize); + } + if (!elementArray) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no enough memory to proccess sort of %d items", length)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done; + } for (i=0; i < length; i++) { idx = groupSize * i + groupOffset; if (indexc) { /* @@ -4418,11 +4412,11 @@ if (group) { for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) { idx = elementPtr->payload.index; for (j = 0; j < groupSize; j++) { if (indices) { - objPtr = TclNewWideIntObjFromSize(idx + j - groupOffset); + objPtr = Tcl_NewWideIntObj(idx + j - groupOffset); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } else { objPtr = listObjPtrs[idx + j - groupOffset]; newArray[i++] = objPtr; @@ -4430,11 +4424,11 @@ } } } } else if (indices) { for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { - objPtr = TclNewWideIntObjFromSize(elementPtr->payload.index); + objPtr = Tcl_NewWideIntObj(elementPtr->payload.index); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } } else { for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { @@ -4455,11 +4449,15 @@ } if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } if (elementArray) { - Tcl_Free(elementArray); + if (elmArrSize <= MAXCALLOC) { + ckfree((char *)elementArray); + } else { + free((char *)elementArray); + } } return sortInfo.resultCode; } /* @@ -4697,11 +4695,11 @@ static int DictionaryCompare( const char *left, const char *right) /* The strings to compare. */ { - Tcl_UniChar uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower; + int uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower; int diff, zeros; int secondaryDiff = 0; while (1) { if (isdigit(UCHAR(*right)) /* INTL: digit */ @@ -4766,12 +4764,12 @@ * string is at the terminating null, do a byte-wise comparison and * bail out immediately. */ if ((*left != '\0') && (*right != '\0')) { - left += TclUtfToUniChar(left, &uniLeft); - right += TclUtfToUniChar(right, &uniRight); + left += TclUtfToUCS4(left, &uniLeft); + right += TclUtfToUCS4(right, &uniRight); /* * Convert both chars to lower for the comparison, because * dictionary sorts are case insensitve. Covert to lower, not * upper, so chars between Z and a will sort before A (where most Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -80,11 +80,11 @@ *---------------------------------------------------------------------- */ int Tcl_PwdObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *retVal; @@ -120,17 +120,17 @@ *---------------------------------------------------------------------- */ int Tcl_RegexpObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t offset, stringLength, matchLength, cflags, eflags; - int i, indices, match, about, all, doinline, numMatchesSaved; + int i, indices, match, about, offset, all, doinline, numMatchesSaved; + int cflags, eflags, stringLength, matchLength; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static const char *const options[] = { "-all", "-about", "-indices", "-inline", @@ -144,11 +144,11 @@ }; indices = 0; about = 0; cflags = TCL_REG_ADVANCED; - offset = TCL_INDEX_START; + offset = 0; all = 0; doinline = 0; for (i = 1; i < objc; i++) { const char *name; @@ -189,15 +189,15 @@ break; case REGEXP_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGEXP_START: { - size_t temp; + int temp; if (++i >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[i], TCL_INDEX_START, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -259,12 +259,12 @@ stringLength = Tcl_GetCharLength(objPtr); if (startIndex) { TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); - if (offset == TCL_INDEX_NONE) { - offset = TCL_INDEX_START; + if (offset < 0) { + offset = 0; } } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { @@ -304,13 +304,13 @@ * considered the start of the line. If for example the pattern {^} is * passed and -start is positive, then the pattern will not match the * start of the string unless the previous character is a newline. */ - if (offset == TCL_INDEX_START) { + if (offset == 0) { eflags = 0; - } else if (offset + 1 > stringLength + 1) { + } else if (offset > stringLength) { eflags = TCL_REG_NOTBOL; } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; @@ -362,41 +362,41 @@ } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { - size_t start, end; + int start, end; Tcl_Obj *objs[2]; /* * Only adjust the match area if there was a match for that * area. (Scriptics Bug 4391/SF Bug #219232) */ - if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) { + if (i <= info.nsubs && info.matches[i].start >= 0) { start = offset + info.matches[i].start; end = offset + info.matches[i].end; /* * Adjust index so it refers to the last character in the * match instead of the first character after the match. */ - if (end + 1 >= offset + 1) { + if (end >= offset) { end--; } } else { - start = TCL_INDEX_NONE; - end = TCL_INDEX_NONE; + start = -1; + end = -1; } - objs[0] = TclNewWideIntObjFromSize(start); - objs[1] = TclNewWideIntObjFromSize(end); + objs[0] = Tcl_NewWideIntObj(start); + objs[1] = Tcl_NewWideIntObj(end); newPtr = Tcl_NewListObj(2, objs); } else { - if (i <= (int)info.nsubs) { + if (i <= info.nsubs) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); } else { newPtr = Tcl_NewObj(); @@ -442,11 +442,11 @@ if (matchLength == 0) { offset++; } all++; - if (offset + 1 >= stringLength + 1) { + if (offset >= stringLength) { break; } } /* @@ -480,18 +480,17 @@ *---------------------------------------------------------------------- */ int Tcl_RegsubObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int result, cflags, all, match, command, numParts; - size_t idx, wlen, wsublen = 0, offset, numMatches; - size_t start, end, subStart, subEnd; + int idx, result, cflags, all, wlen, wsublen, numMatches, offset; + int start, end, subStart, subEnd, match, command, numParts; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend; @@ -506,15 +505,15 @@ REGSUB_LAST }; cflags = TCL_REG_ADVANCED; all = 0; - offset = TCL_INDEX_START; + offset = 0; command = 0; resultPtr = NULL; - for (idx = 1; idx < (size_t)objc; idx++) { + for (idx = 1; idx < objc; idx++) { const char *name; int index; name = TclGetString(objv[idx]); if (name[0] != '-') { @@ -545,15 +544,15 @@ break; case REGSUB_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { - size_t temp; - if (++idx >= (size_t)objc) { + int temp; + if (++idx >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[idx], TCL_INDEX_START, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -566,11 +565,11 @@ goto endOfForLoop; } } endOfForLoop: - if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) { + if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string subSpec ?varName?"); optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); @@ -580,39 +579,38 @@ objc -= idx; objv += idx; if (startIndex) { - size_t stringLength = Tcl_GetCharLength(objv[1]); + int stringLength = Tcl_GetCharLength(objv[1]); TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); - if (offset == TCL_INDEX_NONE) { - offset = TCL_INDEX_START; + if (offset < 0) { + offset = 0; } } - if (all && (offset == TCL_INDEX_START) && (command == 0) + if (all && (offset == 0) && (command == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { /* * This is a simple one pair string map situation. We make use of a * slightly modified version of the one pair STR_MAP code. */ - size_t slen; - int nocase, wsrclc; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); + int slen, nocase, wsrclc; + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; - wsrc = TclGetUnicodeFromObj(objv[0], &slen); - wstring = TclGetUnicodeFromObj(objv[1], &wlen); - wsubspec = TclGetUnicodeFromObj(objv[2], &wsublen); + wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); + wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); + wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; if (slen == 0) { /* @@ -633,11 +631,12 @@ } else { wsrclc = Tcl_UniCharToLower(*wsrc); for (p = wfirstChar = wstring; wstring < wend; wstring++) { if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && - (slen==1 || (strCmpFn(wstring, wsrc, slen) == 0))) { + (slen==1 || (strCmpFn(wstring, wsrc, + (unsigned long) slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); } if (p != wstring) { @@ -698,18 +697,18 @@ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } - wstring = TclGetUnicodeFromObj(objPtr, &wlen); + wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } if (!command) { - wsubspec = TclGetUnicodeFromObj(subPtr, &wsublen); + wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); } result = TCL_OK; /* @@ -743,11 +742,11 @@ break; } if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); - if (offset > TCL_INDEX_START) { + if (offset > 0) { /* * Copy the initial portion of the string in if an offset was * specified. */ @@ -777,11 +776,11 @@ Tcl_Obj **args = NULL, **parts; int numArgs; Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; - args = Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs); + args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs); memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); for (idx = 0 ; idx <= info.nsubs ; idx++) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; @@ -807,11 +806,11 @@ result = Tcl_EvalObjv(interp, numArgs, args, 0); for (idx = 0 ; idx <= info.nsubs ; idx++) { TclDecrRefCount(args[idx + numParts]); } - Tcl_Free(args); + ckfree(args); if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s substitution computation script)", options[REGSUB_COMMAND])); @@ -825,11 +824,11 @@ /* * Refetch the unicode, in case the representation was smashed by * the user code. */ - wstring = TclGetUnicodeFromObj(objPtr, &wlen); + wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); offset += end; if (end == 0 || start == end) { /* * Always consume at least one character of the input string @@ -1001,11 +1000,11 @@ *---------------------------------------------------------------------- */ int Tcl_RenameObjCmd( - ClientData dummy, /* Arbitrary value passed to the command. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *oldName, *newName; @@ -1037,11 +1036,11 @@ *---------------------------------------------------------------------- */ int Tcl_ReturnObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int code, level; @@ -1084,21 +1083,21 @@ *---------------------------------------------------------------------- */ int Tcl_SourceObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRSourceObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRSourceObjCmd, clientData, objc, objv); } int TclNRSourceObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *encodingName = NULL; @@ -1135,11 +1134,11 @@ if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions, "option", TCL_EXACT, &index)) { return TCL_ERROR; } - pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + pkgFiles = (void **)Tcl_GetAssocData(interp, "tclPkgFiles", NULL); /* Make sure that during the following TclNREvalFile no filenames * are recorded for inclusion in the "package files" command */ names = *pkgFiles; *pkgFiles = NULL; } @@ -1168,21 +1167,21 @@ *---------------------------------------------------------------------- */ int Tcl_SplitObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_UniChar ch = 0; + int ch = 0; int len; const char *splitChars; const char *stringPtr; const char *end; - size_t splitCharLen, stringLen; + int splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { splitChars = " \n\t\r"; splitCharLen = 4; @@ -1216,74 +1215,59 @@ */ Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { - int fullchar; - len = TclUtfToUniChar(stringPtr, &ch); - fullchar = ch; - -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(stringPtr + len, &ch); - fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif - - /* - * Assume Tcl_UniChar is an integral type... - */ - - hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(fullchar), - &isNew); + len = TclUtfToUCS4(stringPtr, &ch); + hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew); if (isNew) { TclNewStringObj(objPtr, stringPtr, len); /* * Don't need to fiddle with refcount... */ Tcl_SetHashValue(hPtr, objPtr); } else { - objPtr = Tcl_GetHashValue(hPtr); + objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); } Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } Tcl_DeleteHashTable(&charReuseTable); } else if (splitCharLen == 1) { - char *p; + const char *p; /* * Handle the special case of splitting on a single character. This is * only true for the one-char ASCII case, as one unicode char is > 1 * byte in length. */ - while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) { + while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) { objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; - size_t splitLen; - Tcl_UniChar splitChar = 0; + int splitLen; + int splitChar; /* * Normal case: split on any of a given set of characters. Discard * instances of the split characters. */ splitEnd = splitChars + splitCharLen; for (element = stringPtr; stringPtr < end; stringPtr += len) { - len = TclUtfToUniChar(stringPtr, &ch); + len = TclUtfToUCS4(stringPtr, &ch); for (p = splitChars; p < splitEnd; p += splitLen) { - splitLen = TclUtfToUniChar(p, &splitChar); + splitLen = TclUtfToUCS4(p, &splitChar); if (ch == splitChar) { TclNewStringObj(objPtr, element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); element = stringPtr + len; break; @@ -1316,32 +1300,31 @@ *---------------------------------------------------------------------- */ static int StringFirstCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t start = TCL_INDEX_START; + int start = 0; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "needleString haystackString ?startIndex?"); return TCL_ERROR; } if (objc == 4) { - size_t end = Tcl_GetCharLength(objv[2]) - 1; + int size = Tcl_GetCharLength(objv[2]); - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) { + if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(TclStringFirst(objv[1], - objv[2], start))); + Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start)); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1361,32 +1344,31 @@ *---------------------------------------------------------------------- */ static int StringLastCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t last = TCL_INDEX_END; + int last = INT_MAX - 1; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "needleString haystackString ?lastIndex?"); return TCL_ERROR; } if (objc == 4) { - size_t end = Tcl_GetCharLength(objv[2]) - 1; + int size = Tcl_GetCharLength(objv[2]); - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) { + if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(TclStringLast(objv[1], - objv[2], last))); + Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last)); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1406,16 +1388,16 @@ *---------------------------------------------------------------------- */ static int StringIndexCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t index, end; + int length, index; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string charIndex"); return TCL_ERROR; } @@ -1422,16 +1404,16 @@ /* * Get the char length to calculate what 'end' means. */ - end = Tcl_GetCharLength(objv[1]) - 1; - if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) { + length = Tcl_GetCharLength(objv[1]); + if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } - if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) { + if ((index >= 0) && (index < length)) { int ch = Tcl_GetUniChar(objv[1], index); if (ch == -1) { return TCL_OK; } @@ -1440,21 +1422,21 @@ * If we have a ByteArray object, we're careful to generate a new * bytearray for a result. */ if (TclIsPureByteArray(objv[1])) { - unsigned char uch = (unsigned char) ch; + unsigned char uch = UCHAR(ch); Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1)); } else { char buf[4] = ""; - end = Tcl_UniCharToUtf(ch, buf); - if ((ch >= 0xD800) && (end < 3)) { - end += Tcl_UniCharToUtf(-1, buf + end); + length = Tcl_UniCharToUtf(ch, buf); + if ((ch >= 0xD800) && (length < 3)) { + length += Tcl_UniCharToUtf(-1, buf + length); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length)); } } return TCL_OK; } @@ -1476,17 +1458,17 @@ *---------------------------------------------------------------------- */ static int StringInsertCmd( - ClientData dummy, /* Not used */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { - size_t length; /* String length */ - size_t index; /* Insert index */ + int length; /* String length */ + int index; /* Insert index */ Tcl_Obj *outObj; /* Output object */ if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string index insertString"); return TCL_ERROR; @@ -1495,12 +1477,12 @@ length = Tcl_GetCharLength(objv[1]); if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) { return TCL_ERROR; } - if (index == TCL_INDEX_NONE) { - index = TCL_INDEX_START; + if (index < 0) { + index = 0; } if (index > length) { index = length; } @@ -1533,21 +1515,18 @@ *---------------------------------------------------------------------- */ static int StringIsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *end, *stop; - Tcl_UniChar ch = 0; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ - int i, result = 1, strict = 0, index, length3; - size_t failat = 0; - size_t length1, length2; + int i, failat = 0, result = 1, strict = 0, index, length1, length2; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", @@ -1638,13 +1617,15 @@ result = 0; } else { string1 = TclGetStringFromObj(objPtr, &length1); result = length1 == 0; } - } else if ((objPtr->internalRep.wideValue != 0) - ? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) { - result = 0; + } else if (index != STR_IS_BOOL) { + TclGetBooleanFromObj(NULL, objPtr, &i); + if ((index == STR_IS_TRUE) ^ i) { + result = 0; + } } break; case STR_IS_CONTROL: chcomp = Tcl_UniCharIsControl; break; @@ -1660,13 +1641,12 @@ * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; - int lenRemain; - size_t elemSize; - register const char *p; + int lenRemain, elemSize; + const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; @@ -1829,11 +1809,11 @@ /* * We ignore the strictness here, since empty strings are always * well-formed lists. */ - if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) { + if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) { break; } if (failVarObj != NULL) { /* @@ -1841,13 +1821,12 @@ * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; - size_t lenRemain; - size_t elemSize; - register const char *p; + int lenRemain, elemSize; + const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; @@ -1864,11 +1843,11 @@ * * Skip leading spaces first. This is only really an issue * if it is the first "element" that has the failure. */ - while (TclIsSpaceProc(*p)) { + while (TclIsSpaceProcM(*p)) { p++; } TclNewStringObj(tmpStr, string1, p-string1); failat = Tcl_GetCharLength(tmpStr); TclDecrRefCount(tmpStr); @@ -1909,20 +1888,14 @@ } goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { - int fullchar; - length2 = TclUtfToUniChar(string1, &ch); - fullchar = ch; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (length2 < 3)) { - length2 += TclUtfToUniChar(string1 + length2, &ch); - fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif - if (!chcomp(fullchar)) { + int ucs4; + + length2 = TclUtfToUCS4(string1, &ucs4); + if (!chcomp(ucs4)) { result = 0; break; } } } @@ -1932,11 +1905,11 @@ * valid fail index (>= 0). */ str_is_done: if ((result == 0) && (failVarObj != NULL) && - Tcl_ObjSetVar2(interp, failVarObj, NULL, TclNewWideIntObjFromSize(failat), + Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -1974,20 +1947,20 @@ *---------------------------------------------------------------------- */ static int StringMapCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2, mapElemc, index; + int length1, length2, mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); return TCL_ERROR; } @@ -2020,42 +1993,40 @@ /* * We know the type exactly, so all dict operations will succeed for * sure. This shortens this code quite a bit. */ - Tcl_DictObjSize(interp, objv[objc-2], &i); - if (i == 0) { + Tcl_DictObjSize(interp, objv[objc-2], &mapElemc); + if (mapElemc == 0) { /* * Empty charMap, just return whatever string was given. */ Tcl_SetObjResult(interp, objv[objc-1]); return TCL_OK; } - mapElemc = 2 * i; + mapElemc *= 2; mapWithDict = 1; /* * Copy the dictionary out into an array; that's the easiest way to * adapt this code... */ - mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc); + mapElemv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc); Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); - for (index=2 ; index30% faster on * larger strings. */ - size_t mapLen; - int u2lc; + int mapLen, u2lc; Tcl_UniChar *mapString; - ustring2 = TclGetUnicodeFromObj(mapElemv[0], &length2); + ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* * Match string is either longer than input or empty. */ ustring1 = end; } else { - mapString = TclGetUnicodeFromObj(mapElemv[1], &mapLen); + mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - length2) == 0)) { + (unsigned long) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2143,27 +2113,26 @@ } } } } else { Tcl_UniChar **mapStrings; - size_t *mapLens; - int *u2lc = 0; + int *mapLens, *u2lc = NULL; /* * Precompute pointers to the unicode string and length. This saves us * repeated function calls later, significantly speeding up the * algorithm. We only need the lowercase first char in the nocase * case. */ - mapStrings = TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); - mapLens = TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2); + mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *)); + mapLens = (int *)TclStackAlloc(interp, mapElemc * 2 * sizeof(int)); if (nocase) { - u2lc = TclStackAlloc(interp, mapElemc * sizeof(int)); + u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { - mapStrings[index] = TclGetUnicodeFromObj(mapElemv[index], + mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); } } @@ -2176,11 +2145,11 @@ ustring2 = mapStrings[index]; length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ - ((size_t)(end-ustring1) >= length2) && ((length2 == 1) || + (end-ustring1 >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ @@ -2249,11 +2218,11 @@ *---------------------------------------------------------------------- */ static int StringMatchCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int nocase = 0; @@ -2262,11 +2231,11 @@ Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string"); return TCL_ERROR; } if (objc == 4) { - size_t length; + int length; const char *string = TclGetStringFromObj(objv[1], &length); if ((length > 1) && strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; @@ -2301,16 +2270,16 @@ *---------------------------------------------------------------------- */ static int StringRangeCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t first, last, end; + int length, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string first last"); return TCL_ERROR; } @@ -2318,24 +2287,24 @@ /* * Get the length in actual characters; Then reduce it by one because * 'end' refers to the last character, not one past it. */ - end = Tcl_GetCharLength(objv[1]) - 1; + length = Tcl_GetCharLength(objv[1]) - 1; - if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || - TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK || + TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; + if (first < 0) { + first = 0; } - if (last + 1 >= end + 1) { - last = end; + if (last >= length) { + last = length; } - if (last + 1 >= first + 1) { + if (last >= first) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; } @@ -2357,11 +2326,11 @@ *---------------------------------------------------------------------- */ static int StringReptCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int count; @@ -2413,23 +2382,24 @@ *---------------------------------------------------------------------- */ static int StringRplcCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t first, last, end; + int first, last, length, end; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?"); return TCL_ERROR; } - end = Tcl_GetCharLength(objv[1]) - 1; + length = Tcl_GetCharLength(objv[1]); + end = length - 1; if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { return TCL_ERROR; } @@ -2438,13 +2408,14 @@ * The following test screens out most empty substrings as candidates for * replacement. When they are detected, no replacement is done, and the * result is the original string. */ - if ((last == TCL_INDEX_NONE) || /* Range ends before start of string */ - (first + 1 > end + 1) || /* Range begins after end of string */ - (last + 1 < first + 1)) { /* Range begins after it starts */ + if ((last < 0) || /* Range ends before start of string */ + (first > end) || /* Range begins after end of string */ + (last < first)) { /* Range begins after it starts */ + /* * BUT!!! when (end < 0) -- an empty original string -- we can * have (first <= end < 0 <= last) and an empty string is permitted * to be replaced. */ @@ -2451,14 +2422,14 @@ Tcl_SetObjResult(interp, objv[1]); } else { Tcl_Obj *resultPtr; - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; + if (first < 0) { + first = 0; } - if (last + 1 > end + 1) { + if (last > end) { last = end; } resultPtr = TclStringReplace(interp, objv[1], first, last + 1 - first, (objc == 5) ? objv[4] : NULL, @@ -2487,11 +2458,11 @@ *---------------------------------------------------------------------- */ static int StringRevCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { @@ -2507,13 +2478,11 @@ *---------------------------------------------------------------------- * * StringStartCmd -- * * This procedure is invoked to process the "string wordstart" Tcl - * command. See the user documentation for details on what it does. Note - * that this command only functions correctly on properly formed Tcl UTF - * strings. + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: @@ -2522,59 +2491,68 @@ *---------------------------------------------------------------------- */ static int StringStartCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_UniChar ch = 0; + int ch; const char *p, *string; - size_t numChars, length, cur, index; + int cur, index, length, numChars; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); - numChars = Tcl_NumUtfChars(string, length) - 1; - if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string, length); + if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { return TCL_ERROR; } - string = TclGetString(objv[1]); - if (index + 1 > numChars + 1) { - index = numChars; + string = TclGetStringFromObj(objv[1], &length); + if (index >= numChars) { + index = numChars - 1; } cur = 0; - if (index + 1 > 1) { + if (index > 0) { p = Tcl_UtfAtIndex(string, index); - for (cur = index; cur != TCL_INDEX_NONE; cur--) { - TclUtfToUniChar(p, &ch); + + TclUtfToUCS4(p, &ch); + for (cur = index; cur >= 0; cur--) { + int delta = 0; + const char *next; + if (!Tcl_UniCharIsWordChar(ch)) { break; } - p = Tcl_UtfPrev(p, string); + + next = TclUtfPrev(p, string); + do { + next += delta; + delta = TclUtfToUCS4(next, &ch); + } while (next + delta < p); + p = next; } if (cur != index) { cur += 1; } } - Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(cur)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cur)); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringEndCmd -- * * This procedure is invoked to process the "string wordend" Tcl command. - * See the user documentation for details on what it does. Note that this - * command only functions correctly on properly formed Tcl UTF strings. + * See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: @@ -2583,49 +2561,49 @@ *---------------------------------------------------------------------- */ static int StringEndCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_UniChar ch = 0; + int ch; const char *p, *end, *string; - size_t length, numChars, cur, index; + int cur, index, length, numChars; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); - numChars = Tcl_NumUtfChars(string, length) - 1; - if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string, length); + if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); - if (index == TCL_INDEX_NONE) { - index = TCL_INDEX_START; + if (index < 0) { + index = 0; } - if (index + 1 <= numChars + 1) { + if (index < numChars) { p = Tcl_UtfAtIndex(string, index); end = string+length; for (cur = index; p < end; cur++) { - p += TclUtfToUniChar(p, &ch); + p += TclUtfToUCS4(p, &ch); if (!Tcl_UniCharIsWordChar(ch)) { break; } } if (cur == index) { cur++; } } else { - cur = numChars + 1; + cur = numChars; } - Tcl_SetObjResult(interp, TclNewWideIntObjFromSize(cur)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cur)); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -2645,11 +2623,11 @@ *---------------------------------------------------------------------- */ static int StringEqualCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* @@ -2657,12 +2635,11 @@ * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ const char *string2; - int i, match, nocase = 0, reqlength = -1; - size_t length; + int length, i, match, nocase = 0, reqlength = -1; if (objc < 3 || objc > 6) { str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); @@ -2721,11 +2698,11 @@ *---------------------------------------------------------------------- */ static int StringCmpCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { /* @@ -2753,12 +2730,11 @@ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, int *reqlength) { - int i; - size_t length; + int i, length; const char *string; *reqlength = -1; *nocase = 0; if (objc < 3 || objc > 6) { @@ -2810,11 +2786,11 @@ *---------------------------------------------------------------------- */ static int StringCatCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objResultPtr; @@ -2853,19 +2829,18 @@ * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ - static int StringBytesCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length; + int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } @@ -2893,11 +2868,11 @@ *---------------------------------------------------------------------- */ static int StringLenCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { @@ -2927,16 +2902,16 @@ *---------------------------------------------------------------------- */ static int StringLowerCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2; + int length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); @@ -2950,32 +2925,32 @@ length1 = Tcl_UtfToLower(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - size_t first, last; + int first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } - if (last + 1 >= length1 + 1) { + if (last >= length1) { last = length1; } - if (last + 1 < first + 1) { + if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = TclGetStringFromObj(objv[1], &length1); @@ -3012,16 +2987,16 @@ *---------------------------------------------------------------------- */ static int StringUpperCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2; + int length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); @@ -3035,32 +3010,32 @@ length1 = Tcl_UtfToUpper(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - size_t first, last; + int first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; + if (first < 0) { + first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } - if (last + 1 >= length1 + 1) { + if (last >= length1) { last = length1; } - if (last + 1 < first + 1) { + if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = TclGetStringFromObj(objv[1], &length1); @@ -3097,16 +3072,16 @@ *---------------------------------------------------------------------- */ static int StringTitleCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2; + int length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); @@ -3120,32 +3095,32 @@ length1 = Tcl_UtfToTitle(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - size_t first, last; + int first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; + if (first < 0) { + first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } - if (last + 1 >= length1 + 1) { + if (last >= length1) { last = length1; } - if (last + 1 < first + 1) { + if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = TclGetStringFromObj(objv[1], &length1); @@ -3182,17 +3157,17 @@ *---------------------------------------------------------------------- */ static int StringTrimCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - size_t triml, trimr, length1, length2; + int triml, trimr, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; @@ -3229,18 +3204,17 @@ *---------------------------------------------------------------------- */ static int StringTrimLCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int trim; - size_t length1, length2; + int trim, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; @@ -3276,18 +3250,17 @@ *---------------------------------------------------------------------- */ static int StringTrimRCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int trim; - size_t length1, length2; + int trim, length1, length2; if (objc == 3) { string2 = TclGetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; @@ -3420,21 +3393,21 @@ return TCL_OK; } int Tcl_SubstObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRSubstObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRSubstObjCmd, clientData, objc, objv); } int TclNRSubstObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int flags; @@ -3468,27 +3441,26 @@ *---------------------------------------------------------------------- */ int Tcl_SwitchObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, clientData, objc, objv); } int TclNRSwitchObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, index, mode, foundmode, splitObjs, numMatchesSaved; - int noCase; - size_t patternLength, j; + int i,j, index, mode, foundmode, splitObjs, numMatchesSaved; + int noCase, patternLength; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; Tcl_RegExp regExpr = NULL; Interp *iPtr = (Interp *) interp; @@ -3795,13 +3767,13 @@ for (j=0 ; j<=info.nsubs ; j++) { if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; - if (info.matches[j].end + 1 > 1) { - rangeObjAry[0] = TclNewWideIntObjFromSize(info.matches[j].start); - rangeObjAry[1] = TclNewWideIntObjFromSize(info.matches[j].end-1); + if (info.matches[j].end > 0) { + rangeObjAry[0] = Tcl_NewWideIntObj(info.matches[j].start); + rangeObjAry[1] = Tcl_NewWideIntObj(info.matches[j].end-1); } else { rangeObjAry[0] = rangeObjAry[1] = Tcl_NewWideIntObj(-1); } /* @@ -3861,11 +3833,11 @@ * We've got a match. Find a body to execute, skipping bodies that are * "-". */ matchFound: - ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *ctxPtr = *iPtr->cmdFramePtr; if (splitObjs) { /* * We have to perform the GetSrc and other type dependent handling of @@ -3891,11 +3863,11 @@ } if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) { int bline = ctxPtr->line[bidx]; - ctxPtr->line = Tcl_Alloc(objc * sizeof(int)); + ctxPtr->line = (int *)ckalloc(objc * sizeof(int)); ctxPtr->nline = objc; TclListLines(blist, bline, objc, ctxPtr->line, objv); } else { /* * This is either a dynamic code word, when all elements are @@ -3905,20 +3877,20 @@ * which triggers reversion to the old behavior. */ int k; - ctxPtr->line = Tcl_Alloc(objc * sizeof(int)); + ctxPtr->line = (int *)ckalloc(objc * sizeof(int)); ctxPtr->nline = objc; for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; } } } for (j = i + 1; ; j += 2) { - if (j >= (size_t)objc) { + if (j >= objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... */ @@ -3945,21 +3917,21 @@ int result) /* Result to return*/ { /* Unpack the preserved data */ int splitObjs = PTR2INT(data[0]); - CmdFrame *ctxPtr = data[1]; + CmdFrame *ctxPtr = (CmdFrame *)data[1]; int pc = PTR2INT(data[2]); - const char *pattern = data[3]; - size_t patternLength = strlen(pattern); + const char *pattern = (const char *)data[3]; + int patternLength = strlen(pattern); /* * Clean up TIP 280 context information */ if (splitObjs) { - Tcl_Free(ctxPtr->line); + ckfree(ctxPtr->line); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { /* * Death of SrcInfo reference. */ @@ -3970,16 +3942,16 @@ /* * Generate an error message if necessary. */ if (result == TCL_ERROR) { - unsigned limit = 50; + int limit = 50; int overflow = (patternLength > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", - (overflow ? limit : (unsigned)patternLength), pattern, + (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } TclStackFree(interp, ctxPtr); return result; } @@ -3999,14 +3971,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ThrowObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options; @@ -4064,18 +4035,18 @@ *---------------------------------------------------------------------- */ int Tcl_TimeObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; Tcl_Obj *objs[4]; - register int i, result; + int i, result; int count; double totalMicroSec; #ifndef TCL_WIDE_CLICKS Tcl_Time start, stop; #else @@ -4162,34 +4133,34 @@ *---------------------------------------------------------------------- */ int Tcl_TimeRateObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static double measureOverhead = 0; /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ - register Tcl_Obj *objPtr; - register int result, i; + Tcl_Obj *objPtr; + int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - Tcl_WideUInt count = 0; /* Holds repetition count */ + TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ - Tcl_WideUInt maxcnt = WIDE_MAX; + TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ - Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster + TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max + TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid * growth of execution time. */ - register Tcl_WideInt start, middle, stop; + Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; #endif /* !TCL_WIDE_CLICKS */ static const char *const options[] = { "-direct", "-overhead", "-calibrate", "--", NULL @@ -4197,11 +4168,10 @@ enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; - int codeOptimized = 0; for (i = 1; i < objc - 1; i++) { int index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, @@ -4382,19 +4352,10 @@ if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); - /* - * Replace last compiled done instruction with continue: it's a part of - * iteration, this way evaluation will be more similar to a cycle (also - * avoids extra overhead to set result to interp, etc.) - */ - if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) { - codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE; - codeOptimized = 1; - } } /* * Get start and stop time. */ @@ -4432,10 +4393,16 @@ */ count++; if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); + /* + * Use loop optimized TEBC call (TCL_EVAL_DISCARD_RESULT): it's a part of + * iteration, this way evaluation will be more similar to a cycle (also + * avoids extra overhead to set result to interp, etc.) + */ + ((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT; result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } @@ -4451,10 +4418,11 @@ /* * Force stop immediately. */ threshold = 1; maxcnt = 0; + /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; default: goto done; @@ -4555,17 +4523,17 @@ } } { Tcl_Obj *objarr[8], **objs = objarr; - Tcl_WideUInt usec, val; + TclWideMUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ - usec = (Tcl_WideUInt)(middle - start); + usec = (TclWideMUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* * convert execution time (in wide clicks) to microsecs. */ @@ -4590,11 +4558,11 @@ if (overhead > 0) { /* * Estimate the time of overhead (microsecs). */ - Tcl_WideUInt curOverhead = overhead * count; + TclWideMUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; } else { usec = 0; @@ -4684,15 +4652,10 @@ Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); } done: if (codePtr != NULL) { - if ( codeOptimized - && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE - ) { - codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE; - } TclReleaseByteCode(codePtr); } return result; } @@ -4713,21 +4676,21 @@ *---------------------------------------------------------------------- */ int Tcl_TryObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, clientData, objc, objv); } int TclNRTryObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL; @@ -4815,11 +4778,11 @@ } code = 1; if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad prefix '%s': must be a list", - TclGetString(objv[i+1]))); + Tcl_GetString(objv[i+1]))); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "EXNFORMAT", NULL); return TCL_ERROR; } @@ -4926,16 +4889,16 @@ ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv; - int i, dummy, code, objc; + int i, code, objc; int numHandlers = 0; - handlersObj = data[0]; - finallyObj = data[1]; - objv = data[2]; + handlersObj = (Tcl_Obj *)data[0]; + finallyObj = (Tcl_Obj *)data[1]; + objv = (Tcl_Obj **)data[2]; objc = PTR2INT(data[3]); cmdObj = objv[0]; /* @@ -4977,12 +4940,13 @@ Tcl_Obj **handlers, **info; Tcl_ListObjGetElements(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i 0) { + Tcl_ListObjLength(NULL, info[3], &numElems); + if (numElems> 0) { Tcl_Obj *varName; Tcl_ListObjIndex(NULL, info[3], 0, &varName); if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(resultObj); goto handlerFailed; } Tcl_DecrRefCount(resultObj); - if (dummy > 1) { + if (numElems> 1) { Tcl_ListObjIndex(NULL, info[3], 1, &varName); if (Tcl_ObjSetVar2(interp, varName, NULL, options, TCL_LEAVE_ERR_MSG) == NULL) { goto handlerFailed; } @@ -5144,13 +5108,13 @@ { Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv; Tcl_Obj *finallyObj; int finally; - objv = data[0]; - options = data[1]; - handlerKindObj = data[2]; + objv = (Tcl_Obj **)data[0]; + options = (Tcl_Obj *)data[1]; + handlerKindObj = (Tcl_Obj *)data[2]; finally = PTR2INT(data[3]); cmdObj = objv[0]; finallyObj = finally ? objv[finally] : 0; @@ -5228,13 +5192,13 @@ Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *cmdObj; - resultObj = data[0]; - options = data[1]; - cmdObj = data[2]; + resultObj = (Tcl_Obj *)data[0]; + options = (Tcl_Obj *)data[1]; + cmdObj = (Tcl_Obj *)data[2]; /* * If the result wasn't OK, we need to adjust the result options. */ @@ -5289,21 +5253,21 @@ *---------------------------------------------------------------------- */ int Tcl_WhileObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRWhileObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRWhileObjCmd, clientData, objc, objv); } int TclNRWhileObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ForIterData *iterPtr; @@ -5354,11 +5318,11 @@ int n, /* #elements in lines */ int *lines, /* Array of line numbers, to fill. */ Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of * derived continuation data */ { - const char *listStr = TclGetString(listObj); + const char *listStr = Tcl_GetString(listObj); const char *listHead = listStr; int i, length = strlen(listStr); const char *element = NULL, *next = NULL; ContLineLoc *clLocPtr = TclContinuationsGet(listObj); int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL); Index: generic/tclCompCmds.c ================================================================== --- generic/tclCompCmds.c +++ generic/tclCompCmds.c @@ -19,32 +19,20 @@ /* * Prototypes for procedures defined later in this file: */ -static ClientData DupDictUpdateInfo(ClientData clientData); -static void FreeDictUpdateInfo(ClientData clientData); -static void PrintDictUpdateInfo(ClientData clientData, - Tcl_Obj *appendObj, ByteCode *codePtr, - unsigned int pcOffset); -static void DisassembleDictUpdateInfo(ClientData clientData, - Tcl_Obj *dictObj, ByteCode *codePtr, - unsigned int pcOffset); -static ClientData DupForeachInfo(ClientData clientData); -static void FreeForeachInfo(ClientData clientData); -static void PrintForeachInfo(ClientData clientData, - Tcl_Obj *appendObj, ByteCode *codePtr, - unsigned int pcOffset); -static void DisassembleForeachInfo(ClientData clientData, - Tcl_Obj *dictObj, ByteCode *codePtr, - unsigned int pcOffset); -static void PrintNewForeachInfo(ClientData clientData, - Tcl_Obj *appendObj, ByteCode *codePtr, - unsigned int pcOffset); -static void DisassembleNewForeachInfo(ClientData clientData, - Tcl_Obj *dictObj, ByteCode *codePtr, - unsigned int pcOffset); +static AuxDataDupProc DupDictUpdateInfo; +static AuxDataFreeProc FreeDictUpdateInfo; +static AuxDataPrintProc PrintDictUpdateInfo; +static AuxDataPrintProc DisassembleDictUpdateInfo; +static AuxDataDupProc DupForeachInfo; +static AuxDataFreeProc FreeForeachInfo; +static AuxDataPrintProc PrintForeachInfo; +static AuxDataPrintProc DisassembleForeachInfo; +static AuxDataPrintProc PrintNewForeachInfo; +static AuxDataPrintProc DisassembleNewForeachInfo; static int CompileEachloopCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, int collect); static int CompileDictEachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, @@ -136,13 +124,13 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int isScalar, localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; @@ -258,12 +246,11 @@ int TclCompileArrayExistsCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int isScalar, localIndex; @@ -401,13 +388,13 @@ */ keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); - infoPtr = Tcl_Alloc(sizeof(ForeachInfo)); + infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)); infoPtr->numLists = 1; - infoPtr->varLists[0] = Tcl_Alloc(sizeof(ForeachVarList) + sizeof(int)); + infoPtr->varLists[0] = (ForeachVarList *)ckalloc(sizeof(ForeachVarList) + sizeof(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr); @@ -520,15 +507,14 @@ *---------------------------------------------------------------------- */ int TclCompileBreakCmd( - Tcl_Interp *interp, /* Used for error reporting. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; @@ -581,18 +567,17 @@ int TclCompileCatchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; int resultIndex, optsIndex, range, dropScript = 0; - DefineLineInformation; /* TIP #280 */ int depth = TclGetStackDepth(envPtr); /* * If syntax does not match what we expect for [catch], do not compile. * Let runtime checks determine if syntax has changed. @@ -699,12 +684,12 @@ TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); /* Stack at this point on both branches: result returnCode */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileCatchCmd: bad jump distance %" TCL_Z_MODIFIER "d", - (CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileCatchCmd: bad jump distance %d", + (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset)); } /* * Push the return options if the caller wants them. This needs to happen * before INST_END_CATCH @@ -763,15 +748,14 @@ *---------------------------------------------------------------------- */ int TclCompileClockClicksCmd( - Tcl_Interp* interp, /* Tcl interpreter */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token* tokenPtr; switch (parsePtr->numWords) { @@ -827,11 +811,11 @@ *---------------------------------------------------------------------- */ int TclCompileClockReadingCmd( - Tcl_Interp* interp, /* Tcl interpreter */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -866,12 +850,11 @@ int TclCompileConcatCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Obj *objPtr, *listObj; Tcl_Token *tokenPtr; @@ -906,17 +889,16 @@ } if (listObj != NULL) { Tcl_Obj **objs; const char *bytes; int len; - size_t slen; Tcl_ListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); - bytes = TclGetStringFromObj(objPtr, &slen); - PushLiteral(envPtr, bytes, slen); + bytes = TclGetStringFromObj(objPtr, &len); + PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(objPtr); return TCL_OK; } /* @@ -951,15 +933,14 @@ *---------------------------------------------------------------------- */ int TclCompileContinueCmd( - Tcl_Interp *interp, /* Used for error reporting. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; @@ -1017,17 +998,16 @@ int TclCompileDictSetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i, dictVarIndex; - DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; /* * There must be at least one argument after the command. */ @@ -1095,12 +1075,11 @@ * Parse the increment amount, if present. */ if (parsePtr->numWords == 4) { const char *word; - size_t numBytes; - int code; + int numBytes, code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; incrTokenPtr = TokenAfter(keyTokenPtr); if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -1144,17 +1123,16 @@ int TclCompileDictGetCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i; - DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ @@ -1181,17 +1159,16 @@ int TclCompileDictGetWithDefaultCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i; - DefineLineInformation; /* TIP #280 */ /* * There must be at least three arguments after the command. */ @@ -1213,17 +1190,16 @@ int TclCompileDictExistsCmd( Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int i; - DefineLineInformation; /* TIP #280 */ /* * There must be at least two arguments after the command (the single-arg * case is legal, but too special and magic for us to deal with here). */ @@ -1254,12 +1230,12 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; int i, dictVarIndex; /* * There must be at least one argument after the variable name for us to * compile to bytecode. @@ -1312,12 +1288,11 @@ DefineLineInformation; /* TIP #280 */ int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; - int i; - size_t len; + int i, len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; } @@ -1596,19 +1571,19 @@ Tcl_DStringFree(&buffer); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } Tcl_DStringFree(&buffer); if (numVars != 2) { - Tcl_Free((void *)argv); + ckfree(argv); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nameChars = strlen(argv[0]); keyVarIndex = LocalScalar(argv[0], nameChars, envPtr); nameChars = strlen(argv[1]); valueVarIndex = LocalScalar(argv[1], nameChars, envPtr); - Tcl_Free((void *)argv); + ckfree(argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1812,13 +1787,13 @@ * Assemble the instruction metadata. This is complex enough that it is * represented as auxData; it holds an ordered list of variable indices * that are to be used. */ - duiPtr = Tcl_Alloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); + duiPtr = (DictUpdateInfo *)ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); duiPtr->length = numVars; - keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); + keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); for (i=0 ; ilength - 1); - dui2Ptr = Tcl_Alloc(len); + dui2Ptr = (DictUpdateInfo *)ckalloc(len); memcpy(dui2Ptr, dui1Ptr, len); return dui2Ptr; } static void FreeDictUpdateInfo( ClientData clientData) { - Tcl_Free(clientData); + ckfree(clientData); } static void PrintDictUpdateInfo( ClientData clientData, Tcl_Obj *appendObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - DictUpdateInfo *duiPtr = clientData; - size_t i; + DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; + int i; for (i=0 ; ilength ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } @@ -2329,15 +2304,15 @@ static void DisassembleDictUpdateInfo( ClientData clientData, Tcl_Obj *dictObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - DictUpdateInfo *duiPtr = clientData; - size_t i; + DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; + int i; Tcl_Obj *variables = Tcl_NewObj(); for (i=0 ; ilength ; i++) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewIntObj(duiPtr->varIndices[i])); @@ -2367,21 +2342,20 @@ int TclCompileErrorCmd( Tcl_Interp *interp, /* Used for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + /* * General syntax: [error message ?errorInfo? ?errorCode?] */ - Tcl_Token *tokenPtr; - DefineLineInformation; /* TIP #280 */ - if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { return TCL_ERROR; } /* @@ -2441,12 +2415,11 @@ int TclCompileExprCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *firstWordPtr; if (parsePtr->numWords == 1) { @@ -2486,19 +2459,18 @@ int TclCompileForCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; int bodyCodeOffset, nextCodeOffset, jumpDist; int bodyRange, nextRange; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 5) { return TCL_ERROR; } @@ -2697,26 +2669,25 @@ static int CompileEachloopCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr, /* Holds resulting instructions. */ int collect) /* Select collecting or accumulating mode * (TCL_EACH_*) */ { + DefineLineInformation; /* TIP #280 */ Proc *procPtr = envPtr->procPtr; ForeachInfo *infoPtr=NULL; /* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ Tcl_Token *tokenPtr, *bodyTokenPtr; int jumpBackOffset, infoIndex, range; int numWords, numLists, i, j, code = TCL_OK; Tcl_Obj *varListObj = NULL; - DefineLineInformation; /* TIP #280 */ /* * If the foreach command isn't in a procedure, don't compile it inline: * the payoff is too small. */ @@ -2748,11 +2719,11 @@ * structures describing this command. Then create a AuxData record * pointing to the ForeachInfo structure. */ numLists = (numWords - 2)/2; - infoPtr = Tcl_Alloc(sizeof(ForeachInfo) + infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo) + (numLists - 1) * sizeof(ForeachVarList *)); infoPtr->numLists = 0; /* Count this up as we go */ /* * Parse each var list into sequence of var names. Don't @@ -2782,26 +2753,24 @@ numVars == 0) { code = TCL_ERROR; goto done; } - varListPtr = Tcl_Alloc(sizeof(ForeachVarList) + varListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList) + (numVars - 1) * sizeof(int)); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; infoPtr->numLists++; for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; const char *bytes; - int varIndex; - size_t length; - + int numBytes, varIndex; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); - bytes = TclGetStringFromObj(varNameObj, &length); - varIndex = LocalScalar(bytes, length, envPtr); + bytes = TclGetStringFromObj(varNameObj, &numBytes); + varIndex = LocalScalar(bytes, numBytes, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; } varListPtr->varIndexes[j] = varIndex; @@ -2915,25 +2884,25 @@ static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { - register ForeachInfo *srcPtr = clientData; + ForeachInfo *srcPtr = (ForeachInfo *)clientData; ForeachInfo *dupPtr; - register ForeachVarList *srcListPtr, *dupListPtr; + ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; - dupPtr = Tcl_Alloc(sizeof(ForeachInfo) + dupPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; dupPtr->loopCtTemp = srcPtr->loopCtTemp; for (i = 0; i < numLists; i++) { srcListPtr = srcPtr->varLists[i]; numVars = srcListPtr->numVars; - dupListPtr = Tcl_Alloc(sizeof(ForeachVarList) + dupListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList) + numVars * sizeof(int)); dupListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j]; } @@ -2964,20 +2933,20 @@ static void FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *listPtr; + ForeachInfo *infoPtr = (ForeachInfo *)clientData; + ForeachVarList *listPtr; int numLists = infoPtr->numLists; - register int i; + int i; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; - Tcl_Free(listPtr); + ckfree(listPtr); } - Tcl_Free(infoPtr); + ckfree(infoPtr); } /* *---------------------------------------------------------------------- * @@ -2997,15 +2966,15 @@ static void PrintForeachInfo( ClientData clientData, Tcl_Obj *appendObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = (ForeachInfo *)clientData; + ForeachVarList *varsPtr; int i, j; Tcl_AppendToObj(appendObj, "data=[", -1); for (i=0 ; inumLists ; i++) { @@ -3037,15 +3006,15 @@ static void PrintNewForeachInfo( ClientData clientData, Tcl_Obj *appendObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = (ForeachInfo *)clientData; + ForeachVarList *varsPtr; int i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", infoPtr->loopCtTemp); for (i=0 ; inumLists ; i++) { @@ -3067,15 +3036,15 @@ static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = (ForeachInfo *)clientData; + ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Data stores. @@ -3114,15 +3083,15 @@ static void DisassembleNewForeachInfo( ClientData clientData, Tcl_Obj *dictObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - register ForeachInfo *infoPtr = clientData; - register ForeachVarList *varsPtr; + ForeachInfo *infoPtr = (ForeachInfo *)clientData; + ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Jump offset. @@ -3170,20 +3139,18 @@ int TclCompileFormatCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; - char *bytes, *start; - int i, j; - size_t len; + const char *bytes, *start; + int i, j, len; /* * Don't handle any guaranteed-error cases. */ @@ -3202,11 +3169,11 @@ if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) { Tcl_DecrRefCount(formatObj); return TCL_ERROR; } - objv = Tcl_Alloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); objv[i] = Tcl_NewObj(); Tcl_IncrRefCount(objv[i]); if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) { @@ -3217,16 +3184,16 @@ /* * Everything is a literal, so the result is constant too (or an error if * the format is broken). Do the format now. */ - tmpObj = Tcl_Format(interp, TclGetString(formatObj), + tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj), parsePtr->numWords-2, objv); for (; --i>=0 ;) { Tcl_DecrRefCount(objv[i]); } - Tcl_Free(objv); + ckfree(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { TclCompileSyntaxError(interp, envPtr); return TCL_OK; } @@ -3252,20 +3219,20 @@ */ for (; i>=0 ; i--) { Tcl_DecrRefCount(objv[i]); } - Tcl_Free(objv); + ckfree(objv); tokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(tokenPtr); i = 0; /* * Now scan through and check for non-%s and non-%% substitutions. */ - for (bytes = TclGetString(formatObj) ; *bytes ; bytes++) { + for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) { if (*bytes == '%') { bytes++; if (*bytes == 's') { i++; continue; @@ -3294,11 +3261,11 @@ */ i = 0; /* The count of things to concat. */ j = 2; /* The index into the argument tokens, for * TIP#280 handling. */ - start = TclGetString(formatObj); + start = Tcl_GetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ tmpObj = Tcl_NewObj(); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { @@ -3305,11 +3272,11 @@ if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { - char *b = TclGetStringFromObj(tmpObj, &len); + const char *b = TclGetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, * push it and reset. */ @@ -3394,11 +3361,11 @@ } int TclLocalScalar( const char *bytes, - size_t numBytes, + int numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, {TCL_TOKEN_TEXT, NULL, 0, 0}}; @@ -3443,16 +3410,15 @@ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { - register const char *p; + const char *p; const char *last, *name, *elName; - register size_t n; + int n; Tcl_Token *elemTokenPtr = NULL; - size_t nameLen, elNameLen; - int simpleVarName, localIndex; + int nameLen, elNameLen, simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* * Decide if we can use a frame slot for the var/array name or if we need * to emit code to compute and push the name at runtime. We use a frame @@ -3478,14 +3444,14 @@ nameLen = varTokenPtr[1].size; if (name[nameLen-1] == ')') { /* * last char is ')' => potential array reference. */ - last = Tcl_UtfPrev(name + nameLen, name); + last = &name[nameLen-1]; if (*last == ')') { - for (p = name; p < last; p = Tcl_UtfNext(p)) { + for (p = name; p < last; p++) { if (*p == '(') { elName = p + 1; elNameLen = last - elName; nameLen = p - name; break; @@ -3497,11 +3463,11 @@ /* * An array element, the element name is a simple string: * assemble the corresponding token. */ - elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); + elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; elemTokenPtr->size = elNameLen; elemTokenPtr->numComponents = 0; @@ -3509,26 +3475,25 @@ } } } else if (interp && ((n = varTokenPtr->numComponents) > 1) && (varTokenPtr[1].type == TCL_TOKEN_TEXT) && (varTokenPtr[n].type == TCL_TOKEN_TEXT) - && (*((p = varTokenPtr[n].start + varTokenPtr[n].size)-1) == ')') - && (*Tcl_UtfPrev(p, varTokenPtr[n].start) == ')')) { + && (*(varTokenPtr[n].start + varTokenPtr[n].size - 1) == ')')) { /* * Check for parentheses inside first token. */ simpleVarName = 0; for (p = varTokenPtr[1].start, - last = p + varTokenPtr[1].size; p < last; p = Tcl_UtfNext(p)) { + last = p + varTokenPtr[1].size; p < last; p++) { if (*p == '(') { simpleVarName = 1; break; } } if (simpleVarName) { - size_t remainingLen; + int remainingLen; /* * Check the last token: if it is just ')', do not count it. * Otherwise, remove the ')' and flag so that it is restored at * the end. @@ -3552,11 +3517,11 @@ /* * Make a first token with the extra characters in the first * token. */ - elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); + elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; elemTokenPtr->size = remainingLen; elemTokenPtr->numComponents = 0; @@ -3585,11 +3550,11 @@ * See whether name has any namespace separators (::'s). */ int hasNsQualifiers = 0; - for (p = name, last = p + nameLen-1; p < last; p = Tcl_UtfNext(p)) { + for (p = name, last = p + nameLen-1; p < last; p++) { if ((*p == ':') && (*(p+1) == ':')) { hasNsQualifiers = 1; break; } } Index: generic/tclCompCmdsGR.c ================================================================== --- generic/tclCompCmdsGR.c +++ generic/tclCompCmdsGR.c @@ -47,12 +47,12 @@ */ int TclGetIndexFromToken( Tcl_Token *tokenPtr, - size_t before, - size_t after, + int before, + int after, int *indexPtr) { Tcl_Obj *tmpObj = Tcl_NewObj(); int result = TCL_ERROR; @@ -84,17 +84,16 @@ int TclCompileGlobalCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; @@ -166,31 +165,29 @@ int TclCompileIfCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ JumpFixupArray jumpFalseFixupArray; /* Used to fix the ifFalse jump after each * test when its target PC is determined. */ JumpFixupArray jumpEndFixupArray; /* Used to fix the jump after each "then" body * to the end of the "if" when that PC is * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpIndex = 0; /* Avoid compiler warning. */ - size_t numBytes; - int jumpFalseDist, numWords, wordIdx, j, code; + int jumpFalseDist, numWords, wordIdx, numBytes, j, code; const char *word; int realCond = 1; /* Set to 0 for static conditions: * "if 0 {..}" */ int boolVal; /* Value of static condition. */ int compileScripts = 1; - DefineLineInformation; /* TIP #280 */ /* * Only compile the "if" command if all arguments are simple words, in * order to insure correct substitution [Bug 219166] */ @@ -470,17 +467,16 @@ int TclCompileIncrCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *incrTokenPtr; int isScalar, localIndex, haveImmValue, immValue; - DefineLineInformation; /* TIP #280 */ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { return TCL_ERROR; } @@ -498,11 +494,11 @@ immValue = 1; if (parsePtr->numWords == 3) { incrTokenPtr = TokenAfter(varTokenPtr); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { const char *word = incrTokenPtr[1].start; - size_t numBytes = incrTokenPtr[1].size; + int numBytes = incrTokenPtr[1].size; int code; Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = TclGetIntFromObj(NULL, intObj, &immValue); @@ -588,11 +584,11 @@ CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; - char *bytes; + const char *bytes; /* * We require one compile-time known argument for the case we can compile. */ @@ -639,15 +635,14 @@ return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr); } int TclCompileInfoCoroutineCmd( - Tcl_Interp *interp, /* Used for error reporting. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Only compile [info coroutine] without arguments. */ @@ -667,17 +662,16 @@ int TclCompileInfoExistsCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int isScalar, localIndex; - DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 2) { return TCL_ERROR; } @@ -716,12 +710,11 @@ int TclCompileInfoLevelCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Only compile [info level] without arguments or with a single argument. */ @@ -751,12 +744,11 @@ int TclCompileInfoObjectClassCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -771,12 +763,11 @@ int TclCompileInfoObjectIsACmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -807,12 +798,11 @@ int TclCompileInfoObjectNamespaceCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -845,17 +835,16 @@ int TclCompileLappendCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int isScalar, localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords < 3) { return TCL_ERROR; @@ -961,17 +950,16 @@ int TclCompileLassignCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int isScalar, localIndex, numWords, idx; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; /* * Check for command syntax error, but we'll punt that to runtime. @@ -1065,17 +1053,16 @@ int TclCompileLindexCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *idxTokenPtr, *valTokenPtr; int i, idx, numWords = parsePtr->numWords; - DefineLineInformation; /* TIP #280 */ /* * Quit if too few args. */ @@ -1156,12 +1143,11 @@ int TclCompileListCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *valueTokenPtr; int i, numWords, concat, build; @@ -1270,16 +1256,15 @@ int TclCompileLlengthCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *varTokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *varTokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1303,16 +1288,15 @@ int TclCompileLrangeCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { - Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *listTokenPtr; int idx1, idx2; if (parsePtr->numWords != 4) { return TCL_ERROR; } @@ -1364,16 +1348,15 @@ int TclCompileLinsertCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { - Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *listTokenPtr; int idx, i; if (parsePtr->numWords < 3) { return TCL_ERROR; } @@ -1467,16 +1450,15 @@ int TclCompileLreplaceCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { - Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *listTokenPtr; int idx1, idx2, i; int emptyPrefix=1, suffixStart = 0; if (parsePtr->numWords < 4) { return TCL_ERROR; @@ -1631,22 +1613,21 @@ int TclCompileLsetCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ int tempDepth; /* Depth used for emitting one part of the * code burst. */ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the variable name. */ int localIndex; /* Index of var in local var table. */ int isScalar; /* Flag == 1 if scalar, 0 if array. */ int i; - DefineLineInformation; /* TIP #280 */ /* * Check argument count. */ @@ -1775,15 +1756,14 @@ *---------------------------------------------------------------------- */ int TclCompileNamespaceCurrentCmd( - Tcl_Interp *interp, /* Used for error reporting. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * Only compile [namespace current] without arguments. */ @@ -1803,16 +1783,15 @@ int TclCompileNamespaceCodeCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1853,16 +1832,15 @@ int TclCompileNamespaceOriginCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1875,16 +1853,15 @@ int TclCompileNamespaceQualifiersCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int off; if (parsePtr->numWords != 2) { return TCL_ERROR; } @@ -1911,16 +1888,15 @@ int TclCompileNamespaceTailCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); JumpFixup jumpFixup; if (parsePtr->numWords != 2) { return TCL_ERROR; } @@ -1948,17 +1924,16 @@ int TclCompileNamespaceUpvarCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ if (envPtr->procPtr == NULL) { return TCL_ERROR; } @@ -2009,12 +1984,11 @@ int TclCompileNamespaceWhichCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *opt; int idx; @@ -2073,20 +2047,18 @@ int TclCompileRegexpCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ - size_t len; - int i, nocase, exact, sawLast, simple; + int i, len, nocase, exact, sawLast, simple; const char *str; - DefineLineInformation; /* TIP #280 */ /* * We are only interested in compiling simple regexp cases. Currently * supported compile cases are: * regexp ?-nocase? ?--? staticString $var @@ -2121,11 +2093,11 @@ len = varTokenPtr[1].size; if ((len == 2) && (str[0] == '-') && (str[1] == '-')) { sawLast++; i++; break; - } else if ((len > 1) && (strncmp(str,"-nocase", len) == 0)) { + } else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) { nocase = 1; } else { /* * Not an option we recognize. */ @@ -2239,12 +2211,11 @@ int TclCompileRegsubCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { /* * We only compile the case with [regsub -all] where the pattern is both * known at compile time and simple (i.e., no RE metacharacters). That is, @@ -2268,12 +2239,11 @@ DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *stringTokenPtr; Tcl_Obj *patternObj = NULL, *replacementObj = NULL; Tcl_DString pattern; const char *bytes; - int exact, quantified, result = TCL_ERROR; - size_t len; + int len, exact, quantified, result = TCL_ERROR; if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { return TCL_ERROR; } @@ -2347,11 +2317,11 @@ * OK, we've proved there are no metacharacters except for the * '*' at each end. */ len = Tcl_DStringLength(&pattern) - 2; - if (len + 2 > 2) { + if (len > 0) { goto isSimpleGlob; } /* * The pattern is "**"! I believe that should be impossible, @@ -2415,14 +2385,14 @@ int TclCompileReturnCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ /* * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int level, code, objc, size, status = TCL_OK; @@ -2429,11 +2399,10 @@ int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; Tcl_Obj *returnOpts, **objv; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); - DefineLineInformation; /* TIP #280 */ /* * Check for special case which can always be compiled: * return -options * Unlike the normal [return] compilation, this version does everything at @@ -2456,11 +2425,11 @@ /* * Allocate some working space. */ - objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *)); /* * Scan through the return options. If any are unknown at compile time, * there is no value in bytecompiling. Save the option values known in an * objv array for merging into a return options dictionary. @@ -2634,11 +2603,11 @@ TclCompileSyntaxError( Tcl_Interp *interp, CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); - size_t numBytes; + int numBytes; const char *bytes = TclGetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr); CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, @@ -2667,17 +2636,16 @@ int TclCompileUpvarCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ Tcl_Obj *objPtr; if (envPtr->procPtr == NULL) { return TCL_ERROR; } @@ -2774,17 +2742,16 @@ int TclCompileVariableCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords < 2) { return TCL_ERROR; } @@ -2856,18 +2823,17 @@ *---------------------------------------------------------------------- */ static int IndexTailVarIfKnown( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), Tcl_Token *varTokenPtr, /* Token representing the variable name */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Obj *tailPtr; const char *tailName, *p; - int n = varTokenPtr->numComponents; - size_t len; + int len, n = varTokenPtr->numComponents; Tcl_Token *lastTokenPtr; int full, localIndex; /* * Determine if the tail is (a) known at compile time, and (b) not an @@ -2949,12 +2915,11 @@ int TclCompileObjectNextCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; @@ -2974,12 +2939,11 @@ int TclCompileObjectNextToCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; @@ -2996,15 +2960,14 @@ return TCL_OK; } int TclCompileObjectSelfCmd( - Tcl_Interp *interp, /* Used for error reporting. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { /* * We only handle [self] and [self object] (which is the same operation). * These are the only very common operations on [self] for which Index: generic/tclCompCmdsSZ.c ================================================================== --- generic/tclCompCmdsSZ.c +++ generic/tclCompCmdsSZ.c @@ -21,18 +21,14 @@ /* * Prototypes for procedures defined later in this file: */ -static ClientData DupJumptableInfo(ClientData clientData); -static void FreeJumptableInfo(ClientData clientData); -static void PrintJumptableInfo(ClientData clientData, - Tcl_Obj *appendObj, ByteCode *codePtr, - unsigned int pcOffset); -static void DisassembleJumptableInfo(ClientData clientData, - Tcl_Obj *dictObj, ByteCode *codePtr, - unsigned int pcOffset); +static AuxDataDupProc DupJumptableInfo; +static AuxDataFreeProc FreeJumptableInfo; +static AuxDataPrintProc PrintJumptableInfo; +static AuxDataPrintProc DisassembleJumptableInfo; static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); static int CompileComparisonOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, @@ -43,17 +39,16 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); static void IssueSwitchChainedTests(Tcl_Interp *interp, CompileEnv *envPtr, int mode, int noCase, - int valueIndex, int numWords, - Tcl_Token **bodyToken, int *bodyLines, - int **bodyNext); + int numWords, Tcl_Token **bodyToken, + int *bodyLines, int **bodyNext); static void IssueSwitchJumpTable(Tcl_Interp *interp, - CompileEnv *envPtr, int valueIndex, - int numWords, Tcl_Token **bodyToken, - int *bodyLines, int **bodyContLines); + CompileEnv *envPtr, int numWords, + Tcl_Token **bodyToken, int *bodyLines, + int **bodyContLines); static int IssueTryClausesInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, int numHandlers, int *matchCodes, Tcl_Obj **matchClauses, int *resultVarIndices, int *optionVarIndices, Tcl_Token **handlerTokens); @@ -129,17 +124,16 @@ int TclCompileSetCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *valueTokenPtr; int isAssignment, isScalar, localIndex, numWords; - DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if ((numWords != 2) && (numWords != 3)) { return TCL_ERROR; } @@ -223,18 +217,17 @@ int TclCompileStringCatCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ int i, numWords = parsePtr->numWords, numArgs; Tcl_Token *wordTokenPtr; Tcl_Obj *obj, *folded; - DefineLineInformation; /* TIP #280 */ /* Trivial case, no arg */ if (numWords<2) { PushStringLiteral(envPtr, ""); @@ -257,11 +250,11 @@ folded = obj; } } else { Tcl_DecrRefCount(obj); if (folded) { - size_t len; + int len; const char *bytes = TclGetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); folded = NULL; @@ -275,11 +268,11 @@ } } wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { - size_t len; + int len; const char *bytes = TclGetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); folded = NULL; @@ -295,12 +288,11 @@ int TclCompileStringCmpCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -327,12 +319,11 @@ int TclCompileStringEqualCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -359,12 +350,11 @@ int TclCompileStringFirstCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -391,12 +381,11 @@ int TclCompileStringLastCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -423,12 +412,11 @@ int TclCompileStringIndexCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -451,16 +439,15 @@ int TclCompileStringInsertCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; int idx; if (parsePtr->numWords != 4) { return TCL_ERROR; } @@ -692,10 +679,11 @@ } FIXJUMP1( over); OP( LNOT); return TCL_OK; } + break; case STR_IS_DOUBLE: { int satisfied, isEmpty; if (allowEmpty) { @@ -801,12 +789,11 @@ * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; - size_t length; - int i, exactMatch = 0, nocase = 0; + int i, length, exactMatch = 0, nocase = 0; const char *str; if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { return TCL_ERROR; } @@ -877,12 +864,11 @@ int TclCompileStringLenCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; Tcl_Obj *objPtr; @@ -899,13 +885,13 @@ * something with backslashes). Just push the actual character (not * byte) length. */ char buf[TCL_INTEGER_SPACE]; - size_t len = Tcl_GetCharLength(objPtr); + int len = Tcl_GetCharLength(objPtr); - len = sprintf(buf, "%" TCL_Z_MODIFIER "d", len); + len = sprintf(buf, "%d", len); PushLiteral(envPtr, buf, len); } else { SetLineInformation(1); CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_STR_LEN, envPtr); @@ -924,13 +910,12 @@ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; - char *bytes; + const char *bytes; int len; - size_t slen; /* * We only handle the case: * * string map {foo bar} $thing @@ -962,17 +947,17 @@ * Now issue the opcodes. Note that in the case that we know that the * first word is an empty word, we don't issue the map at all. That is the * correct semantics for mapping. */ - bytes = TclGetStringFromObj(objv[0], &slen); - if (slen == 0) { + bytes = TclGetStringFromObj(objv[0], &len); + if (len == 0) { CompileWord(envPtr, stringTokenPtr, interp, 2); } else { - PushLiteral(envPtr, bytes, slen); - bytes = TclGetStringFromObj(objv[1], &slen); - PushLiteral(envPtr, bytes, slen); + PushLiteral(envPtr, bytes, len); + bytes = TclGetStringFromObj(objv[1], &len); + PushLiteral(envPtr, bytes, len); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } Tcl_DecrRefCount(mapObj); return TCL_OK; @@ -981,12 +966,11 @@ int TclCompileStringRangeCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr; int idx1, idx2; @@ -1057,16 +1041,15 @@ int TclCompileStringReplaceCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds the resulting instructions. */ { - Tcl_Token *tokenPtr, *valueTokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *valueTokenPtr; int first, last; if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { return TCL_ERROR; } @@ -1256,12 +1239,11 @@ int TclCompileStringTrimLCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -1284,12 +1266,11 @@ int TclCompileStringTrimRCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -1312,12 +1293,11 @@ int TclCompileStringTrimCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; @@ -1461,27 +1441,26 @@ int TclCompileSubstCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ int numArgs = parsePtr->numWords - 1; int numOpts = numArgs - 1; int objc, flags = TCL_SUBST_ALL; Tcl_Obj **objv/*, *toSubst = NULL*/; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); int code = TCL_ERROR; - DefineLineInformation; /* TIP #280 */ if (numArgs == 0) { return TCL_ERROR; } - objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *)); for (objc = 0; objc < /*numArgs*/ numOpts; objc++) { objv[objc] = Tcl_NewObj(); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { @@ -1527,11 +1506,11 @@ void TclSubstCompile( Tcl_Interp *interp, const char *bytes, - size_t numBytes, + int numBytes, int flags, int line, CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; @@ -1558,12 +1537,11 @@ count++; } for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { - size_t length; - int literal, catchRange, breakJump; + int length, literal, catchRange, breakJump; char buf[4] = ""; JumpFixup startFixup, okFixup, returnFixup, breakFixup; JumpFixup continueFixup, otherFixup, endFixup; switch (tokenPtr->type) { @@ -1590,12 +1568,11 @@ * code. Note that the first component of TCL_TOKEN_VARIABLE is * always TCL_TOKEN_TEXT... */ if (tokenPtr->numComponents > 1) { - size_t i; - int foundCommand = 0; + int i, foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { foundCommand = 1; break; @@ -1630,12 +1607,12 @@ breakOffset = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); /* Start */ if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad start jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - startFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", + (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); } } envPtr->line = bline; catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); @@ -1689,12 +1666,12 @@ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup); TclAdjustStackDepth(1, envPtr); /* BREAK destination */ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad break jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - breakFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", + (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); } OP( POP); OP( POP); breakJump = CurrentOffset(envPtr) - breakOffset; @@ -1705,26 +1682,26 @@ } TclAdjustStackDepth(2, envPtr); /* CONTINUE destination */ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - continueFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", + (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); } OP( POP); OP( POP); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); TclAdjustStackDepth(2, envPtr); /* RETURN + other destination */ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad return jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - returnFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", + (int) (CurrentOffset(envPtr) - returnFixup.codeOffset)); } if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad other jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - otherFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", + (int) (CurrentOffset(envPtr) - otherFixup.codeOffset)); } /* * Pull the result to top of stack, discard options dict. */ @@ -1732,22 +1709,22 @@ OP4( REVERSE, 2); OP( POP); /* OK destination */ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - okFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", + (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); } if (count > 1) { OP1(STR_CONCAT1, count); count = 1; } /* CONTINUE jump to here */ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad end jump distance %" TCL_Z_MODIFIER "d", - CurrentOffset(envPtr) - endFixup.codeOffset); + Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", + (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); } bline = envPtr->line; } while (count > 255) { @@ -1796,14 +1773,14 @@ int TclCompileSwitchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; /* Pointer to tokens in command. */ int numWords; /* Number of words in command. */ Tcl_Token *valueTokenPtr; /* Token for the value to switch on. */ enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode; @@ -1816,11 +1793,10 @@ int **bodyContLines; /* Array of continuation line info. */ int noCase; /* Has the -nocase flag been given? */ int foundMode = 0; /* Have we seen a mode flag yet? */ int i, valueIndex; int result = TCL_ERROR; - DefineLineInformation; /* TIP #280 */ int *clNext = envPtr->clNext; /* * Only handle the following versions: * switch ?--? word {pattern body ...} @@ -1864,12 +1840,12 @@ * them, so we punt if we *might* encounter them as that is the easiest * way of emulating the behaviour). */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { - register size_t size = tokenPtr[1].size; - register const char *chrs = tokenPtr[1].start; + unsigned size = tokenPtr[1].size; + const char *chrs = tokenPtr[1].start; /* * We only process literal options, and we assume that -e, -g and -n * are unique prefixes of -exact, -glob and -nocase respectively (true * at time of writing). Note that -exact and -glob may only be given @@ -1955,11 +1931,11 @@ * available at this point, this is pretty easy. */ if (numWords == 1) { const char *bytes; - size_t maxLen, numBytes; + int maxLen, numBytes; int bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after * the value we switch on. */ @@ -1972,14 +1948,14 @@ /* Allocate enough space to work in. */ maxLen = TclMaxListLength(bytes, numBytes, NULL); if (maxLen < 2) { return TCL_ERROR; } - bodyTokenArray = Tcl_Alloc(sizeof(Tcl_Token) * maxLen); - bodyToken = Tcl_Alloc(sizeof(Tcl_Token *) * maxLen); - bodyLines = Tcl_Alloc(sizeof(int) * maxLen); - bodyContLines = Tcl_Alloc(sizeof(int*) * maxLen); + bodyTokenArray = (Tcl_Token *)ckalloc(sizeof(Tcl_Token) * maxLen); + bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * maxLen); + bodyLines = (int *)ckalloc(sizeof(int) * maxLen); + bodyContLines = (int **)ckalloc(sizeof(int*) * maxLen); bline = mapPtr->loc[eclIndex].line[valueIndex+1]; numWords = 0; while (numBytes > 0) { @@ -2013,14 +1989,14 @@ numBytes -= (bytes - prevBytes); numWords++; } if (numWords % 2) { abort: - Tcl_Free(bodyToken); - Tcl_Free(bodyTokenArray); - Tcl_Free(bodyLines); - Tcl_Free(bodyContLines); + ckfree(bodyToken); + ckfree(bodyTokenArray); + ckfree(bodyLines); + ckfree(bodyContLines); return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { /* * Odd number of words (>1) available, or no words at all available. @@ -2034,13 +2010,13 @@ } else { /* * Multi-word definition of patterns & actions. */ - bodyToken = Tcl_Alloc(sizeof(Tcl_Token *) * numWords); - bodyLines = Tcl_Alloc(sizeof(int) * numWords); - bodyContLines = Tcl_Alloc(sizeof(int*) * numWords); + bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * numWords); + bodyLines = (int *)ckalloc(sizeof(int) * numWords); + bodyContLines = (int **)ckalloc(sizeof(int*) * numWords); bodyTokenArray = NULL; for (i=0 ; ihashTable, TCL_STRING_KEYS); infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); - finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2)); + finalFixups = (int *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2)); foundDefault = 0; mustGenerate = 1; /* * Next, issue the instruction to do the jump, together with what we want @@ -2571,12 +2545,12 @@ static ClientData DupJumptableInfo( ClientData clientData) { - JumptableInfo *jtPtr = clientData; - JumptableInfo *newJtPtr = Tcl_Alloc(sizeof(JumptableInfo)); + JumptableInfo *jtPtr = (JumptableInfo *)clientData; + JumptableInfo *newJtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo)); Tcl_HashEntry *hPtr, *newHPtr; Tcl_HashSearch search; int isNew; Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS); @@ -2591,32 +2565,32 @@ static void FreeJumptableInfo( ClientData clientData) { - JumptableInfo *jtPtr = clientData; + JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_DeleteHashTable(&jtPtr->hashTable); - Tcl_Free(jtPtr); + ckfree(jtPtr); } static void PrintJumptableInfo( ClientData clientData, Tcl_Obj *appendObj, - ByteCode *codePtr, + TCL_UNUSED(ByteCode *), unsigned int pcOffset) { - register JumptableInfo *jtPtr = clientData; + JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset, i = 0; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { - keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr); + keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); if (i++) { Tcl_AppendToObj(appendObj, ", ", -1); if (i%4==0) { @@ -2630,23 +2604,23 @@ static void DisassembleJumptableInfo( ClientData clientData, Tcl_Obj *dictObj, - ByteCode *codePtr, - unsigned int pcOffset) + TCL_UNUSED(ByteCode *), + TCL_UNUSED(unsigned int)) { - register JumptableInfo *jtPtr = clientData; + JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_Obj *mapping = Tcl_NewObj(); Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { - keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr); + keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1), Tcl_NewIntObj(offset)); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping); @@ -2673,12 +2647,11 @@ int TclCompileTailcallCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; @@ -2720,12 +2693,11 @@ int TclCompileThrowCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; @@ -2824,12 +2796,11 @@ int TclCompileTryCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { int numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR; Tcl_Token *bodyToken, *finallyToken, *tokenPtr; Tcl_Token **handlerTokens = NULL; @@ -2861,16 +2832,16 @@ */ numHandlers = numWords >> 2; numWords -= numHandlers * 4; if (numHandlers > 0) { - handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers); - matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers); + handlerTokens = (Tcl_Token**)TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers); + matchClauses = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers); memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers); - matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers); - resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers); - optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers); + matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); + resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); + optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); for (i=0 ; i 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (objc > 0) { - size_t len; + int len; const char *varname = TclGetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); if (resultVarIndices[i] < 0) { TclDecrRefCount(tmpObj); @@ -2947,11 +2918,11 @@ } } else { resultVarIndices[i] = -1; } if (objc == 2) { - size_t len; + int len; const char *varname = TclGetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); if (optionVarIndices[i] < 0) { TclDecrRefCount(tmpObj); @@ -3066,11 +3037,10 @@ Tcl_Token **handlerTokens) { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; - size_t slen; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; int *noError; char buf[TCL_INTEGER_SPACE]; resultVar = AnonymousLocal(envPtr); @@ -3128,13 +3098,13 @@ * For us to be here, there must be at least one handler. * * Slight overallocation, but reduces size of this function. */ - addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - noError = TclStackAlloc(interp, sizeof(int)*numHandlers); + addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers); + forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers); + noError = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers); for (i=0 ; inumWords != 3) { return TCL_ERROR; } @@ -3952,12 +3919,11 @@ int TclCompileYieldCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { if (parsePtr->numWords < 1 || parsePtr->numWords > 2) { return TCL_ERROR; } @@ -3995,12 +3961,11 @@ int TclCompileYieldToCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int i; @@ -4042,12 +4007,12 @@ Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { - Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -4084,12 +4049,12 @@ Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr) { - Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* TODO: Consider support for compiling expanded args. */ for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); @@ -4169,12 +4134,12 @@ Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr) { - Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { PUSH("1"); } else if (parsePtr->numWords == 3) { @@ -4245,34 +4210,31 @@ int TclCompileInvertOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr); } int TclCompileNotOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr); } int TclCompileAddOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD, envPtr); } @@ -4279,12 +4241,11 @@ int TclCompileMulOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT, envPtr); } @@ -4291,12 +4252,11 @@ int TclCompileAndOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND, envPtr); } @@ -4303,12 +4263,11 @@ int TclCompileOrOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR, envPtr); } @@ -4315,12 +4274,11 @@ int TclCompileXorOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR, envPtr); } @@ -4327,23 +4285,22 @@ int TclCompilePowOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = parsePtr->tokenPtr; + int words; + /* * This one has its own implementation because the ** operator is the only * one with right associativity. */ - Tcl_Token *tokenPtr = parsePtr->tokenPtr; - DefineLineInformation; /* TIP #280 */ - int words; - for (words=1 ; wordsnumWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { @@ -4358,78 +4315,71 @@ int TclCompileLshiftOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr); } int TclCompileRshiftOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr); } int TclCompileModOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr); } int TclCompileNeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr); } int TclCompileStrneqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr); } int TclCompileInOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr); } int TclCompileNiOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN, envPtr); } @@ -4436,126 +4386,115 @@ int TclCompileLessOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr); } int TclCompileLeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr); } int TclCompileGreaterOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr); } int TclCompileGeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr); } int TclCompileEqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr); } int TclCompileStreqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr); } int TclCompileStrLtOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LT, envPtr); } int TclCompileStrLeOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LE, envPtr); } int TclCompileStrGtOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GT, envPtr); } int TclCompileStrGeOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GE, envPtr); } int TclCompileMinusOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { - Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* @@ -4592,16 +4531,15 @@ int TclCompileDivOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) { - Tcl_Token *tokenPtr = parsePtr->tokenPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = parsePtr->tokenPtr; int words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* Index: generic/tclCompExpr.c ================================================================== --- generic/tclCompExpr.c +++ generic/tclCompExpr.c @@ -20,11 +20,11 @@ * expression in the form of a tree of operators, a list of literals, a list * of function names, and an array of Tcl_Token's within a Tcl_Parse struct. * The tree is composed of OpNodes. */ -typedef struct { +typedef struct OpNode { int left; /* "Pointer" to the left operand. */ int right; /* "Pointer" to the right operand. */ union { int parent; /* "Pointer" to the parent operand. */ int prev; /* "Pointer" joining incomplete tree stack */ @@ -507,20 +507,20 @@ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize); -static void ConvertTreeToTokens(const char *start, size_t numBytes, +static void ConvertTreeToTokens(const char *start, int numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, - size_t numBytes, OpNode **opTreePtr, + int numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, int parseOnly); -static size_t ParseLexeme(const char *start, size_t numBytes, +static int ParseLexeme(const char *start, int numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); /* *---------------------------------------------------------------------- * @@ -542,11 +542,11 @@ * message is written to interp. * * Side effects: * Memory will be allocated. If TCL_OK is returned, the caller must clean * up the returned data structures. The (OpNode *) value written to - * opTreePtr should be passed to Tcl_Free() and the parsePtr argument + * opTreePtr should be passed to ckfree() and the parsePtr argument * should be passed to Tcl_FreeParse(). The elements appended to the * litList and funcList will automatically be freed whenever the refcount * on those lists indicates they can be freed. * *---------------------------------------------------------------------- @@ -554,11 +554,11 @@ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - size_t numBytes, /* Number of bytes in string. */ + int numBytes, /* Number of bytes in string. */ OpNode **opTreePtr, /* Points to space where a pointer to the * allocated OpNode tree should go. */ Tcl_Obj *litList, /* List to append literals to. */ Tcl_Obj *funcList, /* List to append function names to. */ Tcl_Parse *parsePtr, /* Structure to fill with tokens representing @@ -577,11 +577,11 @@ * cost of only about 1 kibyte, and is large * enough for most expressions to parse with * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ - size_t scanned = 0; /* Capture number of byte scanned by parsing + int scanned = 0; /* Capture number of byte scanned by parsing * routines. */ int lastParsed; /* Stores info about what the lexeme parsed * the previous pass through the parsing loop * was. If it was an operator, lastParsed is * the index of the OpNode for that operator. @@ -621,19 +621,19 @@ * into the string being parsed to aid in * pinpointing the location of the syntax * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ - const unsigned limit = 25; /* Portions of the error message are + const int limit = 25; /* Portions of the error message are * constructed out of substrings of the * original expression. In order to keep the * error message readable, we impose this * limit on the substring size we extract. */ TclParseInit(interp, start, numBytes, parsePtr); - nodes = Tcl_AttemptAlloc(nodesAvailable * sizeof(OpNode)); + nodes = (OpNode *)attemptckalloc(nodesAvailable * sizeof(OpNode)); if (nodes == NULL) { TclNewLiteralStringObj(msg, "not enough memory to parse expression"); errCode = "NOMEM"; goto error; } @@ -673,11 +673,11 @@ unsigned int size = nodesUsed * 2; OpNode *newPtr = NULL; do { if (size <= UINT_MAX/sizeof(OpNode)) { - newPtr = Tcl_AttemptRealloc(nodes, size * sizeof(OpNode)); + newPtr = (OpNode *)attemptckrealloc(nodes, size * sizeof(OpNode)); } } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); if (newPtr == NULL) { TclNewLiteralStringObj(msg, @@ -708,16 +708,16 @@ int b; switch (lexeme) { case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", - (int)scanned, start); + scanned, start); errCode = "BADCHAR"; goto error; case INCOMPLETE: msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"", - (int)scanned, start); + scanned, start); errCode = "PARTOP"; goto error; case BAREWORD: /* @@ -742,20 +742,20 @@ } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { lexeme = BOOLEAN; } else { Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", - (scanned < limit) ? (int)scanned : (int)limit - 3, start, + (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", - (scanned < limit) ? (int)scanned : (int)limit - 3, + (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "...", - (scanned < limit) ? (int)scanned : (int)limit - 3, + (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", - (scanned < limit) ? (int)scanned : (int)limit - 3, + (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); errCode = "BAREWORD"; if (start[0] == '0') { const char *stop; TclParseNumber(NULL, NULL, NULL, start, scanned, @@ -917,11 +917,11 @@ } scanned = tokenPtr->size; break; case SCRIPT: { - Tcl_Parse *nestedPtr = + Tcl_Parse *nestedPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; tokenPtr->type = TCL_TOKEN_COMMAND; tokenPtr->start = start; @@ -1383,11 +1383,11 @@ /* * Free any partial parse tree we've built. */ if (nodes != NULL) { - Tcl_Free(nodes); + ckfree(nodes); } if (interp == NULL) { /* * Nowhere to report an error message, so just free it. @@ -1412,17 +1412,17 @@ */ Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < parsePtr->string) ? "" : "...", ((start - limit) < parsePtr->string) - ? (int) (start - parsePtr->string) : (int)limit - 3, + ? (int) (start - parsePtr->string) : limit - 3, ((start - limit) < parsePtr->string) ? parsePtr->string : start - limit + 3, - (scanned < limit) ? (int)scanned : (int)limit - 3, start, + (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "...", insertMark ? mark : "", (start + scanned + limit > parsePtr->end) - ? (int) (parsePtr->end - start) - (int)scanned : (int)limit-3, + ? (int) (parsePtr->end - start) - scanned : limit-3, start + scanned, (start + scanned + limit > parsePtr->end) ? "" : "..."); /* * Next, append any postscript message. @@ -1440,11 +1440,11 @@ */ numBytes = parsePtr->end - parsePtr->string; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing expression \"%.*s%s\")", - (numBytes < limit) ? (int)numBytes : (int)limit - 3, + (numBytes < limit) ? numBytes : limit - 3, parsePtr->string, (numBytes < limit) ? "" : "...")); if (errCode) { Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode, subErrCode, NULL); } @@ -1477,11 +1477,11 @@ */ static void ConvertTreeToTokens( const char *start, - size_t numBytes, + int numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) { int subExprTokenIdx = 0; @@ -1566,11 +1566,11 @@ */ TclGrowParseTokenArray(parsePtr, toCopy); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; memcpy(subExprTokenPtr, tokenPtr, - toCopy * sizeof(Tcl_Token)); + (size_t) toCopy * sizeof(Tcl_Token)); subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; parsePtr->numTokens += toCopy; } else { /* * Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to @@ -1583,11 +1583,11 @@ *subExprTokenPtr = *tokenPtr; subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; subExprTokenPtr->numComponents++; subExprTokenPtr++; memcpy(subExprTokenPtr, tokenPtr, - toCopy * sizeof(Tcl_Token)); + (size_t) toCopy * sizeof(Tcl_Token)); parsePtr->numTokens += toCopy + 1; } scanned = tokenPtr->start + tokenPtr->size - start; start += scanned; @@ -1825,11 +1825,11 @@ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - size_t numBytes, /* Number of bytes in string. If -1, the + int numBytes, /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Structure to fill with information about * the parsed expression; any previous * information in the structure is ignored. */ @@ -1836,14 +1836,14 @@ { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals. */ Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names. */ - Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ - if (numBytes == TCL_AUTO_LENGTH) { + if (numBytes < 0) { numBytes = (start ? strlen(start) : 0); } code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList, exprParsePtr, 1 /* parseOnly */); @@ -1859,11 +1859,11 @@ parsePtr->errorType = exprParsePtr->errorType; } Tcl_FreeParse(exprParsePtr); TclStackFree(interp, exprParsePtr); - Tcl_Free(opTree); + ckfree(opTree); return code; } /* *---------------------------------------------------------------------- @@ -1880,20 +1880,21 @@ * Code identifying lexeme parsed is writen to *lexemePtr. * *---------------------------------------------------------------------- */ -static size_t +static int ParseLexeme( const char *start, /* Start of lexeme to parse. */ - size_t numBytes, /* Number of bytes in string. */ + int numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this storage, if non-NULL. */ { const char *end; + int scanned; Tcl_UniChar ch = 0; Tcl_Obj *literal = NULL; unsigned char byte; if (numBytes == 0) { @@ -2097,11 +2098,10 @@ * Might be inspired by reserved identifier rules in C, which of course * have no direct relevance here. */ if (!TclIsBareword(*start) || *start == '_') { - size_t scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUniChar(start, &ch); } else { char utfBytes[4]; @@ -2147,18 +2147,18 @@ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ - size_t numBytes, /* Number of bytes in script. */ + int numBytes, /* Number of bytes in script. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int optimize) /* 0 for one-off expressions. */ { OpNode *opTree = NULL; /* Will point to the tree of operators */ Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */ Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/ - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions */ int code = ParseExpr(interp, script, numBytes, &opTree, litList, funcList, parsePtr, 0 /* parseOnly */); @@ -2185,11 +2185,11 @@ Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); - Tcl_Free(opTree); + ckfree(opTree); } /* *---------------------------------------------------------------------- * @@ -2224,11 +2224,11 @@ * Note we are compiling an expression with literal arguments. This means * there can be no [info frame] calls when we execute the resulting * bytecode, so there's no need to tend to TIP 280 issues. */ - envPtr = TclStackAlloc(interp, sizeof(CompileEnv)); + envPtr = (CompileEnv *)TclStackAlloc(interp, sizeof(CompileEnv)); TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0); CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, 0 /* optimize */); TclEmitOpcode(INST_DONE, envPtr); byteCodePtr = TclInitByteCode(envPtr); @@ -2295,11 +2295,11 @@ switch (nodePtr->lexeme) { case FUNCTION: { Tcl_DString cmdName; const char *p; - size_t length; + int length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = TclGetStringFromObj(*funcObjv, &length); funcObjv++; @@ -2319,17 +2319,17 @@ nodePtr->left = numWords; numWords = 2; /* Command plus one argument */ break; } case QUESTION: - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump); break; case COLON: - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpPtr->jump); TclAdjustStackDepth(-1, envPtr); @@ -2338,11 +2338,11 @@ } convert = 1; break; case AND: case OR: - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump); break; @@ -2454,11 +2454,11 @@ case OT_LITERAL: { Tcl_Obj *const *litObjv = *litObjvPtr; Tcl_Obj *literal = *litObjv; if (optimize) { - size_t length; + int length; const char *bytes = TclGetStringFromObj(literal, &length); int index = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index); if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { @@ -2513,13 +2513,13 @@ * already, then use it to share via the literal table. */ if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; - size_t numBytes; + int numBytes; const char *bytes - = TclGetStringFromObj(objPtr, &numBytes); + = Tcl_GetStringFromObj(objPtr, &numBytes); index = TclRegisterLiteral(envPtr, bytes, numBytes, 0); tableValue = TclFetchLiteral(envPtr, index); if ((tableValue->typePtr == NULL) && (objPtr->typePtr != NULL)) { @@ -2571,11 +2571,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - TclOpCmdClientData *occdPtr = clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; unsigned char lexeme; OpNode nodes[2]; Tcl_Obj *const *litObjv = objv + 1; if (objc != 1 + occdPtr->i.numArgs) { @@ -2629,14 +2629,14 @@ int code = TCL_OK; if (objc < 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } else { - TclOpCmdClientData *occdPtr = clientData; - Tcl_Obj **litObjv = TclStackAlloc(interp, + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; + Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp, 2 * (objc-2) * sizeof(Tcl_Obj *)); - OpNode *nodes = TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode)); + OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode)); unsigned char lexeme; int i, lastAnd = 1; Tcl_Obj *const *litObjPtrPtr = litObjv; ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL); @@ -2704,11 +2704,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - TclOpCmdClientData *occdPtr = clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; unsigned char lexeme; int code; if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity)); @@ -2759,11 +2759,11 @@ Tcl_DecrRefCount(litObjv[decrMe]); return code; } else { Tcl_Obj *const *litObjv = objv + 1; - OpNode *nodes = TclStackAlloc(interp, (objc-1) * sizeof(OpNode)); + OpNode *nodes = (OpNode *)TclStackAlloc(interp, (objc-1) * sizeof(OpNode)); int i, lastOp = OT_LITERAL; nodes[0].lexeme = START; nodes[0].mark = MARK_RIGHT; if (lexeme == EXPON) { @@ -2823,11 +2823,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - TclOpCmdClientData *occdPtr = clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected); return TCL_ERROR; } Index: generic/tclCompile.c ================================================================== --- generic/tclCompile.c +++ generic/tclCompile.c @@ -127,10 +127,14 @@ {"jumpFalse1", 2, -1, 1, {OPERAND_OFFSET1}}, /* Jump relative to (pc + op1) if stktop expr object is false */ {"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}}, /* Jump relative to (pc + op4) if stktop expr object is false */ + {"lor", 1, -1, 0, {OPERAND_NONE}}, + /* Logical or: push (stknext || stktop) */ + {"land", 1, -1, 0, {OPERAND_NONE}}, + /* Logical and: push (stknext && stktop) */ {"bitor", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise or: push (stknext | stktop) */ {"bitxor", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise xor push (stknext ^ stktop) */ {"bitand", 1, -1, 0, {OPERAND_NONE}}, @@ -167,18 +171,29 @@ /* Unary minus: push -stktop */ {"bitnot", 1, 0, 0, {OPERAND_NONE}}, /* Bitwise not: push ~stktop */ {"not", 1, 0, 0, {OPERAND_NONE}}, /* Logical not: push !stktop */ + {"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}}, + /* Call builtin math function with index op1; any args are on stk */ + {"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}}, + /* Call non-builtin func objv[0]; = */ {"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}}, /* Try converting stktop to first int then double if possible. */ {"break", 1, 0, 0, {OPERAND_NONE}}, /* Abort closest enclosing loop; if none, return TCL_BREAK code. */ {"continue", 1, 0, 0, {OPERAND_NONE}}, /* Skip to next iteration of closest enclosing loop; if none, return * TCL_CONTINUE code. */ + + {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}}, + /* Initialize execution of a foreach loop. Operand is aux data index + * of the ForeachInfo structure for the foreach command. */ + {"foreach_step4", 5, +1, 1, {OPERAND_AUX4}}, + /* "Step" or begin next iteration of foreach loop. Push 0 if to + * terminate loop, else push 1. */ {"beginCatch4", 5, 0, 1, {OPERAND_UINT4}}, /* Record start of catch with the operand's exception index. Push the * current stack depth onto a special catch stack. */ {"endCatch", 1, 0, 0, {OPERAND_NONE}}, @@ -323,10 +338,13 @@ * managed correctly. * Stack: ... dict => ... value key doneBool */ {"dictNext", 5, +3, 1, {OPERAND_LVT4}}, /* Get the next iteration from the iterator in op4's local scalar. * Stack: ... => ... value key doneBool */ + {"dictDone", 5, 0, 1, {OPERAND_LVT4}}, + /* Terminate the iterator in op4's local scalar. Use unsetScalar + * instead (with 0 for flags). */ {"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}}, /* Create the variables (described in the aux data referred to by the * second immediate argument) to mirror the state of the dictionary in * the variable referred to by the first immediate argument. The list * of keys (top of the stack, not popped) must be the same length as @@ -677,12 +695,11 @@ static void EnterCmdStartData(CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); -static int IsCompactibleCompileEnv(Tcl_Interp *interp, - CompileEnv *envPtr); +static int IsCompactibleCompileEnv(CompileEnv *envPtr); static void PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ static int SetByteCodeFromAny(Tcl_Interp *interp, @@ -777,18 +794,19 @@ ContLineLoc *clLocPtr; #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { if (Tcl_LinkVar(interp, "tcl_traceCompile", - (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { + &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable"); } traceInitialized = 1; } #endif - stringPtr = TclGetStringFromObj(objPtr, &length); + stringPtr = TclGetString(objPtr); + length = objPtr->length; /* * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and * use to initialize the tracking in the compiler. This information was * stored by TclCompEvalObj and ProcCompileProc. @@ -830,11 +848,11 @@ * faster code in some cases, and more compact code in more. */ if (Tcl_GetMaster(interp) == NULL && !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) - && IsCompactibleCompileEnv(interp, &compEnv)) { + && IsCompactibleCompileEnv(&compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); if (clLocPtr) { @@ -850,12 +868,12 @@ /* * Apply some peephole optimizations that can cross specific/generic * instruction generator boundaries. */ - if (iPtr->optimizer) { - (iPtr->optimizer)(&compEnv); + if (iPtr->extra.optimizer) { + (iPtr->extra.optimizer)(&compEnv); } /* * Invoke the compilation hook procedure if one exists. */ @@ -941,12 +959,12 @@ *---------------------------------------------------------------------- */ static void DupByteCodeInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + TCL_UNUSED(Tcl_Obj *) /*srcPtr*/, + TCL_UNUSED(Tcl_Obj *) /*copyPtr*/) { return; } /* @@ -969,11 +987,11 @@ *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( - register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); assert(codePtr != NULL); @@ -1000,18 +1018,18 @@ *---------------------------------------------------------------------- */ void TclPreserveByteCode( - register ByteCode *codePtr) + ByteCode *codePtr) { codePtr->refCount++; } void TclReleaseByteCode( - register ByteCode *codePtr) + ByteCode *codePtr) { if (codePtr->refCount-- > 1) { return; } @@ -1019,18 +1037,18 @@ CleanupByteCode(codePtr); } static void CleanupByteCode( - register ByteCode *codePtr) /* Points to the ByteCode to free. */ + ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; int numAuxDataItems = codePtr->numAuxDataItems; - register Tcl_Obj **objArrayPtr, *objPtr; - register const AuxData *auxDataPtr; + Tcl_Obj **objArrayPtr, *objPtr; + const AuxData *auxDataPtr; int i; #ifdef TCL_COMPILE_STATS if (interp != NULL) { ByteCodeStats *statsPtr; @@ -1127,21 +1145,21 @@ if (iPtr) { Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); if (hePtr) { - ReleaseCmdWordData(Tcl_GetHashValue(hePtr)); + ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr)); Tcl_DeleteHashEntry(hePtr); } } - if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) { + if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { TclFreeLocalCache(interp, codePtr->localCachePtr); } TclHandleRelease(codePtr->interpHandle); - Tcl_Free(codePtr); + ckfree(codePtr); } /* * --------------------------------------------------------------------- * @@ -1153,11 +1171,10 @@ * --------------------------------------------------------------------- */ static int IsCompactibleCompileEnv( - Tcl_Interp *interp, CompileEnv *envPtr) { unsigned char *pc; int size; @@ -1322,11 +1339,11 @@ codePtr = NULL; } } if (codePtr == NULL) { CompileEnv compEnv; - size_t numBytes; + int numBytes; const char *bytes = TclGetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); @@ -1371,13 +1388,13 @@ *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( - register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - register ByteCode *codePtr; + ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &substCodeType, codePtr); assert(codePtr != NULL); TclReleaseByteCode(codePtr); @@ -1391,18 +1408,18 @@ if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; inuloc ; i++) { - Tcl_Free(eclPtr->loc[i].line); + ckfree(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - Tcl_Free(eclPtr->loc); + ckfree(eclPtr->loc); } - Tcl_Free(eclPtr); + ckfree(eclPtr); } /* *---------------------------------------------------------------------- * @@ -1422,21 +1439,21 @@ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ - register CompileEnv *envPtr,/* Points to the CompileEnv structure to + CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ - size_t numBytes, /* Number of bytes in source string. */ + int numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting * compiled */ { Interp *iPtr = (Interp *) interp; - assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL); + assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL); envPtr->iPtr = iPtr; envPtr->source = stringPtr; envPtr->numSrcBytes = numBytes; envPtr->procPtr = iPtr->compiledProcPtr; @@ -1477,11 +1494,11 @@ * * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the * non-compiling evaluator */ - envPtr->extCmdMapPtr = Tcl_Alloc(sizeof(ExtCmdLoc)); + envPtr->extCmdMapPtr = (ExtCmdLoc *)ckalloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; @@ -1533,11 +1550,11 @@ * to that context. Note that the context can be byte code execution. * In that case we have to fill out the missing pieces (line, path, * ...) which may make change the type as well. */ - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); int pc = 0; *ctxPtr = *invoker; if (invoker->type == TCL_LOCATION_BC) { /* @@ -1629,14 +1646,14 @@ *---------------------------------------------------------------------- */ void TclFreeCompileEnv( - register CompileEnv *envPtr)/* Points to the CompileEnv structure. */ + CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ - Tcl_Free(envPtr->localLitTable.buckets); + ckfree(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { /* * We never converted to Bytecode, so free the things we would @@ -1662,24 +1679,24 @@ } auxDataPtr++; } } if (envPtr->mallocedCodeArray) { - Tcl_Free(envPtr->codeStart); + ckfree(envPtr->codeStart); } if (envPtr->mallocedLiteralArray) { - Tcl_Free(envPtr->literalArrayPtr); + ckfree(envPtr->literalArrayPtr); } if (envPtr->mallocedExceptArray) { - Tcl_Free(envPtr->exceptArrayPtr); - Tcl_Free(envPtr->exceptAuxArrayPtr); + ckfree(envPtr->exceptArrayPtr); + ckfree(envPtr->exceptAuxArrayPtr); } if (envPtr->mallocedCmdMap) { - Tcl_Free(envPtr->cmdMapPtr); + ckfree(envPtr->cmdMapPtr); } if (envPtr->mallocedAuxDataArray) { - Tcl_Free(envPtr->auxDataArrayPtr); + ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; } @@ -1741,11 +1758,11 @@ break; case TCL_TOKEN_BS: if (tempPtr != NULL) { char utfBuf[4] = ""; - size_t length = TclParseBackslash(tokenPtr->start, + int length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfBuf); Tcl_AppendToObj(tempPtr, utfBuf, length); } break; @@ -1784,11 +1801,11 @@ */ static int ExpandRequested( Tcl_Token *tokenPtr, - size_t numWords) + int numWords) { /* Determine whether any words of the command require expansion */ while (numWords--) { if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { return 1; @@ -1802,22 +1819,22 @@ CompileCmdLiteral( Tcl_Interp *interp, Tcl_Obj *cmdObj, CompileEnv *envPtr) { + int numBytes; const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; - size_t length; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } - bytes = TclGetStringFromObj(cmdObj, &length); - cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); + bytes = TclGetStringFromObj(cmdObj, &numBytes); + cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags); if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); } TclEmitPush(cmdLitIdx, envPtr); @@ -1826,16 +1843,15 @@ void TclCompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, - size_t numWords, + int numWords, CompileEnv *envPtr) { - size_t wordIdx = 0; - int depth = TclGetStackDepth(envPtr); DefineLineInformation; + int wordIdx = 0, depth = TclGetStackDepth(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr = TokenAfter(tokenPtr); @@ -1874,12 +1890,12 @@ Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, CompileEnv *envPtr) { - int wordIdx = 0; DefineLineInformation; + int wordIdx = 0; int depth = TclGetStackDepth(envPtr); StartExpanding(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1933,12 +1949,12 @@ Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr) { - int unwind = 0, incrOffset = -1; DefineLineInformation; + int unwind = 0, incrOffset = -1; int depth = TclGetStackDepth(envPtr); /* * Emit of the INST_START_CMD instruction is controlled by the value of * envPtr->atCmdStart: @@ -1995,11 +2011,11 @@ * Throw out any line information generated by the failed compile attempt. */ while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; - Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); + ckfree(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } /* * Reset the index of next command. Toss out any from failed nested @@ -2113,12 +2129,12 @@ * form now */ envPtr->line = cmdLine; envPtr->clNext = clNext; - Tcl_Free(eclPtr->loc[wlineat].line); - Tcl_Free(eclPtr->loc[wlineat].next); + ckfree(eclPtr->loc[wlineat].line); + ckfree(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; TclCheckStackDepth(depth, envPtr); return cmdIdx; @@ -2128,11 +2144,11 @@ TclCompileScript( Tcl_Interp *interp, /* Used for error and status reporting. Also * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ - size_t numBytes, /* Number of bytes in script. If -1, the + int numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last @@ -2139,29 +2155,52 @@ * command this routine compiles into bytecode. * Initial value of -1 indicates this routine * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ int depth = TclGetStackDepth(envPtr); + Interp *iPtr = (Interp *) interp; if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); } + /* + * Check depth to avoid overflow of the C execution stack by too many + * nested calls of TclCompileScript (considering interp recursionlimit). + * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition + * during "mixed" evaluation and compilation process (nested eval+compile) + * and is good enough for default recursionlimit (1000). + */ + if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many nested compilations (infinite loop?)", -1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); + TclCompileSyntaxError(interp, envPtr); + return; + } /* Each iteration compiles one command from the script. */ - while (numBytes + 1 > 1) { - Tcl_Parse parse; + if (numBytes > 0) { + /* + * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so + * many nested compilations (body enclosed in body) can cause abnormal + * program termination with a stack overflow exception, bug [fec0c17d39]. + */ + Tcl_Parse *parsePtr = (Tcl_Parse *)ckalloc(sizeof(Tcl_Parse)); + + do { const char *next; - if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) { + if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { /* - * Compile bytecodes to report the parse error at runtime. + * Compile bytecodes to report the parsePtr error at runtime. */ - Tcl_LogCommandInfo(interp, script, parse.commandStart, - parse.term + 1 - parse.commandStart); + Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, + parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); + ckfree(parsePtr); return; } #ifdef TCL_COMPILE_DEBUG /* @@ -2168,13 +2207,13 @@ * If tracing, print a line for each top level command compiled. * TODO: Suppress when numWords == 0 ? */ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { - int commandLength = parse.term - parse.commandStart; + int commandLength = parsePtr->term - parsePtr->commandStart; fprintf(stdout, " Compiling: "); - TclPrintSource(stdout, parse.commandStart, + TclPrintSource(stdout, parsePtr->commandStart, TclMin(commandLength, 55)); fprintf(stdout, "\n"); } #endif @@ -2181,52 +2220,63 @@ /* * TIP #280: Count newlines before the command start. * (See test info-30.33). */ - TclAdvanceLines(&envPtr->line, p, parse.commandStart); + TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, - parse.commandStart - envPtr->source); + parsePtr->commandStart - envPtr->source); /* * Advance parser to the next command in the script. */ - next = parse.commandStart + parse.commandSize; + next = parsePtr->commandStart + parsePtr->commandSize; numBytes -= next - p; p = next; - if (parse.numWords == 0) { + if (parsePtr->numWords == 0) { /* * The "command" parsed has no words. In this case we can skip * the rest of the loop body. With no words, clearly * CompileCommandTokens() has nothing to do. Since the parser * aggressively sucks up leading comment and white space, - * including newlines, parse.commandStart must be pointing at + * including newlines, parsePtr->commandStart must be pointing at * either the end of script, or a command-terminating semi-colon. * In either case, the TclAdvance*() calls have nothing to do. * Finally, when no words are parsed, no tokens have been - * allocated at parse.tokenPtr so there's also nothing for + * allocated at parsePtr->tokenPtr so there's also nothing for * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() - * can be written with an assumption that parse.numWords > 0, with + * can be written with an assumption that parsePtr->numWords > 0, with * the implication the CCT() always generates bytecode. */ continue; } - lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr); + /* + * Avoid stack exhaustion by too many nested calls of TclCompileScript + * (considering interp recursionlimit). + */ + iPtr->numLevels++; + + lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); + + iPtr->numLevels--; /* * TIP #280: Track lines in the just compiled command. */ - TclAdvanceLines(&envPtr->line, parse.commandStart, p); + TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p); TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, p - envPtr->source); - Tcl_FreeParse(&parse); + Tcl_FreeParse(parsePtr); + } while (numBytes > 0); + + ckfree(parsePtr); } if (lastCmdIdx == -1) { /* * Compiling the script yielded no bytecode. The script must be all @@ -2281,12 +2331,12 @@ Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - size_t i, nameBytes = tokenPtr[1].size; - int localVar, localVarName = 1; + int nameBytes = tokenPtr[1].size; + int i, localVar, localVarName = 1; /* * Determine how the variable name should be handled: if it contains any * namespace qualifiers it is not a local variable (localVarName=-1); if * it looks like an array element and the token has a single component, it @@ -2356,12 +2406,11 @@ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[4] = ""; - int i, numObjsToConcat, adjust; - size_t length; + int i, numObjsToConcat, length, adjust; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; int *clPosition = NULL; int depth = TclGetStackDepth(envPtr); @@ -2392,11 +2441,11 @@ } } if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = Tcl_Alloc(maxNumCL * sizeof(int)); + clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); } adjust = 0; Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; @@ -2433,11 +2482,11 @@ if (isLiteral) { int clPos = Tcl_DStringLength(&textBuffer); if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = Tcl_Realloc(clPosition, + clPosition = (int *)ckrealloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; numCL ++; } @@ -2491,11 +2540,11 @@ tokenPtr += tokenPtr->numComponents; break; default: Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s", - tokenPtr->type, (int)tokenPtr->size, tokenPtr->start); + tokenPtr->type, tokenPtr->size, tokenPtr->start); } } /* * Push any accumulated characters appearing at the end. @@ -2538,11 +2587,11 @@ * Release the temp table we used to collect the locations of continuation * lines, if any. */ if (maxNumCL) { - Tcl_Free(clPosition); + ckfree(clPosition); } TclCheckStackDepth(depth+1, envPtr); } /* @@ -2684,12 +2733,11 @@ int TclCompileNoOp( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; int i; @@ -2749,11 +2797,11 @@ * NOTE: [Bugs 3392070, 3389764] We make a copy based completely * on the string value, and do not call Tcl_DuplicateObj() so we * can be sure we do not have any lingering cycles hiding in * the intrep. */ - size_t numBytes; + int numBytes; const char *bytes = TclGetStringFromObj(objPtr, &numBytes); Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(copyPtr); TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); @@ -2763,17 +2811,17 @@ } } ByteCode * TclInitByteCode( - register CompileEnv *envPtr)/* Points to the CompileEnv structure from + CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { - register ByteCode *codePtr; + ByteCode *codePtr; size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes; size_t auxDataArrayBytes, structureSize; - register unsigned char *p; + unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; @@ -2807,11 +2855,11 @@ namespacePtr = envPtr->iPtr->varFramePtr->nsPtr; } else { namespacePtr = envPtr->iPtr->globalNsPtr; } - p = Tcl_Alloc(structureSize); + p = (unsigned char *)ckalloc(structureSize); codePtr = (ByteCode *) p; codePtr->interpHandle = TclHandlePreserve(iPtr->handle); codePtr->compileEpoch = iPtr->compileEpoch; codePtr->nsPtr = namespacePtr; codePtr->nsEpoch = namespacePtr->resolverEpoch; @@ -2904,11 +2952,11 @@ TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, - register CompileEnv *envPtr)/* Points to the CompileEnv structure from + CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; PreventCycle(objPtr, envPtr); @@ -2949,21 +2997,21 @@ *---------------------------------------------------------------------- */ int TclFindCompiledLocal( - register const char *name, /* Points to first character of the name of a + const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ - size_t nameBytes, /* Number of bytes in the name. */ + int nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { - register CompiledLocal *localPtr; + CompiledLocal *localPtr; int localVar = -1; - register int i; + int i; Proc *procPtr; /* * If not creating a temporary, does a local variable of the specified * name already exist? @@ -2978,20 +3026,21 @@ */ LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; - size_t len; + int len; if (!cachePtr || !name) { return -1; } varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { - localName = TclGetStringFromObj(*varNamePtr, &len); + localName = TclGetString(*varNamePtr); + len = (*varNamePtr)->length; if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } } } @@ -3005,11 +3054,11 @@ for (i = 0; i < localCt; i++) { if (!TclIsVarTemporary(localPtr)) { char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && - (strncmp(name,localName,nameBytes) == 0)) { + (strncmp(name, localName, nameBytes) == 0)) { return i; } } localPtr = localPtr->nextPtr; } @@ -3019,11 +3068,11 @@ * Create a new variable if appropriate. */ if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + nameBytes + 1); + localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; @@ -3069,11 +3118,11 @@ void TclExpandCodeArray( void *envArgPtr) /* Points to the CompileEnv whose code array * must be enlarged. */ { - CompileEnv *envPtr = envArgPtr; + CompileEnv *envPtr = (CompileEnv *)envArgPtr; /* The CompileEnv containing the code array to * be doubled in size. */ /* * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined @@ -3083,18 +3132,18 @@ size_t currBytes = envPtr->codeNext - envPtr->codeStart; size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart); if (envPtr->mallocedCodeArray) { - envPtr->codeStart = Tcl_Realloc(envPtr->codeStart, newBytes); + envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes); } else { /* - * envPtr->codeStart isn't a Tcl_Alloc'd pointer, so we must code a - * Tcl_Realloc equivalent for ourselves. + * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a + * ckrealloc equivalent for ourselves. */ - unsigned char *newPtr = Tcl_Alloc(newBytes); + unsigned char *newPtr = (unsigned char *)ckalloc(newBytes); memcpy(newPtr, envPtr->codeStart, currBytes); envPtr->codeStart = newPtr; envPtr->mallocedCodeArray = 1; } @@ -3150,18 +3199,18 @@ size_t newElems = 2 * currElems; size_t currBytes = currElems * sizeof(CmdLocation); size_t newBytes = newElems * sizeof(CmdLocation); if (envPtr->mallocedCmdMap) { - envPtr->cmdMapPtr = Tcl_Realloc(envPtr->cmdMapPtr, newBytes); + envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes); } else { /* - * envPtr->cmdMapPtr isn't a Tcl_Alloc'd pointer, so we must code a - * Tcl_Realloc equivalent for ourselves. + * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a + * ckrealloc equivalent for ourselves. */ - CmdLocation *newPtr = Tcl_Alloc(newBytes); + CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes); memcpy(newPtr, envPtr->cmdMapPtr, currBytes); envPtr->cmdMapPtr = newPtr; envPtr->mallocedCmdMap = 1; } @@ -3275,20 +3324,20 @@ size_t currElems = eclPtr->nloc; size_t newElems = (currElems ? 2*currElems : 1); size_t newBytes = newElems * sizeof(ECL); - eclPtr->loc = Tcl_Realloc(eclPtr->loc, newBytes); + eclPtr->loc = (ECL *)ckrealloc(eclPtr->loc, newBytes); eclPtr->nloc = newElems; } ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; - ePtr->line = Tcl_Alloc(numWords * sizeof(int)); - ePtr->next = Tcl_Alloc(numWords * sizeof(int *)); + ePtr->line = (int *)ckalloc(numWords * sizeof(int)); + ePtr->next = (int **)ckalloc(numWords * sizeof(int *)); ePtr->nline = numWords; - wwlines = Tcl_Alloc(numWords * sizeof(int)); + wwlines = (int *)ckalloc(numWords * sizeof(int)); last = cmd; wordLine = line; wordNext = clNext; for (wordIdx=0 ; wordIdxexceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* * Expand the ExceptionRange array. The currently allocated entries @@ -3353,21 +3402,21 @@ size_t newBytes = newElems * sizeof(ExceptionRange); size_t newBytes2 = newElems * sizeof(ExceptionAux); if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = - Tcl_Realloc(envPtr->exceptArrayPtr, newBytes); + (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes); envPtr->exceptAuxArrayPtr = - Tcl_Realloc(envPtr->exceptAuxArrayPtr, newBytes2); + (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* - * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so we must - * code a Tcl_Realloc equivalent for ourselves. + * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must + * code a ckrealloc equivalent for ourselves. */ - ExceptionRange *newPtr = Tcl_Alloc(newBytes); - ExceptionAux *newPtr2 = Tcl_Alloc(newBytes2); + ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes); + ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); envPtr->exceptArrayPtr = newPtr; envPtr->exceptAuxArrayPtr = newPtr2; @@ -3466,15 +3515,15 @@ if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) { auxPtr->allocBreakTargets *= 2; auxPtr->allocBreakTargets += 2; if (auxPtr->breakTargets) { - auxPtr->breakTargets = Tcl_Realloc(auxPtr->breakTargets, + auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets, sizeof(int) * auxPtr->allocBreakTargets); } else { auxPtr->breakTargets = - Tcl_Alloc(sizeof(int) * auxPtr->allocBreakTargets); + (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets); } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); } @@ -3492,15 +3541,15 @@ if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) { auxPtr->allocContinueTargets *= 2; auxPtr->allocContinueTargets += 2; if (auxPtr->continueTargets) { - auxPtr->continueTargets = Tcl_Realloc(auxPtr->continueTargets, + auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets, sizeof(int) * auxPtr->allocContinueTargets); } else { auxPtr->continueTargets = - Tcl_Alloc(sizeof(int) * auxPtr->allocContinueTargets); + (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets); } } auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = CurrentOffset(envPtr); TclEmitInstInt4(INST_JUMP4, 0, envPtr); @@ -3658,16 +3707,16 @@ /* * Drop the arrays we were holding the only reference to. */ if (auxPtr->breakTargets) { - Tcl_Free(auxPtr->breakTargets); + ckfree(auxPtr->breakTargets); auxPtr->breakTargets = NULL; auxPtr->numBreakTargets = 0; } if (auxPtr->continueTargets) { - Tcl_Free(auxPtr->continueTargets); + ckfree(auxPtr->continueTargets); auxPtr->continueTargets = NULL; auxPtr->numContinueTargets = 0; } } @@ -3698,15 +3747,15 @@ TclCreateAuxData( ClientData clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ - register CompileEnv *envPtr)/* Points to the CompileEnv for which a new + CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { int index; /* Index for the new AuxData structure. */ - register AuxData *auxDataPtr; + AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { /* @@ -3719,18 +3768,18 @@ int newElems = 2*envPtr->auxDataArrayEnd; size_t newBytes = newElems * sizeof(AuxData); if (envPtr->mallocedAuxDataArray) { envPtr->auxDataArrayPtr = - Tcl_Realloc(envPtr->auxDataArrayPtr, newBytes); + (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes); } else { /* - * envPtr->auxDataArrayPtr isn't a Tcl_Alloc'd pointer, so we must - * code a Tcl_Realloc equivalent for ourselves. + * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must + * code a ckrealloc equivalent for ourselves. */ - AuxData *newPtr = Tcl_Alloc(newBytes); + AuxData *newPtr = (AuxData *)ckalloc(newBytes); memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes); envPtr->auxDataArrayPtr = newPtr; envPtr->mallocedAuxDataArray = 1; } @@ -3761,11 +3810,11 @@ *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( - register JumpFixupArray *fixupArrayPtr) + JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * initialize. */ { fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace; fixupArrayPtr->next = 0; @@ -3793,11 +3842,11 @@ *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( - register JumpFixupArray *fixupArrayPtr) + JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * enlarge. */ { /* * The currently allocated jump fixup entries are stored from fixup[0] up @@ -3808,18 +3857,18 @@ size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup); int newElems = 2*(fixupArrayPtr->end + 1); size_t newBytes = newElems * sizeof(JumpFixup); if (fixupArrayPtr->mallocedArray) { - fixupArrayPtr->fixup = Tcl_Realloc(fixupArrayPtr->fixup, newBytes); + fixupArrayPtr->fixup = (JumpFixup *)ckrealloc(fixupArrayPtr->fixup, newBytes); } else { /* - * fixupArrayPtr->fixup isn't a Tcl_Alloc'd pointer, so we must code a - * Tcl_Realloc equivalent for ourselves. + * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a + * ckrealloc equivalent for ourselves. */ - JumpFixup *newPtr = Tcl_Alloc(newBytes); + JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes); memcpy(newPtr, fixupArrayPtr->fixup, currBytes); fixupArrayPtr->fixup = newPtr; fixupArrayPtr->mallocedArray = 1; } @@ -3842,16 +3891,16 @@ *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( - register JumpFixupArray *fixupArrayPtr) + JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * free. */ { if (fixupArrayPtr->mallocedArray) { - Tcl_Free(fixupArrayPtr->fixup); + ckfree(fixupArrayPtr->fixup); } } /* *---------------------------------------------------------------------- @@ -3947,11 +3996,11 @@ int distThreshold) /* Maximum distance before the two byte jump * is grown to five bytes. */ { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; - size_t numBytes; + unsigned numBytes; if (jumpDist <= distThreshold) { jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; switch (jumpFixupPtr->jumpType) { case TCL_UNCONDITIONAL_JUMP: @@ -4289,11 +4338,11 @@ GetCmdLocEncodingSize( CompileEnv *envPtr) /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ { - register CmdLocation *mapPtr = envPtr->cmdMapPtr; + CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; int codeDelta, codeLen, srcDelta, srcLen; int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext; /* The offsets in their respective byte * sequences where the next encoded offset or @@ -4373,15 +4422,15 @@ * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { - register CmdLocation *mapPtr = envPtr->cmdMapPtr; + CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; - register unsigned char *p = startPtr; + unsigned char *p = startPtr; int codeDelta, codeLen, srcDelta, srcLen, prevOffset; - register int i; + int i; /* * Encode the code offset for each command as a sequence of deltas. */ @@ -4491,11 +4540,11 @@ RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; - register ByteCodeStats *statsPtr; + ByteCodeStats *statsPtr; if (iPtr == NULL) { /* Avoid segfaulting in case we're called in a deleted interp */ return; } Index: generic/tclCompile.h ================================================================== --- generic/tclCompile.h +++ generic/tclCompile.h @@ -85,11 +85,11 @@ CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch * command. Errors in the range cause a jump * to a catch PC offset. */ } ExceptionRangeType; -typedef struct { +typedef struct ExceptionRange { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ int codeOffset; /* Offset of the first instruction byte of the @@ -160,11 +160,11 @@ * source's starting offset and length. Note that the code offset increases * monotonically: that is, the table is sorted in code offset order. The * source offset is not monotonic. */ -typedef struct { +typedef struct CmdLocation { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ int numSrcBytes; /* Number of command source chars. */ } CmdLocation; @@ -178,21 +178,21 @@ * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC. * Also recorded is information coming from the context, i.e. type of the * frame and associated information, like the path of a sourced file. */ -typedef struct { - size_t srcOffset; /* Command location to find the entry. */ +typedef struct ECL { + int srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ int **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; -typedef struct { +typedef struct ExtCmdLoc { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in * tclCompileObj. */ Tcl_Obj *path; /* Path of the sourced file the command is @@ -215,13 +215,13 @@ * to duplicate or free this auxiliary data when the containing ByteCode * objects are duplicated and freed. Pointers to these procedures are kept in * the AuxData structure. */ -typedef void *(AuxDataDupProc) (void *clientData); -typedef void (AuxDataFreeProc) (void *clientData); -typedef void (AuxDataPrintProc)(void *clientData, +typedef ClientData (AuxDataDupProc) (ClientData clientData); +typedef void (AuxDataFreeProc) (ClientData clientData); +typedef void (AuxDataPrintProc)(ClientData clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); /* * We define a separate AuxDataType struct to hold type-related information @@ -415,23 +415,23 @@ TclHandle interpHandle; /* Handle for interpreter containing the * compiled code. Commands and their compile * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - size_t compileEpoch; /* Value of iPtr->compileEpoch when this + unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ Namespace *nsPtr; /* Namespace context in which this code was * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this + unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ - size_t refCount; /* Reference count: set 1 when created plus 1 + unsigned int refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ unsigned int flags; /* flags describing state for the codebyte. * this variable holds ORed values from the @@ -527,309 +527,331 @@ #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), (typePtr)); \ - (codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in * tclCompile.c. Also, the order and number of the expression opcodes (e.g., - * INST_BITOR) must match the entries in the array operatorStrings in + * INST_LOR) must match the entries in the array operatorStrings in * tclExecute.c. */ -enum TclInstruction { - /* Opcodes 0 to 9 */ - INST_DONE = 0, - INST_PUSH1, - INST_PUSH4, - INST_POP, - INST_DUP, - INST_STR_CONCAT1, - INST_INVOKE_STK1, - INST_INVOKE_STK4, - INST_EVAL_STK, - INST_EXPR_STK, - - /* Opcodes 10 to 23 */ - INST_LOAD_SCALAR1, - INST_LOAD_SCALAR4, - INST_LOAD_SCALAR_STK, - INST_LOAD_ARRAY1, - INST_LOAD_ARRAY4, - INST_LOAD_ARRAY_STK, - INST_LOAD_STK, - INST_STORE_SCALAR1, - INST_STORE_SCALAR4, - INST_STORE_SCALAR_STK, - INST_STORE_ARRAY1, - INST_STORE_ARRAY4, - INST_STORE_ARRAY_STK, - INST_STORE_STK, - - /* Opcodes 24 to 33 */ - INST_INCR_SCALAR1, - INST_INCR_SCALAR_STK, - INST_INCR_ARRAY1, - INST_INCR_ARRAY_STK, - INST_INCR_STK, - INST_INCR_SCALAR1_IMM, - INST_INCR_SCALAR_STK_IMM, - INST_INCR_ARRAY1_IMM, - INST_INCR_ARRAY_STK_IMM, - INST_INCR_STK_IMM, - - /* Opcodes 34 to 39 */ - INST_JUMP1, - INST_JUMP4, - INST_JUMP_TRUE1, - INST_JUMP_TRUE4, - INST_JUMP_FALSE1, - INST_JUMP_FALSE4, - - /* Opcodes 42 to 64 */ - INST_BITOR, - INST_BITXOR, - INST_BITAND, - INST_EQ, - INST_NEQ, - INST_LT, - INST_GT, - INST_LE, - INST_GE, - INST_LSHIFT, - INST_RSHIFT, - INST_ADD, - INST_SUB, - INST_MULT, - INST_DIV, - INST_MOD, - INST_UPLUS, - INST_UMINUS, - INST_BITNOT, - INST_LNOT, - INST_TRY_CVT_TO_NUMERIC, - - /* Opcodes 65 to 66 */ - INST_BREAK, - INST_CONTINUE, - - /* Opcodes 69 to 72 */ - INST_BEGIN_CATCH4, - INST_END_CATCH, - INST_PUSH_RESULT, - INST_PUSH_RETURN_CODE, - - /* Opcodes 73 to 78 */ - INST_STR_EQ, - INST_STR_NEQ, - INST_STR_CMP, - INST_STR_LEN, - INST_STR_INDEX, - INST_STR_MATCH, - - /* Opcodes 79 to 81 */ - INST_LIST, - INST_LIST_INDEX, - INST_LIST_LENGTH, - - /* Opcodes 82 to 87 */ - INST_APPEND_SCALAR1, - INST_APPEND_SCALAR4, - INST_APPEND_ARRAY1, - INST_APPEND_ARRAY4, - INST_APPEND_ARRAY_STK, - INST_APPEND_STK, - - /* Opcodes 88 to 93 */ - INST_LAPPEND_SCALAR1, - INST_LAPPEND_SCALAR4, - INST_LAPPEND_ARRAY1, - INST_LAPPEND_ARRAY4, - INST_LAPPEND_ARRAY_STK, - INST_LAPPEND_STK, - - /* TIP #22 - LINDEX operator with flat arg list */ - INST_LIST_INDEX_MULTI, - - /* - * TIP #33 - 'lset' command. Code gen also required a Forth-like - * OVER operation. - */ - INST_OVER, - INST_LSET_LIST, - INST_LSET_FLAT, - - /* TIP#90 - 'return' command. */ - INST_RETURN_IMM, - - /* TIP#123 - exponentiation operator. */ - INST_EXPON, - - /* TIP #157 - {*}... (word expansion) language syntax support. */ - INST_EXPAND_START, - INST_EXPAND_STKTOP, - INST_INVOKE_EXPANDED, - - /* - * TIP #57 - 'lassign' command. Code generation requires immediate - * LINDEX and LRANGE operators. - */ - INST_LIST_INDEX_IMM, - INST_LIST_RANGE_IMM, - INST_START_CMD, - INST_LIST_IN, - INST_LIST_NOT_IN, - INST_PUSH_RETURN_OPTIONS, - INST_RETURN_STK, - - /* - * Dictionary (TIP#111) related commands. - */ - INST_DICT_GET, - INST_DICT_SET, - INST_DICT_UNSET, - INST_DICT_INCR_IMM, - INST_DICT_APPEND, - INST_DICT_LAPPEND, - INST_DICT_FIRST, - INST_DICT_NEXT, - INST_DICT_UPDATE_START, - INST_DICT_UPDATE_END, - - /* - * Instruction to support jumps defined by tables (instead of the classic - * [switch] technique of chained comparisons). - */ - INST_JUMP_TABLE, - - /* - * Instructions to support compilation of global, variable, upvar and - * [namespace upvar]. - */ - INST_UPVAR, - INST_NSUPVAR, - INST_VARIABLE, - - /* Instruction to support compiling syntax error to bytecode */ - INST_SYNTAX, - - /* Instruction to reverse N items on top of stack */ - INST_REVERSE, - - /* regexp instruction */ - INST_REGEXP, - - /* For [info exists] compilation */ - INST_EXIST_SCALAR, - INST_EXIST_ARRAY, - INST_EXIST_ARRAY_STK, - INST_EXIST_STK, - - /* For [subst] compilation */ - INST_NOP, - INST_RETURN_CODE_BRANCH, - - /* For [unset] compilation */ - INST_UNSET_SCALAR, - INST_UNSET_ARRAY, - INST_UNSET_ARRAY_STK, - INST_UNSET_STK, - - /* For [dict with], [dict exists], [dict create] and [dict merge] */ - INST_DICT_EXPAND, - INST_DICT_RECOMBINE_STK, - INST_DICT_RECOMBINE_IMM, - INST_DICT_EXISTS, - INST_DICT_VERIFY, - - /* For [string map] and [regsub] compilation */ - INST_STR_MAP, - INST_STR_FIND, - INST_STR_FIND_LAST, - INST_STR_RANGE_IMM, - INST_STR_RANGE, - - /* For operations to do with coroutines and other NRE-manipulators */ - INST_YIELD, - INST_COROUTINE_NAME, - INST_TAILCALL, - - /* For compilation of basic information operations */ - INST_NS_CURRENT, - INST_INFO_LEVEL_NUM, - INST_INFO_LEVEL_ARGS, - INST_RESOLVE_COMMAND, - - /* For compilation relating to TclOO */ - INST_TCLOO_SELF, - INST_TCLOO_CLASS, - INST_TCLOO_NS, - INST_TCLOO_IS_OBJECT, - - /* For compilation of [array] subcommands */ - INST_ARRAY_EXISTS_STK, - INST_ARRAY_EXISTS_IMM, - INST_ARRAY_MAKE_STK, - INST_ARRAY_MAKE_IMM, - - INST_INVOKE_REPLACE, - - INST_LIST_CONCAT, - - INST_EXPAND_DROP, - - /* New foreach implementation */ - INST_FOREACH_START, - INST_FOREACH_STEP, - INST_FOREACH_END, - INST_LMAP_COLLECT, - - /* For compilation of [string trim] and related */ - INST_STR_TRIM, - INST_STR_TRIM_LEFT, - INST_STR_TRIM_RIGHT, - - INST_CONCAT_STK, - - INST_STR_UPPER, - INST_STR_LOWER, - INST_STR_TITLE, - INST_STR_REPLACE, - - INST_ORIGIN_COMMAND, - - INST_TCLOO_NEXT, - INST_TCLOO_NEXT_CLASS, - - INST_YIELD_TO_INVOKE, - - INST_NUM_TYPE, - INST_TRY_CVT_TO_BOOLEAN, - INST_STR_CLASS, - - INST_LAPPEND_LIST, - INST_LAPPEND_LIST_ARRAY, - INST_LAPPEND_LIST_ARRAY_STK, - INST_LAPPEND_LIST_STK, - - INST_CLOCK_READ, - - INST_DICT_GET_DEF, - - /* TIP 461 */ - INST_STR_LT, - INST_STR_GT, - INST_STR_LE, - INST_STR_GE, - - /* The last opcode */ - LAST_INST_OPCODE -}; +/* Opcodes 0 to 9 */ +#define INST_DONE 0 +#define INST_PUSH1 1 +#define INST_PUSH4 2 +#define INST_POP 3 +#define INST_DUP 4 +#define INST_STR_CONCAT1 5 +#define INST_INVOKE_STK1 6 +#define INST_INVOKE_STK4 7 +#define INST_EVAL_STK 8 +#define INST_EXPR_STK 9 + +/* Opcodes 10 to 23 */ +#define INST_LOAD_SCALAR1 10 +#define INST_LOAD_SCALAR4 11 +#define INST_LOAD_SCALAR_STK 12 +#define INST_LOAD_ARRAY1 13 +#define INST_LOAD_ARRAY4 14 +#define INST_LOAD_ARRAY_STK 15 +#define INST_LOAD_STK 16 +#define INST_STORE_SCALAR1 17 +#define INST_STORE_SCALAR4 18 +#define INST_STORE_SCALAR_STK 19 +#define INST_STORE_ARRAY1 20 +#define INST_STORE_ARRAY4 21 +#define INST_STORE_ARRAY_STK 22 +#define INST_STORE_STK 23 + +/* Opcodes 24 to 33 */ +#define INST_INCR_SCALAR1 24 +#define INST_INCR_SCALAR_STK 25 +#define INST_INCR_ARRAY1 26 +#define INST_INCR_ARRAY_STK 27 +#define INST_INCR_STK 28 +#define INST_INCR_SCALAR1_IMM 29 +#define INST_INCR_SCALAR_STK_IMM 30 +#define INST_INCR_ARRAY1_IMM 31 +#define INST_INCR_ARRAY_STK_IMM 32 +#define INST_INCR_STK_IMM 33 + +/* Opcodes 34 to 39 */ +#define INST_JUMP1 34 +#define INST_JUMP4 35 +#define INST_JUMP_TRUE1 36 +#define INST_JUMP_TRUE4 37 +#define INST_JUMP_FALSE1 38 +#define INST_JUMP_FALSE4 39 + +/* Opcodes 40 to 64 */ +#define INST_LOR 40 +#define INST_LAND 41 +#define INST_BITOR 42 +#define INST_BITXOR 43 +#define INST_BITAND 44 +#define INST_EQ 45 +#define INST_NEQ 46 +#define INST_LT 47 +#define INST_GT 48 +#define INST_LE 49 +#define INST_GE 50 +#define INST_LSHIFT 51 +#define INST_RSHIFT 52 +#define INST_ADD 53 +#define INST_SUB 54 +#define INST_MULT 55 +#define INST_DIV 56 +#define INST_MOD 57 +#define INST_UPLUS 58 +#define INST_UMINUS 59 +#define INST_BITNOT 60 +#define INST_LNOT 61 +#define INST_CALL_BUILTIN_FUNC1 62 +#define INST_CALL_FUNC1 63 +#define INST_TRY_CVT_TO_NUMERIC 64 + +/* Opcodes 65 to 66 */ +#define INST_BREAK 65 +#define INST_CONTINUE 66 + +/* Opcodes 67 to 68 */ +#define INST_FOREACH_START4 67 /* DEPRECATED */ +#define INST_FOREACH_STEP4 68 /* DEPRECATED */ + +/* Opcodes 69 to 72 */ +#define INST_BEGIN_CATCH4 69 +#define INST_END_CATCH 70 +#define INST_PUSH_RESULT 71 +#define INST_PUSH_RETURN_CODE 72 + +/* Opcodes 73 to 78 */ +#define INST_STR_EQ 73 +#define INST_STR_NEQ 74 +#define INST_STR_CMP 75 +#define INST_STR_LEN 76 +#define INST_STR_INDEX 77 +#define INST_STR_MATCH 78 + +/* Opcodes 78 to 81 */ +#define INST_LIST 79 +#define INST_LIST_INDEX 80 +#define INST_LIST_LENGTH 81 + +/* Opcodes 82 to 87 */ +#define INST_APPEND_SCALAR1 82 +#define INST_APPEND_SCALAR4 83 +#define INST_APPEND_ARRAY1 84 +#define INST_APPEND_ARRAY4 85 +#define INST_APPEND_ARRAY_STK 86 +#define INST_APPEND_STK 87 + +/* Opcodes 88 to 93 */ +#define INST_LAPPEND_SCALAR1 88 +#define INST_LAPPEND_SCALAR4 89 +#define INST_LAPPEND_ARRAY1 90 +#define INST_LAPPEND_ARRAY4 91 +#define INST_LAPPEND_ARRAY_STK 92 +#define INST_LAPPEND_STK 93 + +/* TIP #22 - LINDEX operator with flat arg list */ + +#define INST_LIST_INDEX_MULTI 94 + +/* + * TIP #33 - 'lset' command. Code gen also required a Forth-like + * OVER operation. + */ + +#define INST_OVER 95 +#define INST_LSET_LIST 96 +#define INST_LSET_FLAT 97 + +/* TIP#90 - 'return' command. */ + +#define INST_RETURN_IMM 98 + +/* TIP#123 - exponentiation operator. */ + +#define INST_EXPON 99 + +/* TIP #157 - {*}... (word expansion) language syntax support. */ + +#define INST_EXPAND_START 100 +#define INST_EXPAND_STKTOP 101 +#define INST_INVOKE_EXPANDED 102 + +/* + * TIP #57 - 'lassign' command. Code generation requires immediate + * LINDEX and LRANGE operators. + */ + +#define INST_LIST_INDEX_IMM 103 +#define INST_LIST_RANGE_IMM 104 + +#define INST_START_CMD 105 + +#define INST_LIST_IN 106 +#define INST_LIST_NOT_IN 107 + +#define INST_PUSH_RETURN_OPTIONS 108 +#define INST_RETURN_STK 109 + +/* + * Dictionary (TIP#111) related commands. + */ + +#define INST_DICT_GET 110 +#define INST_DICT_SET 111 +#define INST_DICT_UNSET 112 +#define INST_DICT_INCR_IMM 113 +#define INST_DICT_APPEND 114 +#define INST_DICT_LAPPEND 115 +#define INST_DICT_FIRST 116 +#define INST_DICT_NEXT 117 +#define INST_DICT_DONE 118 +#define INST_DICT_UPDATE_START 119 +#define INST_DICT_UPDATE_END 120 + +/* + * Instruction to support jumps defined by tables (instead of the classic + * [switch] technique of chained comparisons). + */ + +#define INST_JUMP_TABLE 121 + +/* + * Instructions to support compilation of global, variable, upvar and + * [namespace upvar]. + */ + +#define INST_UPVAR 122 +#define INST_NSUPVAR 123 +#define INST_VARIABLE 124 + +/* Instruction to support compiling syntax error to bytecode */ + +#define INST_SYNTAX 125 + +/* Instruction to reverse N items on top of stack */ + +#define INST_REVERSE 126 + +/* regexp instruction */ + +#define INST_REGEXP 127 + +/* For [info exists] compilation */ +#define INST_EXIST_SCALAR 128 +#define INST_EXIST_ARRAY 129 +#define INST_EXIST_ARRAY_STK 130 +#define INST_EXIST_STK 131 + +/* For [subst] compilation */ +#define INST_NOP 132 +#define INST_RETURN_CODE_BRANCH 133 + +/* For [unset] compilation */ +#define INST_UNSET_SCALAR 134 +#define INST_UNSET_ARRAY 135 +#define INST_UNSET_ARRAY_STK 136 +#define INST_UNSET_STK 137 + +/* For [dict with], [dict exists], [dict create] and [dict merge] */ +#define INST_DICT_EXPAND 138 +#define INST_DICT_RECOMBINE_STK 139 +#define INST_DICT_RECOMBINE_IMM 140 +#define INST_DICT_EXISTS 141 +#define INST_DICT_VERIFY 142 + +/* For [string map] and [regsub] compilation */ +#define INST_STR_MAP 143 +#define INST_STR_FIND 144 +#define INST_STR_FIND_LAST 145 +#define INST_STR_RANGE_IMM 146 +#define INST_STR_RANGE 147 + +/* For operations to do with coroutines and other NRE-manipulators */ +#define INST_YIELD 148 +#define INST_COROUTINE_NAME 149 +#define INST_TAILCALL 150 + +/* For compilation of basic information operations */ +#define INST_NS_CURRENT 151 +#define INST_INFO_LEVEL_NUM 152 +#define INST_INFO_LEVEL_ARGS 153 +#define INST_RESOLVE_COMMAND 154 + +/* For compilation relating to TclOO */ +#define INST_TCLOO_SELF 155 +#define INST_TCLOO_CLASS 156 +#define INST_TCLOO_NS 157 +#define INST_TCLOO_IS_OBJECT 158 + +/* For compilation of [array] subcommands */ +#define INST_ARRAY_EXISTS_STK 159 +#define INST_ARRAY_EXISTS_IMM 160 +#define INST_ARRAY_MAKE_STK 161 +#define INST_ARRAY_MAKE_IMM 162 + +#define INST_INVOKE_REPLACE 163 + +#define INST_LIST_CONCAT 164 + +#define INST_EXPAND_DROP 165 + +/* New foreach implementation */ +#define INST_FOREACH_START 166 +#define INST_FOREACH_STEP 167 +#define INST_FOREACH_END 168 +#define INST_LMAP_COLLECT 169 + +/* For compilation of [string trim] and related */ +#define INST_STR_TRIM 170 +#define INST_STR_TRIM_LEFT 171 +#define INST_STR_TRIM_RIGHT 172 + +#define INST_CONCAT_STK 173 + +#define INST_STR_UPPER 174 +#define INST_STR_LOWER 175 +#define INST_STR_TITLE 176 +#define INST_STR_REPLACE 177 + +#define INST_ORIGIN_COMMAND 178 + +#define INST_TCLOO_NEXT 179 +#define INST_TCLOO_NEXT_CLASS 180 + +#define INST_YIELD_TO_INVOKE 181 + +#define INST_NUM_TYPE 182 +#define INST_TRY_CVT_TO_BOOLEAN 183 +#define INST_STR_CLASS 184 + +#define INST_LAPPEND_LIST 185 +#define INST_LAPPEND_LIST_ARRAY 186 +#define INST_LAPPEND_LIST_ARRAY_STK 187 +#define INST_LAPPEND_LIST_STK 188 + +#define INST_CLOCK_READ 189 + +#define INST_DICT_GET_DEF 190 + +/* TIP 461 */ +#define INST_STR_LT 191 +#define INST_STR_GT 192 +#define INST_STR_LE 193 +#define INST_STR_GE 194 + +/* The last opcode */ +#define LAST_INST_OPCODE 194 /* * Table describing the Tcl bytecode instructions: their name (for displaying * code), total number of code bytes required (including operand bytes), and a * description of the type of each operand. These operand types include signed @@ -863,11 +885,11 @@ OPERAND_SCLS1 /* Index into tclStringClassTable. */ } InstOperandType; typedef struct InstructionDesc { const char *name; /* Name of instruction. */ - size_t numBytes; /* Total number of bytes for instruction. */ + int numBytes; /* Total number of bytes for instruction. */ int stackEffect; /* The worst-case balance stack effect of the * instruction, used for stack requirements * computations. The value INT_MIN signals * that the instruction's worst case effect is * (1-opnd1). */ @@ -1021,11 +1043,11 @@ * needed during program execution. These structures are stored in CompileEnv * and ByteCode structures as auxiliary data. */ typedef struct { - size_t length; /* Size of array */ + int length; /* Size of array */ int varIndices[1]; /* 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 * take account of this. MUST BE LAST FIELD IN @@ -1076,34 +1098,34 @@ ExceptionAux *auxPtr); MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, - size_t numBytes, CompileEnv *envPtr, int optimize); + int numBytes, CompileEnv *envPtr, int optimize); MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, - Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords, + Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, - const char *script, size_t numBytes, + const char *script, int numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); -MODULE_SCOPE int TclCreateAuxData(void *clientData, +MODULE_SCOPE int TclCreateAuxData(ClientData clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); -MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); +MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, - size_t length, size_t hash, int *newPtr, + int length, unsigned int hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); @@ -1113,26 +1135,26 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); -MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, size_t index); -MODULE_SCOPE int TclFindCompiledLocal(const char *name, size_t nameChars, +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index); +MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, int distThreshold); MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr); MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr, - size_t before, size_t after, int *indexPtr); + int before, int after, int *indexPtr); MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr); MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, - size_t numBytes, const CmdFrame *invoker, int word); + int numBytes, const CmdFrame *invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, int returnCode, ExceptionAux **auxPtrPtr); MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr, @@ -1143,11 +1165,11 @@ int range); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif -MODULE_SCOPE int TclLocalScalar(const char *bytes, size_t numBytes, +MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes, CompileEnv *envPtr); MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG @@ -1155,32 +1177,32 @@ Tcl_Obj *objPtr); #endif MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, const unsigned char *pc); MODULE_SCOPE void TclPrintObject(FILE *outFile, - Tcl_Obj *objPtr, size_t maxChars); + Tcl_Obj *objPtr, int maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, - const char *string, size_t maxChars); + const char *string, int maxChars); MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *isScalarPtr); MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); -MODULE_SCOPE int TclSingleOpCmd(void *clientData, +MODULE_SCOPE int TclSingleOpCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclSortingOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclSortingOpCmd(void *clientData, +MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclVariadicOpCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNoIdentOpCmd(void *clientData, +MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr); MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr); @@ -1187,17 +1209,17 @@ #endif MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - size_t length, const unsigned char *pc, + int length, const unsigned char *pc, Tcl_Obj **tosPtr); 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 int TclPushProcCallFrame(void *clientData, - register Tcl_Interp *interp, int objc, +MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); /* *---------------------------------------------------------------- @@ -1207,11 +1229,11 @@ */ /* * Simplified form to access AuxData. * - * void *TclFetchAuxData(CompileEng *envPtr, int index); + * ClientData TclFetchAuxData(CompileEng *envPtr, int index); */ #define TclFetchAuxData(envPtr, index) \ (envPtr)->auxDataArrayPtr[(index)].clientData @@ -1381,11 +1403,11 @@ * void TclEmitPush(int objIndex, CompileEnv *envPtr); */ #define TclEmitPush(objIndex, envPtr) \ do { \ - register int _objIndexCopy = (objIndex); \ + int _objIndexCopy = (objIndex); \ if (_objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ } else { \ TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ } \ @@ -1526,19 +1548,19 @@ /* * Convenience macros for use when pushing literals. The ANSI C "prototype" for * these macros are: * * static void PushLiteral(CompileEnv *envPtr, - * const char *string, size_t length); + * const char *string, int length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ #define PushLiteral(envPtr, string, length) \ TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr)) #define PushStringLiteral(envPtr, string) \ - PushLiteral(envPtr, string, sizeof(string "") - 1) + PushLiteral(envPtr, string, (int) (sizeof(string "") - 1)) /* * Macro to advance to the next token; it is more mnemonic than the address * arithmetic that it replaces. The ANSI C "prototype" for this macro is: * @@ -1550,11 +1572,11 @@ /* * Macro to get the offset to the next instruction to be issued. The ANSI C * "prototype" for this macro is: * - * static ptrdiff_t CurrentOffset(CompileEnv *envPtr); + * static int CurrentOffset(CompileEnv *envPtr); */ #define CurrentOffset(envPtr) \ ((envPtr)->codeNext - (envPtr)->codeStart) @@ -1802,12 +1824,12 @@ int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ int tclDTraceDebugIndent = 0; \ FILE *tclDTraceDebugLog = NULL; \ void TclDTraceOpenDebugLog(void) { \ char n[35]; \ - sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ - (size_t) getpid()); \ + sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \ + (unsigned long) getpid()); \ tclDTraceDebugLog = fopen(n, "a"); \ } #define TclDTraceDbgMsg(p, m, ...) \ do { \ Index: generic/tclConfig.c ================================================================== --- generic/tclConfig.c +++ generic/tclConfig.c @@ -29,27 +29,24 @@ * A ClientData struct for the QueryConfig command. Store the three bits * of data we need; the package name for which we store a config dict, * the (Tcl_Interp *) in which it is stored, and the encoding. */ -typedef struct { +typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; char *encoding; } QCCD; /* * Static functions in this file: */ -static int QueryConfigObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - struct Tcl_Obj *const *objv); -static void QueryConfigDelete(ClientData clientData); +static Tcl_ObjCmdProc QueryConfigObjCmd; +static Tcl_CmdDeleteProc QueryConfigDelete; +static Tcl_InterpDeleteProc ConfigDictDeleteProc; static Tcl_Obj * GetConfigDict(Tcl_Interp *interp); -static void ConfigDictDeleteProc(ClientData clientData, - Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * Tcl_RegisterConfig -- @@ -77,15 +74,15 @@ * configuration values, ASCII, thus UTF-8. */ { Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; const Tcl_Config *cfg; - QCCD *cdPtr = Tcl_Alloc(sizeof(QCCD)); + QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; if (valEncoding) { - cdPtr->encoding = Tcl_Alloc(strlen(valEncoding)+1); + cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; } cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); @@ -197,15 +194,14 @@ ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv) { - QCCD *cdPtr = clientData; + QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; - size_t n = 0; - int index, m; + int n, index; static const char *const subcmdStrings[] = { "get", "list", NULL }; enum subcmds { CFG_GET, CFG_LIST @@ -260,11 +256,11 @@ } /* * Value is stored as-is in a byte array, see Bug [9b2e636361], * so we have to decode it first. */ - value = (const char *) TclGetByteArrayFromObj(val, &n); + value = (const char *) Tcl_GetByteArrayFromObj(val, &n); value = Tcl_ExternalToUtfDString(venc, value, n, &conv); Tcl_SetObjResult(interp, Tcl_NewStringObj(value, Tcl_DStringLength(&conv))); Tcl_DStringFree(&conv); return TCL_OK; @@ -273,21 +269,21 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_DictObjSize(interp, pkgDict, &m); - listPtr = Tcl_NewListObj(m, NULL); + Tcl_DictObjSize(interp, pkgDict, &n); + listPtr = Tcl_NewListObj(n, NULL); if (!listPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "insufficient memory to create list", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } - if (m) { + if (n) { Tcl_DictSearch s; Tcl_Obj *key; int done; for (Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done); @@ -325,20 +321,20 @@ static void QueryConfigDelete( ClientData clientData) { - QCCD *cdPtr = clientData; + QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); if (cdPtr->encoding) { - Tcl_Free(cdPtr->encoding); + ckfree(cdPtr->encoding); } - Tcl_Free(cdPtr); + ckfree(cdPtr); } /* *------------------------------------------------------------------------- * @@ -358,11 +354,11 @@ static Tcl_Obj * GetConfigDict( Tcl_Interp *interp) { - Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL); + Tcl_Obj *pDB = (Tcl_Obj *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL); if (pDB == NULL) { pDB = Tcl_NewDictObj(); Tcl_IncrRefCount(pDB); Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB); @@ -391,19 +387,17 @@ */ static void ConfigDictDeleteProc( ClientData clientData, /* Pointer to Tcl_Obj. */ - Tcl_Interp *interp) /* Interpreter being deleted. */ + TCL_UNUSED(Tcl_Interp *)) { - Tcl_Obj *pDB = clientData; - - Tcl_DecrRefCount(pDB); + Tcl_DecrRefCount((Tcl_Obj *)clientData); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclDTrace.d ================================================================== --- generic/tclDTrace.d +++ generic/tclDTrace.d @@ -8,11 +8,10 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ typedef struct Tcl_Obj Tcl_Obj; -typedef const char* TclDTraceStr; /* * Tcl DTrace probes */ @@ -23,39 +22,39 @@ * triggered immediately before proc bytecode execution * arg0: proc name (string) * arg1: number of arguments (int) * arg2: array of proc argument objects (Tcl_Obj**) */ - probe proc__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv); + probe proc__entry(const char *name, int objc, struct Tcl_Obj **objv); /* * tcl*:::proc-return probe * triggered immediately after proc bytecode execution * arg0: proc name (string) * arg1: return code (int) */ - probe proc__return(TclDTraceStr name, int code); + probe proc__return(const char *name, int code); /* * tcl*:::proc-result probe * triggered after proc-return probe and result processing * arg0: proc name (string) * arg1: return code (int) * arg2: proc result (string) * arg3: proc result object (Tcl_Obj*) */ - probe proc__result(TclDTraceStr name, int code, TclDTraceStr result, + probe proc__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::proc-args probe * triggered before proc-entry probe, gives access to string * representation of proc arguments * arg0: proc name (string) * arg1-arg9: proc arguments or NULL (strings) */ - probe proc__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2, - TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5, - TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8, - TclDTraceStr arg9); + probe proc__args(const char *name, const char *arg1, const char *arg2, + const char *arg3, const char *arg4, const char *arg5, + const char *arg6, const char *arg7, const char *arg8, + const char *arg9); /* * tcl*:::proc-info probe * triggered before proc-entry probe, gives access to TIP 280 * information for the proc invocation (i.e. [info frame 0]) * arg0: TIP 280 cmd (string) @@ -65,51 +64,51 @@ * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ - probe proc__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc, - TclDTraceStr file, int line, int level, TclDTraceStr method, - TclDTraceStr class); + probe proc__info(const char *cmd, const char *type, const char *proc, + const char *file, int line, int level, const char *method, + const char *class); /***************************** cmd probes ******************************/ /* * tcl*:::cmd-entry probe * triggered immediately before commmand execution * arg0: command name (string) * arg1: number of arguments (int) * arg2: array of command argument objects (Tcl_Obj**) */ - probe cmd__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv); + probe cmd__entry(const char *name, int objc, struct Tcl_Obj **objv); /* * tcl*:::cmd-return probe * triggered immediately after commmand execution * arg0: command name (string) * arg1: return code (int) */ - probe cmd__return(TclDTraceStr name, int code); + probe cmd__return(const char *name, int code); /* * tcl*:::cmd-result probe * triggered after cmd-return probe and result processing * arg0: command name (string) * arg1: return code (int) * arg2: command result (string) * arg3: command result object (Tcl_Obj*) */ - probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result, + probe cmd__result(const char *name, int code, const char *result, struct Tcl_Obj *resultobj); /* * tcl*:::cmd-args probe * triggered before cmd-entry probe, gives access to string * representation of command arguments * arg0: command name (string) * arg1-arg9: command arguments or NULL (strings) */ - probe cmd__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2, - TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5, - TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8, - TclDTraceStr arg9); + probe cmd__args(const char *name, const char *arg1, const char *arg2, + const char *arg3, const char *arg4, const char *arg5, + const char *arg6, const char *arg7, const char *arg8, + const char *arg9); /* * tcl*:::cmd-info probe * triggered before cmd-entry probe, gives access to TIP 280 * information for the command invocation (i.e. [info frame 0]) * arg0: TIP 280 cmd (string) @@ -119,31 +118,31 @@ * arg4: TIP 280 line (int) * arg5: TIP 280 level (int) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ - probe cmd__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc, - TclDTraceStr file, int line, int level, TclDTraceStr method, - TclDTraceStr class); + probe cmd__info(const char *cmd, const char *type, const char *proc, + const char *file, int line, int level, const char *method, + const char *class); /***************************** inst probes *****************************/ /* * tcl*:::inst-start probe * triggered immediately before execution of a bytecode * arg0: bytecode name (string) * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ - probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack); + probe inst__start(const char *name, int depth, struct Tcl_Obj **stack); /* * tcl*:::inst-done probe * triggered immediately after execution of a bytecode * arg0: bytecode name (string) * arg1: depth of stack (int) * arg2: top of stack (Tcl_Obj**) */ - probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack); + probe inst__done(const char *name, int depth, struct Tcl_Obj **stack); /***************************** obj probes ******************************/ /* * tcl*:::obj-create probe * triggered immediately after a new Tcl_Obj has been created @@ -161,33 +160,33 @@ /* * tcl*:::tcl-probe probe * triggered when the ::tcl::dtrace command is called * arg0-arg9: command arguments (strings) */ - probe tcl__probe(TclDTraceStr arg0, TclDTraceStr arg1, TclDTraceStr arg2, - TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5, - TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8, - TclDTraceStr arg9); + probe tcl__probe(const char *arg0, const char *arg1, const char *arg2, + const char *arg3, const char *arg4, const char *arg5, + const char *arg6, const char *arg7, const char *arg8, + const char *arg9); }; /* * Tcl types and constants for use in DTrace scripts */ typedef struct Tcl_ObjType { - char *name; + const char *name; void *freeIntRepProc; void *dupIntRepProc; void *updateStringProc; void *setFromAnyProc; } Tcl_ObjType; struct Tcl_Obj { - size_t refCount; + int refCount; char *bytes; - size_t length; - Tcl_ObjType *typePtr; + int length; + const Tcl_ObjType *typePtr; union { long longValue; double doubleValue; void *otherValuePtr; int64_t wideValue; Index: generic/tclDate.c ================================================================== --- generic/tclDate.c +++ generic/tclDate.c @@ -91,10 +91,21 @@ */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ + +/* + * Meridian: am, pm, or 24-hour style. + */ + +typedef enum _MERIDIAN { + MERam, MERpm, MER24 +} MERIDIAN; + + + /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ @@ -110,11 +121,11 @@ int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; - int dateMeridian; + MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; @@ -136,12 +147,12 @@ time_t *dateRelPointer; int dateDigitCount; } DateInfo; -#define YYMALLOC Tcl_Alloc -#define YYFREE(x) (Tcl_Free((void*) (x))) +#define YYMALLOC ckalloc +#define YYFREE(x) (ckfree((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) #define yyDayNumber (info->dateDayNumber) #define yyMonthOrdinal (info->dateMonthOrdinal) @@ -196,21 +207,10 @@ */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; - -/* - * Meridian: am, pm, or 24-hour style. - */ - -typedef enum _MERIDIAN { - MERam, MERpm, MER24 -} MERIDIAN; - - - # ifndef YY_NULLPTR # if defined __cplusplus && 201103L <= __cplusplus # define YY_NULLPTR nullptr # else @@ -2547,13 +2547,13 @@ static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { - register char *p; - register char *q; - register const TABLE *tp; + char *p; + char *q; + const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ @@ -2672,18 +2672,18 @@ TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { - register char c; - register char *p; + char c; + char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { - while (TclIsSpaceProc(UCHAR(*yyInput))) { + while (TclIsSpaceProcM(*yyInput)) { yyInput++; } if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ /* @@ -2742,11 +2742,11 @@ } } int TclClockOldscanObjCmd( - void *clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Count of paraneters */ Tcl_Obj *const *objv) /* Parameters */ { Tcl_Obj *result, *resultElement; @@ -2759,11 +2759,11 @@ Tcl_WrongNumArgs(interp, 1, objv, "stringToParse baseYear baseMonth baseDay" ); return TCL_ERROR; } - yyInput = TclGetString(objv[1]); + yyInput = Tcl_GetString( objv[1] ); dateInfo.dateStart = yyInput; yyHaveDate = 0; if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK @@ -2846,60 +2846,60 @@ result = Tcl_NewObj(); resultElement = Tcl_NewObj(); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyYear)); + Tcl_NewIntObj((int) yyYear)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyMonth)); + Tcl_NewIntObj((int) yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyDay)); + Tcl_NewIntObj((int) yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj( - ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian))); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) + ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); } resultElement = Tcl_NewObj(); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(-yyTimezone)); + Tcl_NewIntObj((int) -yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyRelMonth)); + Tcl_NewIntObj((int) yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyRelDay)); + Tcl_NewIntObj((int) yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyRelSeconds)); + Tcl_NewIntObj((int) yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyDayOrdinal)); + Tcl_NewIntObj((int) yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyDayNumber)); + Tcl_NewIntObj((int) yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyMonthOrdinal)); + Tcl_NewIntObj((int) yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyMonth)); + Tcl_NewIntObj((int) yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); Tcl_SetObjResult(interp, result); return TCL_OK; Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -57,32 +57,32 @@ const char *name, const char *version, int exact, void *clientDataPtr); /* 2 */ EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -EXTERN void * Tcl_Alloc(size_t size); +EXTERN char * Tcl_Alloc(unsigned int size); /* 4 */ -EXTERN void Tcl_Free(void *ptr); +EXTERN void Tcl_Free(char *ptr); /* 5 */ -EXTERN void * Tcl_Realloc(void *ptr, size_t size); +EXTERN char * Tcl_Realloc(char *ptr, unsigned int size); /* 6 */ -EXTERN void * Tcl_DbCkalloc(size_t size, const char *file, +EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file, int line); /* 7 */ -EXTERN void Tcl_DbCkfree(void *ptr, const char *file, int line); +EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); /* 8 */ -EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t size, +EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line); #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, void *clientData); + Tcl_FileProc *proc, ClientData clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, void *clientData); + Tcl_FileProc *proc, ClientData clientData); #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ EXTERN void Tcl_DeleteFileHandler(int fd); #endif /* UNIX */ @@ -101,11 +101,11 @@ Tcl_Obj *objPtr); /* 15 */ EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); /* 16 */ EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, - size_t length); + int length); /* 17 */ EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); /* 18 */ EXTERN int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); @@ -116,29 +116,36 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 21 */ EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); -/* Slot 22 is reserved */ +/* 22 */ +TCL_DEPRECATED("No longer in use, changed to macro") +Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, + int line); /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, - size_t length, const char *file, int line); + int length, const char *file, int line); /* 24 */ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line); /* 25 */ EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line); -/* Slot 26 is reserved */ +/* 26 */ +TCL_DEPRECATED("No longer in use, changed to macro") +Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, + int line); /* 27 */ EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line); /* 28 */ -EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, size_t length, +EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, const char *file, int line); /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); -/* Slot 30 is reserved */ +/* 30 */ +EXTERN void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); /* 32 */ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, @@ -150,11 +157,15 @@ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); /* 35 */ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); -/* Slot 36 is reserved */ +/* 36 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_GetIndexFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, const char *const *tablePtr, + const char *msg, int flags, int *indexPtr); /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); /* 38 */ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, @@ -161,11 +172,11 @@ Tcl_Obj *objPtr, int *intPtr); /* 39 */ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ -EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); +EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ @@ -187,87 +198,109 @@ Tcl_Obj *listPtr, int *lengthPtr); /* 48 */ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); -/* Slot 49 is reserved */ +/* 49 */ +TCL_DEPRECATED("No longer in use, changed to macro") +Tcl_Obj * Tcl_NewBooleanObj(int boolValue); /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, - size_t length); + int length); /* 51 */ EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); -/* Slot 52 is reserved */ +/* 52 */ +TCL_DEPRECATED("No longer in use, changed to macro") +Tcl_Obj * Tcl_NewIntObj(int intValue); /* 53 */ EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); -/* Slot 54 is reserved */ +/* 54 */ +TCL_DEPRECATED("No longer in use, changed to macro") +Tcl_Obj * Tcl_NewLongObj(long longValue); /* 55 */ EXTERN Tcl_Obj * Tcl_NewObj(void); /* 56 */ -EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, size_t length); -/* Slot 57 is reserved */ +EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); +/* 57 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); /* 58 */ -EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, - size_t length); +EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); /* 59 */ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, - const unsigned char *bytes, size_t length); + const unsigned char *bytes, int length); /* 60 */ EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); -/* Slot 61 is reserved */ +/* 61 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); /* 62 */ EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); -/* Slot 63 is reserved */ +/* 63 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); /* 64 */ -EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length); +EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); /* 65 */ EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, - size_t length); -/* Slot 66 is reserved */ -/* Slot 67 is reserved */ + int length); +/* 66 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_AddErrorInfo(Tcl_Interp *interp, + const char *message); +/* 67 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_AddObjErrorInfo(Tcl_Interp *interp, + const char *message, int length); /* 68 */ EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ EXTERN void Tcl_AppendElement(Tcl_Interp *interp, const char *element); /* 70 */ EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - void *clientData); + ClientData clientData); /* 72 */ EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ EXTERN int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); /* 74 */ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); /* 75 */ EXTERN int Tcl_AsyncReady(void); -/* Slot 76 is reserved */ -/* Slot 77 is reserved */ +/* 76 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_BackgroundError(Tcl_Interp *interp); +/* 77 */ +TCL_DEPRECATED("Use Tcl_UtfBackslash") +char Tcl_Backslash(const char *src, int *readPtr); /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList); /* 79 */ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, void *clientData); + Tcl_InterpDeleteProc *proc, + ClientData clientData); /* 80 */ EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, - void *clientData); + ClientData clientData); /* 81 */ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ EXTERN int Tcl_CommandComplete(const char *cmd); /* 83 */ EXTERN char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ -EXTERN size_t Tcl_ConvertElement(const char *src, char *dst, +EXTERN int Tcl_ConvertElement(const char *src, char *dst, int flags); /* 85 */ -EXTERN size_t Tcl_ConvertCountedElement(const char *src, - size_t length, char *dst, int flags); +EXTERN int Tcl_ConvertCountedElement(const char *src, + int length, char *dst, int flags); /* 86 */ EXTERN int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); @@ -276,72 +309,78 @@ const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 88 */ EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, void *instanceData, - int mask); + const char *chanName, + ClientData instanceData, int mask); /* 89 */ EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, void *clientData); + Tcl_ChannelProc *proc, ClientData clientData); /* 90 */ EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, void *clientData); + Tcl_CloseProc *proc, ClientData clientData); /* 91 */ EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, - void *clientData, + ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - void *clientData); + ClientData clientData); /* 93 */ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, - void *clientData); + ClientData clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); -/* Slot 95 is reserved */ +/* 95 */ +TCL_DEPRECATED("") +void Tcl_CreateMathFunc(Tcl_Interp *interp, + const char *name, int numArgs, + Tcl_ValueType *argTypes, Tcl_MathProc *proc, + ClientData clientData); /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - void *clientData, + ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName, int isSafe); /* 98 */ EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, void *clientData); + Tcl_TimerProc *proc, ClientData clientData); /* 99 */ EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, void *clientData); + Tcl_CmdTraceProc *proc, + ClientData clientData); /* 100 */ EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, - Tcl_ChannelProc *proc, void *clientData); + Tcl_ChannelProc *proc, ClientData clientData); /* 102 */ EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, void *clientData); + Tcl_CloseProc *proc, ClientData clientData); /* 103 */ EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); /* 104 */ EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, - void *clientData); + ClientData clientData); /* 106 */ EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - void *clientData); + ClientData clientData); /* 107 */ EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, - void *clientData); + ClientData clientData); /* 108 */ EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ EXTERN void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr); /* 110 */ @@ -352,18 +391,20 @@ EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); /* 113 */ EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, void *clientData); + Tcl_InterpDeleteProc *proc, + ClientData clientData); /* 115 */ EXTERN int Tcl_DoOneEvent(int flags); /* 116 */ -EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData); +EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, + ClientData clientData); /* 117 */ EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, - const char *bytes, size_t length); + const char *bytes, int length); /* 118 */ EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element); /* 119 */ EXTERN void Tcl_DStringEndSublist(Tcl_DString *dsPtr); @@ -376,27 +417,29 @@ EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr); /* 123 */ EXTERN void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 124 */ -EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, - size_t length); +EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); /* 125 */ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ EXTERN int Tcl_Eof(Tcl_Channel chan); /* 127 */ EXTERN const char * Tcl_ErrnoId(void); /* 128 */ EXTERN const char * Tcl_ErrnoMsg(int err); -/* Slot 129 is reserved */ +/* 129 */ +EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); /* 130 */ EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); -/* Slot 131 is reserved */ +/* 131 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 132 */ -EXTERN void Tcl_EventuallyFree(void *clientData, +EXTERN void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc); /* 133 */ EXTERN TCL_NORETURN void Tcl_Exit(int status); /* 134 */ EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp, @@ -425,18 +468,20 @@ Tcl_Obj **resultPtrPtr); /* 142 */ EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ EXTERN void Tcl_Finalize(void); -/* Slot 144 is reserved */ +/* 144 */ +EXTERN void Tcl_FindExecutable(const char *argv0); /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* 147 */ -EXTERN void Tcl_FreeResult(Tcl_Interp *interp); +TCL_DEPRECATED("see TIP #559. Use Tcl_ResetResult") +void Tcl_FreeResult(Tcl_Interp *interp); /* 148 */ EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, @@ -446,33 +491,33 @@ const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ -EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp, +EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr); /* 152 */ EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - void **handlePtr); + ClientData *handlePtr); /* 154 */ -EXTERN void * Tcl_GetChannelInstanceData(Tcl_Channel chan); +EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan); /* 157 */ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ -EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); +EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 160 */ EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp, @@ -492,38 +537,47 @@ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, void **filePtr); + int checkUsage, ClientData *filePtr); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, void **filePtr); + int checkUsage, ClientData *filePtr); #endif /* MACOSX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ -EXTERN size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); +EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ -EXTERN size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); +EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ EXTERN int Tcl_GetServiceMode(void); /* 172 */ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName); /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel(int type); -/* Slot 174 is reserved */ -/* Slot 175 is reserved */ +/* 174 */ +EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp); +/* 175 */ +TCL_DEPRECATED("No longer in use, changed to macro") +const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, + int flags); /* 176 */ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* Slot 177 is reserved */ -/* Slot 178 is reserved */ +/* 177 */ +EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, + const char *command); +/* 178 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_GlobalEvalObj(Tcl_Interp *interp, + Tcl_Obj *objPtr); /* 179 */ EXTERN int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 180 */ @@ -545,15 +599,15 @@ /* 187 */ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, void *addr, int type); /* Slot 188 is reserved */ /* 189 */ -EXTERN Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode); +EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); /* 190 */ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ -EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket); +EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); /* 192 */ EXTERN char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); /* 194 */ @@ -578,13 +632,13 @@ int myport, int async); /* 200 */ EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - void *callbackData); + ClientData callbackData); /* 201 */ -EXTERN void Tcl_Preserve(void *data); +EXTERN void Tcl_Preserve(ClientData data); /* 202 */ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); /* 203 */ EXTERN int Tcl_PutEnv(const char *assignment); @@ -592,12 +646,11 @@ EXTERN const char * Tcl_PosixError(Tcl_Interp *interp); /* 205 */ EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); /* 206 */ -EXTERN size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, - size_t toRead); +EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); /* 207 */ EXTERN void Tcl_ReapDetachedProcs(void); /* 208 */ EXTERN int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags); @@ -617,30 +670,32 @@ const char *text, const char *start); /* 214 */ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ -EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index, +EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 216 */ -EXTERN void Tcl_Release(void *clientData); +EXTERN void Tcl_Release(ClientData clientData); /* 217 */ EXTERN void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -EXTERN size_t Tcl_ScanElement(const char *src, int *flagPtr); +EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ -EXTERN size_t Tcl_ScanCountedElement(const char *src, - size_t length, int *flagPtr); -/* Slot 220 is reserved */ +EXTERN int Tcl_ScanCountedElement(const char *src, int length, + int *flagPtr); +/* 220 */ +TCL_DEPRECATED("") +int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ EXTERN int Tcl_ServiceEvent(int flags); /* 223 */ EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, - void *clientData); + ClientData clientData); /* 224 */ EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ EXTERN int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, @@ -653,14 +708,18 @@ EXTERN void Tcl_SetErrno(int err); /* 228 */ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); -/* Slot 230 is reserved */ +/* 230 */ +EXTERN void Tcl_SetPanicProc( + TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); -/* Slot 232 is reserved */ +/* 232 */ +EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, + Tcl_FreeProc *freeProc); /* 233 */ EXTERN int Tcl_SetServiceMode(int mode); /* 234 */ EXTERN void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr); @@ -667,11 +726,14 @@ /* 235 */ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); -/* Slot 237 is reserved */ +/* 237 */ +TCL_DEPRECATED("No longer in use, changed to macro") +const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, + const char *newValue, int flags); /* 238 */ EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 239 */ @@ -685,94 +747,145 @@ const char *listStr, int *argcPtr, const char ***argvPtr); /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr); -/* Slot 244 is reserved */ -/* Slot 245 is reserved */ -/* Slot 246 is reserved */ -/* Slot 247 is reserved */ +/* 244 */ +EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, + const char *pkgName, + Tcl_PackageInitProc *initProc, + Tcl_PackageInitProc *safeInitProc); +/* 245 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_StringMatch(const char *str, const char *pattern); +/* 246 */ +TCL_DEPRECATED("") +int Tcl_TellOld(Tcl_Channel chan); +/* 247 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, + int flags, Tcl_VarTraceProc *proc, + ClientData clientData); /* 248 */ EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, - Tcl_VarTraceProc *proc, void *clientData); + Tcl_VarTraceProc *proc, + ClientData clientData); /* 249 */ EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 250 */ -EXTERN size_t Tcl_Ungets(Tcl_Channel chan, const char *str, - size_t len, int atHead); +EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str, + int len, int atHead); /* 251 */ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName); /* 252 */ EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); -/* Slot 253 is reserved */ +/* 253 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, + int flags); /* 254 */ EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* Slot 255 is reserved */ +/* 255 */ +TCL_DEPRECATED("No longer in use, changed to macro") +void Tcl_UntraceVar(Tcl_Interp *interp, + const char *varName, int flags, + Tcl_VarTraceProc *proc, + ClientData clientData); /* 256 */ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - void *clientData); + ClientData clientData); /* 257 */ EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); -/* Slot 258 is reserved */ +/* 258 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, + const char *varName, const char *localName, + int flags); /* 259 */ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 260 */ EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); -/* Slot 261 is reserved */ +/* 261 */ +TCL_DEPRECATED("No longer in use, changed to macro") +ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, + const char *varName, int flags, + Tcl_VarTraceProc *procPtr, + ClientData prevClientData); /* 262 */ -EXTERN void * Tcl_VarTraceInfo2(Tcl_Interp *interp, +EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - void *prevClientData); + ClientData prevClientData); /* 263 */ -EXTERN size_t Tcl_Write(Tcl_Channel chan, const char *s, - size_t slen); +EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); /* 264 */ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 265 */ EXTERN int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ EXTERN void Tcl_ValidateAllMemory(const char *file, int line); -/* Slot 267 is reserved */ -/* Slot 268 is reserved */ +/* 267 */ +TCL_DEPRECATED("see TIP #422") +void Tcl_AppendResultVA(Tcl_Interp *interp, + va_list argList); +/* 268 */ +TCL_DEPRECATED("see TIP #422") +void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, + va_list argList); /* 269 */ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr); -/* Slot 271 is reserved */ +/* 271 */ +TCL_DEPRECATED("No longer in use, changed to macro") +const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 272 */ EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); -/* Slot 273 is reserved */ -/* Slot 274 is reserved */ -/* Slot 275 is reserved */ -/* Slot 276 is reserved */ +/* 273 */ +TCL_DEPRECATED("No longer in use, changed to macro") +int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, + const char *version); +/* 274 */ +TCL_DEPRECATED("No longer in use, changed to macro") +const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *version, int exact); +/* 275 */ +TCL_DEPRECATED("see TIP #422") +void Tcl_SetErrorCodeVA(Tcl_Interp *interp, + va_list argList); +/* 276 */ +TCL_DEPRECATED("see TIP #422") +int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); /* 277 */ EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); -/* Slot 278 is reserved */ +/* 278 */ +TCL_DEPRECATED("see TIP #422") +TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList); /* 279 */ EXTERN void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); /* 280 */ EXTERN void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, - void *instanceData, int mask, + ClientData instanceData, int mask, Tcl_Channel prevChan); /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 283 */ @@ -785,18 +898,19 @@ Tcl_Obj *appendObjPtr); /* 287 */ EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, - void *clientData); + ClientData clientData); /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, - void *clientData); -/* Slot 290 is reserved */ + ClientData clientData); +/* 290 */ +EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); /* 291 */ EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, - size_t numBytes, int flags); + int numBytes, int flags); /* 292 */ EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 293 */ EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -804,22 +918,22 @@ /* 294 */ EXTERN TCL_NORETURN void Tcl_ExitThread(int status); /* 295 */ EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, - size_t srcLen, int flags, + int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - size_t dstLen, int *srcReadPtr, + int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 296 */ EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, - const char *src, size_t srcLen, + const char *src, int srcLen, Tcl_DString *dsPtr); /* 297 */ EXTERN void Tcl_FinalizeThread(void); /* 298 */ -EXTERN void Tcl_FinalizeNotifier(void *clientData); +EXTERN void Tcl_FinalizeNotifier(ClientData clientData); /* 299 */ EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ @@ -829,20 +943,20 @@ /* 303 */ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, - size_t offset, const char *msg, int flags, + int offset, const char *msg, int flags, int *indexPtr); /* 305 */ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, - size_t size); + int size); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ -EXTERN void * Tcl_InitNotifier(void); +EXTERN ClientData Tcl_InitNotifier(void); /* 308 */ EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ EXTERN void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr); /* 310 */ @@ -849,16 +963,20 @@ EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); /* 311 */ EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN size_t Tcl_NumUtfChars(const char *src, size_t length); +EXTERN int Tcl_NumUtfChars(const char *src, int length); /* 313 */ -EXTERN size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, - size_t charsToRead, int appendFlag); -/* Slot 314 is reserved */ -/* Slot 315 is reserved */ +EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, + int charsToRead, int appendFlag); +/* 314 */ +EXTERN void Tcl_RestoreResult(Tcl_Interp *interp, + Tcl_SavedResult *statePtr); +/* 315 */ +EXTERN void Tcl_SaveResult(Tcl_Interp *interp, + Tcl_SavedResult *statePtr); /* 316 */ EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); /* 317 */ EXTERN Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, @@ -868,25 +986,25 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); /* 319 */ EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN int Tcl_UniCharAtIndex(const char *src, size_t index); +EXTERN int Tcl_UniCharAtIndex(const char *src, int index); /* 321 */ EXTERN int Tcl_UniCharToLower(int ch); /* 322 */ EXTERN int Tcl_UniCharToTitle(int ch); /* 323 */ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); +EXTERN const char * Tcl_UtfAtIndex(const char *src, int index); /* 326 */ -EXTERN int Tcl_UtfCharComplete(const char *src, size_t length); +EXTERN int Tcl_UtfCharComplete(const char *src, int length); /* 327 */ -EXTERN size_t Tcl_UtfBackslash(const char *src, int *readPtr, +EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ EXTERN const char * Tcl_UtfFindLast(const char *src, int ch); @@ -895,37 +1013,42 @@ /* 331 */ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, - size_t srcLen, int flags, + int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - size_t dstLen, int *srcReadPtr, + int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, - const char *src, size_t srcLen, + const char *src, int srcLen, Tcl_DString *dsPtr); /* 334 */ EXTERN int Tcl_UtfToLower(char *src); /* 335 */ EXTERN int Tcl_UtfToTitle(char *src); /* 336 */ -EXTERN int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); +EXTERN int Tcl_UtfToChar16(const char *src, + unsigned short *chPtr); /* 337 */ EXTERN int Tcl_UtfToUpper(char *src); /* 338 */ -EXTERN size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, - size_t srcLen); +EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, + int srcLen); /* 339 */ -EXTERN size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); +EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); -/* Slot 341 is reserved */ -/* Slot 342 is reserved */ +/* 341 */ +TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") +const char * Tcl_GetDefaultEncodingDir(void); +/* 342 */ +TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") +void Tcl_SetDefaultEncodingDir(const char *path); /* 343 */ -EXTERN void Tcl_AlertNotifier(void *clientData); +EXTERN void Tcl_AlertNotifier(ClientData clientData); /* 344 */ EXTERN void Tcl_ServiceModeHook(int mode); /* 345 */ EXTERN int Tcl_UniCharIsAlnum(int ch); /* 346 */ @@ -939,50 +1062,56 @@ /* 350 */ EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ -EXTERN size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr); +TCL_DEPRECATED("Use Tcl_GetCharLength") +int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ -EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); +TCL_DEPRECATED("Use Tcl_UtfNcmp") +int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, + unsigned long numChars); /* 354 */ -EXTERN char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, - size_t uniLength, Tcl_DString *dsPtr); +EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, + int uniLength, Tcl_DString *dsPtr); /* 355 */ -EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, - size_t length, Tcl_DString *dsPtr); +EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, int length, + Tcl_DString *dsPtr); /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); -/* Slot 357 is reserved */ +/* 357 */ +TCL_DEPRECATED("Use Tcl_EvalTokensStandard") +Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, + Tcl_Token *tokenPtr, int count); /* 358 */ EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - size_t length); + int length); /* 360 */ EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, - const char *start, size_t numBytes, + const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 361 */ EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, - const char *start, size_t numBytes, - int nested, Tcl_Parse *parsePtr); + const char *start, int numBytes, int nested, + Tcl_Parse *parsePtr); /* 362 */ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, - size_t numBytes, Tcl_Parse *parsePtr); + int numBytes, Tcl_Parse *parsePtr); /* 363 */ EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, - const char *start, size_t numBytes, + const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 364 */ EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, - const char *start, size_t numBytes, + const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 365 */ EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 366 */ EXTERN int Tcl_Chdir(const char *dirName); @@ -989,14 +1118,15 @@ /* 367 */ EXTERN int Tcl_Access(const char *path, int mode); /* 368 */ EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); +EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, + unsigned long n); /* 370 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, - size_t n); + unsigned long n); /* 371 */ EXTERN int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); /* 372 */ EXTERN int Tcl_UniCharIsControl(int ch); @@ -1007,31 +1137,33 @@ /* 375 */ EXTERN int Tcl_UniCharIsPunct(int ch); /* 376 */ EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, - size_t offset, size_t nmatches, int flags); + int offset, int nmatches, int flags); /* 377 */ EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, - size_t numChars); + int numChars); /* 379 */ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); + const Tcl_UniChar *unicode, int numChars); /* 380 */ -EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); +EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); -/* Slot 382 is reserved */ +EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index); +/* 382 */ +TCL_DEPRECATED("No longer in use, changed to macro") +Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, - size_t last); +EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); /* 384 */ -EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t length); +TCL_DEPRECATED("Use Tcl_AppendStringsToObj") +void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, int length); /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 386 */ EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); @@ -1041,26 +1173,28 @@ EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); /* 389 */ EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ -EXTERN int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +EXTERN int Tcl_ProcObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); /* 391 */ EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, void *clientData, - size_t stackSize, int flags); + Tcl_ThreadCreateProc *proc, + ClientData clientData, int stackSize, + int flags); /* 394 */ -EXTERN size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, - size_t bytesToRead); +EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, + int bytesToRead); /* 395 */ -EXTERN size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, - size_t srcLen); +EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, + int srcLen); /* 396 */ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ @@ -1070,11 +1204,12 @@ const Tcl_ChannelType *chanTypePtr); /* 400 */ EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr); /* 401 */ -EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc( +TCL_DEPRECATED("Use Tcl_ChannelClose2Proc") +Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr); /* 402 */ EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr); /* 403 */ @@ -1082,11 +1217,12 @@ const Tcl_ChannelType *chanTypePtr); /* 404 */ EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr); /* 405 */ -EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc( +TCL_DEPRECATED("Use Tcl_ChannelWideSeekProc") +Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr); /* 406 */ EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 407 */ @@ -1118,55 +1254,72 @@ /* 417 */ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); /* 419 */ -EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); +TCL_DEPRECATED("Use Tcl_UtfNcasecmp") +int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, + unsigned long numChars); /* 420 */ -EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, +TCL_DEPRECATED("Use Tcl_StringCaseMatch") +int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); -/* Slot 421 is reserved */ -/* Slot 422 is reserved */ +/* 421 */ +EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, + const void *key); +/* 422 */ +EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, + const void *key, int *newPtr); /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 424 */ EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ -EXTERN void * Tcl_CommandTraceInfo(Tcl_Interp *interp, +EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - void *prevClientData); + ClientData prevClientData); /* 426 */ EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, void *clientData); + Tcl_CommandTraceProc *proc, + ClientData clientData); /* 427 */ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, void *clientData); + Tcl_CommandTraceProc *proc, + ClientData clientData); /* 428 */ -EXTERN void * Tcl_AttemptAlloc(size_t size); +EXTERN char * Tcl_AttemptAlloc(unsigned int size); /* 429 */ -EXTERN void * Tcl_AttemptDbCkalloc(size_t size, const char *file, - int line); +EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size, + const char *file, int line); /* 430 */ -EXTERN void * Tcl_AttemptRealloc(void *ptr, size_t size); +EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size); /* 431 */ -EXTERN void * Tcl_AttemptDbCkrealloc(void *ptr, size_t size, +EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line); /* 432 */ -EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, - size_t length); +EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); -/* Slot 435 is reserved */ -/* Slot 436 is reserved */ +/* 435 */ +TCL_DEPRECATED("") +int Tcl_GetMathFuncInfo(Tcl_Interp *interp, + const char *name, int *numArgsPtr, + Tcl_ValueType **argTypesPtr, + Tcl_MathProc **procPtr, + ClientData *clientDataPtr); +/* 436 */ +TCL_DEPRECATED("") +Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, + const char *pattern); /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 438 */ EXTERN int Tcl_DetachChannel(Tcl_Interp *interp, @@ -1212,11 +1365,11 @@ Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 452 */ EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ -EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, +EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 455 */ EXTERN int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode); @@ -1243,56 +1396,56 @@ Tcl_Obj *pathPtr); /* 464 */ EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ -EXTERN void * Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, +EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 467 */ EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ EXTERN Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, - void *clientData); + ClientData clientData); /* 469 */ EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ EXTERN Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr); /* 471 */ EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ EXTERN Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ -EXTERN int Tcl_FSRegister(void *clientData, +EXTERN int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr); /* 474 */ EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ -EXTERN void * Tcl_FSData(const Tcl_Filesystem *fsPtr); +EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ -EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); +EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ EXTERN int Tcl_OutputBuffered(Tcl_Channel chan); /* 480 */ EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); /* 481 */ EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp, - Tcl_Token *tokenPtr, size_t count); + Tcl_Token *tokenPtr, int count); /* 482 */ EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, - void *clientData, + ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 485 */ @@ -1359,11 +1512,11 @@ const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 506 */ EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, - const char *name, void *clientData, + const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 508 */ EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, @@ -1395,20 +1548,21 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 518 */ EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); -/* Slot 519 is reserved */ +/* 519 */ +EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - void *clientData, + ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - void *clientData); + ClientData clientData); /* 522 */ EXTERN int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ EXTERN int Tcl_LimitCheck(Tcl_Interp *interp); /* 524 */ @@ -1487,31 +1641,31 @@ Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 552 */ EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - void *clientData); + ClientData clientData); /* 553 */ EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - void **clientData); + ClientData *clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ -EXTERN Tcl_Obj * Tcl_NewBignumObj(mp_int *value); +EXTERN Tcl_Obj * Tcl_NewBignumObj(void *value); /* 556 */ -EXTERN Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file, +EXTERN Tcl_Obj * Tcl_DbNewBignumObj(void *value, const char *file, int line); /* 557 */ -EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value); +EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, void *value); /* 558 */ EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, - Tcl_Obj *obj, mp_int *value); + Tcl_Obj *obj, void *value); /* 559 */ EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, - Tcl_Obj *obj, mp_int *value); + Tcl_Obj *obj, void *value); /* 560 */ EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length); /* 561 */ EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( @@ -1526,11 +1680,11 @@ EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); /* 565 */ EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); /* 566 */ EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp, - double initval, mp_int *toInit); + double initval, void *toInit); /* 567 */ EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 568 */ EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, @@ -1552,12 +1706,12 @@ /* 574 */ EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 575 */ EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, - const char *bytes, size_t length, - size_t limit, const char *ellipsis); + const char *bytes, int length, int limit, + const char *ellipsis); /* 576 */ EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ EXTERN int Tcl_AppendFormatToObj(Tcl_Interp *interp, @@ -1568,11 +1722,11 @@ /* 579 */ EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ EXTERN int Tcl_CancelEval(Tcl_Interp *interp, - Tcl_Obj *resultObjPtr, void *clientData, + Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 581 */ EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); /* 582 */ EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, @@ -1579,11 +1733,12 @@ Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 583 */ EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, void *clientData, + Tcl_ObjCmdProc *nreProc, + ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 585 */ @@ -1592,16 +1747,18 @@ /* 586 */ EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, - Tcl_NRPostProc *postProcPtr, void *data0, - void *data1, void *data2, void *data3); + Tcl_NRPostProc *postProcPtr, + ClientData data0, ClientData data1, + ClientData data2, ClientData data3); /* 588 */ EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, - Tcl_ObjCmdProc *objProc, void *clientData, - int objc, Tcl_Obj *const objv[]); + Tcl_ObjCmdProc *objProc, + ClientData clientData, int objc, + Tcl_Obj *const objv[]); /* 589 */ EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ EXTERN unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr); /* 591 */ @@ -1641,11 +1798,11 @@ EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); /* 606 */ EXTERN void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum); /* 607 */ EXTERN void Tcl_TransferResult(Tcl_Interp *sourceInterp, - int result, Tcl_Interp *targetInterp); + int code, Tcl_Interp *targetInterp); /* 608 */ EXTERN int Tcl_InterpActive(Tcl_Interp *interp); /* 609 */ EXTERN void Tcl_BackgroundException(Tcl_Interp *interp, int code); /* 610 */ @@ -1652,18 +1809,18 @@ EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 611 */ EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format, - Tcl_Obj *data, size_t buffersize, + Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 612 */ EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc, - const unsigned char *buf, size_t len); + const unsigned char *buf, int len); /* 613 */ EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler, - const unsigned char *buf, size_t len); + const unsigned char *buf, int len); /* 614 */ EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 615 */ @@ -1675,11 +1832,11 @@ /* 618 */ EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 619 */ EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, - Tcl_Obj *data, size_t count); + Tcl_Obj *data, int count); /* 620 */ EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); /* 621 */ EXTERN int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle); /* 622 */ @@ -1713,11 +1870,11 @@ /* 631 */ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - void *callbackData); + ClientData callbackData); /* 632 */ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 633 */ @@ -1731,11 +1888,11 @@ size_t datalen, int copy); /* 636 */ EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); /* 637 */ EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - size_t numBytes); + unsigned int numBytes); /* 638 */ EXTERN Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 639 */ EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr, @@ -1750,15 +1907,22 @@ /* 643 */ EXTERN int Tcl_IsShared(Tcl_Obj *objPtr); /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, - size_t size); + int size); /* 645 */ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, - Tcl_Obj *objPtr, size_t endValue, - size_t *indexPtr); + Tcl_Obj *objPtr, int endValue, int *indexPtr); +/* 646 */ +EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); +/* 647 */ +EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, + int uniLength, Tcl_DString *dsPtr); +/* 648 */ +EXTERN int * Tcl_UtfToUniCharDString(const char *src, int length, + Tcl_DString *dsPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; @@ -1769,24 +1933,24 @@ const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ - void * (*tcl_Alloc) (size_t size); /* 3 */ - void (*tcl_Free) (void *ptr); /* 4 */ - void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */ - void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */ - void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ - void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ + char * (*tcl_Alloc) (unsigned int size); /* 3 */ + void (*tcl_Free) (char *ptr); /* 4 */ + char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ + char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ + void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */ + char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ + void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved9)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ + void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ @@ -1798,127 +1962,127 @@ void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */ void (*tcl_Sleep) (int ms); /* 12 */ int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */ int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */ void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */ - void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 16 */ + void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */ int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */ void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ - void (*reserved22)(void); - Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, size_t length, const char *file, int line); /* 23 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */ + Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ - void (*reserved26)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */ Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ - Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t length, const char *file, int line); /* 28 */ + Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ - void (*reserved30)(void); + void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ - void (*reserved36)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ - const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ + CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */ int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ - void (*reserved49)(void); - Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, size_t length); /* 50 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */ + Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ - void (*reserved52)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */ - void (*reserved54)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ - Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, size_t length); /* 56 */ - void (*reserved57)(void); - unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, size_t length); /* 58 */ - void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, size_t length); /* 59 */ + Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */ + unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */ + void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ - void (*reserved61)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */ void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */ - void (*reserved63)(void); - void (*tcl_SetObjLength) (Tcl_Obj *objPtr, size_t length); /* 64 */ - void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 65 */ - void (*reserved66)(void); - void (*reserved67)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */ + void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ + void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */ void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ - Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, void *clientData); /* 71 */ + Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */ int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ - void (*reserved76)(void); - void (*reserved77)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ + TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ - void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */ - void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */ + void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ + void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ - size_t (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ - size_t (*tcl_ConvertCountedElement) (const char *src, size_t length, char *dst, int flags); /* 85 */ + int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ + int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ - Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, void *instanceData, int mask); /* 88 */ - void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, void *clientData); /* 89 */ - void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 90 */ - Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ - void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */ - void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */ + Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ + void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ + void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */ + Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ + void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ + void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ - void (*reserved95)(void); - Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ + TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ + Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */ - Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */ - Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */ + Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */ + Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */ void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */ - void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */ - void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */ + void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */ + void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */ int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */ int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */ - void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */ - void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */ - void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 107 */ + void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */ + void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */ + void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */ void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */ void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */ void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */ void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */ void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */ void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */ - void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 114 */ + void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */ int (*tcl_DoOneEvent) (int flags); /* 115 */ - void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, void *clientData); /* 116 */ - char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, size_t length); /* 117 */ + void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */ + char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length); /* 117 */ char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */ void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */ void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */ void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */ void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */ void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */ - void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, size_t length); /* 124 */ + void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ const char * (*tcl_ErrnoId) (void); /* 127 */ const char * (*tcl_ErrnoMsg) (int err); /* 128 */ - void (*reserved129)(void); + int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ - void (*reserved131)(void); - void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ + void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */ int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */ int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */ @@ -1926,53 +2090,53 @@ int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */ int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */ int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ - void (*reserved144)(void); + TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ - void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ + TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ - void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ + ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ - int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */ - void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ + int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ + ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ - const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ + CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ const char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */ Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ + int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* UNIX */ #if defined(_WIN32) /* WIN */ void (*reserved167)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ + int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* MACOSX */ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */ - size_t (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ - size_t (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ + int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ + int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ - void (*reserved174)(void); - void (*reserved175)(void); + const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ - void (*reserved177)(void); - void (*reserved178)(void); + int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ int (*tcl_Init) (Tcl_Interp *interp); /* 180 */ void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */ int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */ int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */ @@ -1979,227 +2143,227 @@ int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */ int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */ char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */ void (*reserved188)(void); - Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */ + Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ - Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */ + Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */ Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */ Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ - Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */ - void (*tcl_Preserve) (void *data); /* 201 */ + Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ + void (*tcl_Preserve) (ClientData data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ - size_t (*tcl_Read) (Tcl_Channel chan, char *bufPtr, size_t toRead); /* 206 */ + int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */ int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */ void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */ void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */ Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ - void (*tcl_RegExpRange) (Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 215 */ - void (*tcl_Release) (void *clientData); /* 216 */ + void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ + void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ - size_t (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ - size_t (*tcl_ScanCountedElement) (const char *src, size_t length, int *flagPtr); /* 219 */ - void (*reserved220)(void); + int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ + int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ + TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ - void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */ + void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */ int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */ int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */ void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ - void (*reserved230)(void); + TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ - void (*reserved232)(void); + void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ int (*tcl_SetServiceMode) (int mode); /* 233 */ void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - void (*reserved237)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ - void (*reserved244)(void); - void (*reserved245)(void); - void (*reserved246)(void); - void (*reserved247)(void); - int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */ + TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ + TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ + int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ - size_t (*tcl_Ungets) (Tcl_Channel chan, const char *str, size_t len, int atHead); /* 250 */ + int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ - void (*reserved253)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ - void (*reserved255)(void); - void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 256 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */ + void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ - void (*reserved258)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ - void (*reserved261)(void); - void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */ - size_t (*tcl_Write) (Tcl_Channel chan, const char *s, size_t slen); /* 263 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ + ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ + int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */ - void (*reserved267)(void); - void (*reserved268)(void); + TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ + TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ - void (*reserved271)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ - void (*reserved273)(void); - void (*reserved274)(void); - void (*reserved275)(void); - void (*reserved276)(void); + TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ + TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ + TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ - void (*reserved278)(void); + TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ - Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ + Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ void (*reserved285)(void); void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ - void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ - void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */ - void (*reserved290)(void); - int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, size_t numBytes, int flags); /* 291 */ + void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ + void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ + void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ + int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */ - int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ - char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 296 */ + int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ + char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ - void (*tcl_FinalizeNotifier) (void *clientData); /* 298 */ + void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ - int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */ - void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */ + int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ + void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */ - void * (*tcl_InitNotifier) (void); /* 307 */ + ClientData (*tcl_InitNotifier) (void); /* 307 */ void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */ void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */ void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ - size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 312 */ - size_t (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag); /* 313 */ - void (*reserved314)(void); - void (*reserved315)(void); + int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */ + int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */ + void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ + void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ - int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */ + int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ int (*tcl_UniCharToLower) (int ch); /* 321 */ int (*tcl_UniCharToTitle) (int ch); /* 322 */ int (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */ - int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */ - size_t (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ + const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ + int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ + int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ const char * (*tcl_UtfNext) (const char *src); /* 330 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ - int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ - char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 333 */ + int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ + char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ int (*tcl_UtfToTitle) (char *src); /* 335 */ - int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */ + int (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */ int (*tcl_UtfToUpper) (char *src); /* 337 */ - size_t (*tcl_WriteChars) (Tcl_Channel chan, const char *src, size_t srcLen); /* 338 */ - size_t (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ + int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ + int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ - void (*reserved341)(void); - void (*reserved342)(void); - void (*tcl_AlertNotifier) (void *clientData); /* 343 */ + TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ + TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ + void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ int (*tcl_UniCharIsDigit) (int ch); /* 347 */ int (*tcl_UniCharIsLower) (int ch); /* 348 */ int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ - size_t (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ - char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 354 */ - Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 355 */ + TCL_DEPRECATED_API("Use Tcl_GetCharLength") int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ + TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ + char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ + unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ - void (*reserved357)(void); + TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ - void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, size_t length); /* 359 */ - int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ - int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, size_t numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ - int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr); /* 362 */ - int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ - int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ + void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */ + int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ + int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ + int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ + int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ + int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ int (*tcl_UniCharIsPrint) (int ch); /* 374 */ int (*tcl_UniCharIsPunct) (int ch); /* 375 */ - int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags); /* 376 */ + int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */ void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ - Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */ - void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */ - size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ - int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ - void (*reserved382)(void); - Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */ - void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 384 */ + Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ + void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ + int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ + TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ + Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ + TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ - int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ + int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */ - int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); /* 393 */ - size_t (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, size_t bytesToRead); /* 394 */ - size_t (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, size_t srcLen); /* 395 */ + int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */ + int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */ + int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */ - Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ + TCL_DEPRECATED_API("Use Tcl_ChannelClose2Proc") Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */ Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */ - Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */ + TCL_DEPRECATED_API("Use Tcl_ChannelWideSeekProc") Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr); /* 409 */ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr); /* 410 */ @@ -2209,28 +2373,28 @@ int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */ void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */ void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ - int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ - void (*reserved421)(void); - void (*reserved422)(void); + TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ + TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ + Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ + Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ - void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */ - int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */ - void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ - void * (*tcl_AttemptAlloc) (size_t size); /* 428 */ - void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ - void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */ - void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */ - int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */ + ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ + int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ + void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ + char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */ + char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ + char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */ + char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ + int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ - void (*reserved435)(void); - void (*reserved436)(void); + TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ + TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */ int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */ @@ -2243,11 +2407,11 @@ int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */ int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */ int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */ int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */ int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */ - const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ + const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */ int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */ Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */ int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */ @@ -2255,29 +2419,29 @@ Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */ Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */ int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */ - void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ + ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */ int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */ - Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */ + Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */ const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */ Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */ Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */ Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */ - int (*tcl_FSRegister) (void *clientData, const Tcl_Filesystem *fsPtr); /* 473 */ + int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */ int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ - void * (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ + ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */ - const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ + CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */ int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */ void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */ - int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t count); /* 481 */ + int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */ void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */ - Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ + Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */ Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */ @@ -2296,11 +2460,11 @@ int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */ int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */ Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */ Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */ void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */ - Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ + Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */ int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 510 */ int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 511 */ @@ -2309,13 +2473,13 @@ Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */ Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */ Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ - void (*reserved519)(void); - void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ - void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData); /* 521 */ + TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ + void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ + void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */ int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */ void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */ void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */ @@ -2342,47 +2506,47 @@ int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */ int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */ int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ - void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */ - void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ + void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ + void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ - Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */ - Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line); /* 556 */ - void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */ - int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */ - int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */ + Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */ + Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */ + void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */ + int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */ + int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */ int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */ Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */ void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */ void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */ void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */ void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */ - int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, mp_int *toInit); /* 566 */ + int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */ Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */ int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */ int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */ Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */ int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */ const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */ void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */ - void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length, size_t limit, const char *ellipsis); /* 575 */ + void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */ Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */ int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */ void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */ - int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 580 */ + int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */ int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */ int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */ - Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ + Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */ int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */ int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ - void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, void *data0, void *data1, void *data2, void *data3); /* 587 */ - int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ + void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */ + int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */ int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */ @@ -2397,23 +2561,23 @@ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */ int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */ - void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 607 */ + void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */ int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */ void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */ int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */ - int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ - unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, size_t len); /* 612 */ - unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, size_t len); /* 613 */ + int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ + unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */ + unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */ int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */ Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */ int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */ int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */ int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */ - int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, size_t count); /* 619 */ + int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */ int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */ int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */ void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */ Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */ int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */ @@ -2421,25 +2585,28 @@ int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */ int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */ void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ - Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */ + Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */ Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */ int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */ - char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */ + char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ - int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 644 */ - int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */ + int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */ + int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */ + int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ + char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */ + int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus @@ -2506,25 +2673,28 @@ (tclStubsPtr->tcl_DbDecrRefCount) /* 19 */ #define Tcl_DbIncrRefCount \ (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ -/* Slot 22 is reserved */ +#define Tcl_DbNewBooleanObj \ + (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #define Tcl_DbNewDoubleObj \ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */ #define Tcl_DbNewListObj \ (tclStubsPtr->tcl_DbNewListObj) /* 25 */ -/* Slot 26 is reserved */ +#define Tcl_DbNewLongObj \ + (tclStubsPtr->tcl_DbNewLongObj) /* 26 */ #define Tcl_DbNewObj \ (tclStubsPtr->tcl_DbNewObj) /* 27 */ #define Tcl_DbNewStringObj \ (tclStubsPtr->tcl_DbNewStringObj) /* 28 */ #define Tcl_DuplicateObj \ (tclStubsPtr->tcl_DuplicateObj) /* 29 */ -/* Slot 30 is reserved */ +#define TclFreeObj \ + (tclStubsPtr->tclFreeObj) /* 30 */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ #define Tcl_GetByteArrayFromObj \ @@ -2531,11 +2701,12 @@ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */ #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ -/* Slot 36 is reserved */ +#define Tcl_GetIndexFromObj \ + (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */ #define Tcl_GetLongFromObj \ @@ -2556,40 +2727,48 @@ (tclStubsPtr->tcl_ListObjIndex) /* 46 */ #define Tcl_ListObjLength \ (tclStubsPtr->tcl_ListObjLength) /* 47 */ #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ -/* Slot 49 is reserved */ +#define Tcl_NewBooleanObj \ + (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ -/* Slot 52 is reserved */ +#define Tcl_NewIntObj \ + (tclStubsPtr->tcl_NewIntObj) /* 52 */ #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ -/* Slot 54 is reserved */ +#define Tcl_NewLongObj \ + (tclStubsPtr->tcl_NewLongObj) /* 54 */ #define Tcl_NewObj \ (tclStubsPtr->tcl_NewObj) /* 55 */ #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ -/* Slot 57 is reserved */ +#define Tcl_SetBooleanObj \ + (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ -/* Slot 61 is reserved */ +#define Tcl_SetIntObj \ + (tclStubsPtr->tcl_SetIntObj) /* 61 */ #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ -/* Slot 63 is reserved */ +#define Tcl_SetLongObj \ + (tclStubsPtr->tcl_SetLongObj) /* 63 */ #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ -/* Slot 66 is reserved */ -/* Slot 67 is reserved */ +#define Tcl_AddErrorInfo \ + (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ +#define Tcl_AddObjErrorInfo \ + (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ (tclStubsPtr->tcl_AppendElement) /* 69 */ #define Tcl_AppendResult \ @@ -2602,12 +2781,14 @@ (tclStubsPtr->tcl_AsyncInvoke) /* 73 */ #define Tcl_AsyncMark \ (tclStubsPtr->tcl_AsyncMark) /* 74 */ #define Tcl_AsyncReady \ (tclStubsPtr->tcl_AsyncReady) /* 75 */ -/* Slot 76 is reserved */ -/* Slot 77 is reserved */ +#define Tcl_BackgroundError \ + (tclStubsPtr->tcl_BackgroundError) /* 76 */ +#define Tcl_Backslash \ + (tclStubsPtr->tcl_Backslash) /* 77 */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */ #define Tcl_CancelIdleCall \ @@ -2638,11 +2819,12 @@ (tclStubsPtr->tcl_CreateEventSource) /* 92 */ #define Tcl_CreateExitHandler \ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ -/* Slot 95 is reserved */ +#define Tcl_CreateMathFunc \ + (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateSlave \ (tclStubsPtr->tcl_CreateSlave) /* 97 */ #define Tcl_CreateTimerHandler \ @@ -2705,14 +2887,16 @@ (tclStubsPtr->tcl_Eof) /* 126 */ #define Tcl_ErrnoId \ (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ -/* Slot 129 is reserved */ +#define Tcl_Eval \ + (tclStubsPtr->tcl_Eval) /* 129 */ #define Tcl_EvalFile \ (tclStubsPtr->tcl_EvalFile) /* 130 */ -/* Slot 131 is reserved */ +#define Tcl_EvalObj \ + (tclStubsPtr->tcl_EvalObj) /* 131 */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ (tclStubsPtr->tcl_Exit) /* 133 */ #define Tcl_ExposeCommand \ @@ -2733,11 +2917,12 @@ (tclStubsPtr->tcl_ExprObj) /* 141 */ #define Tcl_ExprString \ (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ -/* Slot 144 is reserved */ +#define Tcl_FindExecutable \ + (tclStubsPtr->tcl_FindExecutable) /* 144 */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ #define Tcl_FreeResult \ @@ -2798,16 +2983,20 @@ (tclStubsPtr->tcl_GetServiceMode) /* 171 */ #define Tcl_GetSlave \ (tclStubsPtr->tcl_GetSlave) /* 172 */ #define Tcl_GetStdChannel \ (tclStubsPtr->tcl_GetStdChannel) /* 173 */ -/* Slot 174 is reserved */ -/* Slot 175 is reserved */ +#define Tcl_GetStringResult \ + (tclStubsPtr->tcl_GetStringResult) /* 174 */ +#define Tcl_GetVar \ + (tclStubsPtr->tcl_GetVar) /* 175 */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ -/* Slot 177 is reserved */ -/* Slot 178 is reserved */ +#define Tcl_GlobalEval \ + (tclStubsPtr->tcl_GlobalEval) /* 177 */ +#define Tcl_GlobalEvalObj \ + (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ (tclStubsPtr->tcl_Init) /* 180 */ #define Tcl_InitHashTable \ @@ -2885,11 +3074,12 @@ (tclStubsPtr->tcl_ResetResult) /* 217 */ #define Tcl_ScanElement \ (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ -/* Slot 220 is reserved */ +#define Tcl_SeekOld \ + (tclStubsPtr->tcl_SeekOld) /* 220 */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ (tclStubsPtr->tcl_ServiceEvent) /* 222 */ #define Tcl_SetAssocData \ @@ -2904,23 +3094,26 @@ (tclStubsPtr->tcl_SetErrno) /* 227 */ #define Tcl_SetErrorCode \ (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ -/* Slot 230 is reserved */ +#define Tcl_SetPanicProc \ + (tclStubsPtr->tcl_SetPanicProc) /* 230 */ #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ -/* Slot 232 is reserved */ +#define Tcl_SetResult \ + (tclStubsPtr->tcl_SetResult) /* 232 */ #define Tcl_SetServiceMode \ (tclStubsPtr->tcl_SetServiceMode) /* 233 */ #define Tcl_SetObjErrorCode \ (tclStubsPtr->tcl_SetObjErrorCode) /* 234 */ #define Tcl_SetObjResult \ (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ -/* Slot 237 is reserved */ +#define Tcl_SetVar \ + (tclStubsPtr->tcl_SetVar) /* 237 */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ (tclStubsPtr->tcl_SignalId) /* 239 */ #define Tcl_SignalMsg \ @@ -2929,14 +3122,18 @@ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ #define Tcl_SplitList \ (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ -/* Slot 244 is reserved */ -/* Slot 245 is reserved */ -/* Slot 246 is reserved */ -/* Slot 247 is reserved */ +#define Tcl_StaticPackage \ + (tclStubsPtr->tcl_StaticPackage) /* 244 */ +#define Tcl_StringMatch \ + (tclStubsPtr->tcl_StringMatch) /* 245 */ +#define Tcl_TellOld \ + (tclStubsPtr->tcl_TellOld) /* 246 */ +#define Tcl_TraceVar \ + (tclStubsPtr->tcl_TraceVar) /* 247 */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ (tclStubsPtr->tcl_TranslateFileName) /* 249 */ #define Tcl_Ungets \ @@ -2943,24 +3140,28 @@ (tclStubsPtr->tcl_Ungets) /* 250 */ #define Tcl_UnlinkVar \ (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ -/* Slot 253 is reserved */ +#define Tcl_UnsetVar \ + (tclStubsPtr->tcl_UnsetVar) /* 253 */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ -/* Slot 255 is reserved */ +#define Tcl_UntraceVar \ + (tclStubsPtr->tcl_UntraceVar) /* 255 */ #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ -/* Slot 258 is reserved */ +#define Tcl_UpVar \ + (tclStubsPtr->tcl_UpVar) /* 258 */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ #define Tcl_VarEval \ (tclStubsPtr->tcl_VarEval) /* 260 */ -/* Slot 261 is reserved */ +#define Tcl_VarTraceInfo \ + (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #define Tcl_Write \ (tclStubsPtr->tcl_Write) /* 263 */ #define Tcl_WrongNumArgs \ @@ -2967,26 +3168,34 @@ (tclStubsPtr->tcl_WrongNumArgs) /* 264 */ #define Tcl_DumpActiveMemory \ (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ -/* Slot 267 is reserved */ -/* Slot 268 is reserved */ +#define Tcl_AppendResultVA \ + (tclStubsPtr->tcl_AppendResultVA) /* 267 */ +#define Tcl_AppendStringsToObjVA \ + (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ -/* Slot 271 is reserved */ +#define Tcl_PkgPresent \ + (tclStubsPtr->tcl_PkgPresent) /* 271 */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ -/* Slot 273 is reserved */ -/* Slot 274 is reserved */ -/* Slot 275 is reserved */ -/* Slot 276 is reserved */ +#define Tcl_PkgProvide \ + (tclStubsPtr->tcl_PkgProvide) /* 273 */ +#define Tcl_PkgRequire \ + (tclStubsPtr->tcl_PkgRequire) /* 274 */ +#define Tcl_SetErrorCodeVA \ + (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ +#define Tcl_VarEvalVA \ + (tclStubsPtr->tcl_VarEvalVA) /* 276 */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ -/* Slot 278 is reserved */ +#define Tcl_PanicVA \ + (tclStubsPtr->tcl_PanicVA) /* 278 */ #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #define Tcl_InitMemory \ (tclStubsPtr->tcl_InitMemory) /* 280 */ #define Tcl_StackChannel \ @@ -3004,11 +3213,12 @@ (tclStubsPtr->tcl_CreateEncoding) /* 287 */ #define Tcl_CreateThreadExitHandler \ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ -/* Slot 290 is reserved */ +#define Tcl_DiscardResult \ + (tclStubsPtr->tcl_DiscardResult) /* 290 */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ (tclStubsPtr->tcl_EvalObjv) /* 292 */ #define Tcl_EvalObjEx \ @@ -3051,12 +3261,14 @@ (tclStubsPtr->tcl_ConditionWait) /* 311 */ #define Tcl_NumUtfChars \ (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ -/* Slot 314 is reserved */ -/* Slot 315 is reserved */ +#define Tcl_RestoreResult \ + (tclStubsPtr->tcl_RestoreResult) /* 314 */ +#define Tcl_SaveResult \ + (tclStubsPtr->tcl_SaveResult) /* 315 */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ (tclStubsPtr->tcl_SetVar2Ex) /* 317 */ #define Tcl_ThreadAlert \ @@ -3093,22 +3305,24 @@ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */ #define Tcl_UtfToLower \ (tclStubsPtr->tcl_UtfToLower) /* 334 */ #define Tcl_UtfToTitle \ (tclStubsPtr->tcl_UtfToTitle) /* 335 */ -#define Tcl_UtfToUniChar \ - (tclStubsPtr->tcl_UtfToUniChar) /* 336 */ +#define Tcl_UtfToChar16 \ + (tclStubsPtr->tcl_UtfToChar16) /* 336 */ #define Tcl_UtfToUpper \ (tclStubsPtr->tcl_UtfToUpper) /* 337 */ #define Tcl_WriteChars \ (tclStubsPtr->tcl_WriteChars) /* 338 */ #define Tcl_WriteObj \ (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ -/* Slot 341 is reserved */ -/* Slot 342 is reserved */ +#define Tcl_GetDefaultEncodingDir \ + (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ +#define Tcl_SetDefaultEncodingDir \ + (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ (tclStubsPtr->tcl_ServiceModeHook) /* 344 */ #define Tcl_UniCharIsAlnum \ @@ -3127,17 +3341,18 @@ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 352 */ #define Tcl_UniCharNcmp \ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ -#define Tcl_UniCharToUtfDString \ - (tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */ -#define Tcl_UtfToUniCharDString \ - (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ +#define Tcl_Char16ToUtfDString \ + (tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */ +#define Tcl_UtfToChar16DString \ + (tclStubsPtr->tcl_UtfToChar16DString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ -/* Slot 357 is reserved */ +#define Tcl_EvalTokens \ + (tclStubsPtr->tcl_EvalTokens) /* 357 */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ (tclStubsPtr->tcl_LogCommandInfo) /* 359 */ #define Tcl_ParseBraces \ @@ -3182,11 +3397,12 @@ (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */ #define Tcl_GetCharLength \ (tclStubsPtr->tcl_GetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ -/* Slot 382 is reserved */ +#define Tcl_GetUnicode \ + (tclStubsPtr->tcl_GetUnicode) /* 382 */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ #define Tcl_AppendUnicodeToObj \ (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ #define Tcl_RegExpMatchObj \ @@ -3259,12 +3475,14 @@ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ #define Tcl_UniCharNcasecmp \ (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ #define Tcl_UniCharCaseMatch \ (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ -/* Slot 421 is reserved */ -/* Slot 422 is reserved */ +#define Tcl_FindHashEntry \ + (tclStubsPtr->tcl_FindHashEntry) /* 421 */ +#define Tcl_CreateHashEntry \ + (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ (tclStubsPtr->tcl_InitObjHashTable) /* 424 */ #define Tcl_CommandTraceInfo \ @@ -3285,12 +3503,14 @@ (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ -/* Slot 435 is reserved */ -/* Slot 436 is reserved */ +#define Tcl_GetMathFuncInfo \ + (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ +#define Tcl_ListMathFuncs \ + (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ (tclStubsPtr->tcl_DetachChannel) /* 438 */ #define Tcl_IsStandardChannel \ @@ -3451,11 +3671,12 @@ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ #define Tcl_GetCommandFullName \ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #define Tcl_FSEvalFileEx \ (tclStubsPtr->tcl_FSEvalFileEx) /* 518 */ -/* Slot 519 is reserved */ +#define Tcl_SetExitProc \ + (tclStubsPtr->tcl_SetExitProc) /* 519 */ #define Tcl_LimitAddHandler \ (tclStubsPtr->tcl_LimitAddHandler) /* 520 */ #define Tcl_LimitRemoveHandler \ (tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */ #define Tcl_LimitReady \ @@ -3704,101 +3925,155 @@ (tclStubsPtr->tcl_IsShared) /* 643 */ #define Tcl_LinkArray \ (tclStubsPtr->tcl_LinkArray) /* 644 */ #define Tcl_GetIntForIndex \ (tclStubsPtr->tcl_GetIntForIndex) /* 645 */ +#define Tcl_UtfToUniChar \ + (tclStubsPtr->tcl_UtfToUniChar) /* 646 */ +#define Tcl_UniCharToUtfDString \ + (tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */ +#define Tcl_UtfToUniCharDString \ + (tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp +# undef Tcl_FindExecutable +# undef Tcl_GetStringResult # undef Tcl_Init +# undef Tcl_SetPanicProc +# undef Tcl_SetExitProc # undef Tcl_ObjSetVar2 +# undef Tcl_StaticPackage # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) +# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) # define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) # define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \ (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags)) #endif #if defined(_WIN32) && defined(UNICODE) # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) # define Tcl_MainEx Tcl_MainExW - EXTERN TCL_NORETURN void Tcl_MainExW(int argc, wchar_t **argv, + EXTERN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); - EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv); #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#undef Tcl_SeekOld +#undef Tcl_TellOld + +#undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) +#undef Tcl_PkgProvide #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) +#undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) +#undef Tcl_GetIndexFromObj #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ sizeof(char *), msg, flags, indexPtr) +#undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(boolValue) \ Tcl_NewWideIntObj((boolValue)!=0) +#undef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj(boolValue, file, line) \ Tcl_DbNewWideIntObj((boolValue)!=0, file, line) +#undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, boolValue) \ Tcl_SetWideIntObj(objPtr, (boolValue)!=0) +#undef Tcl_SetVar #define Tcl_SetVar(interp, varName, newValue, flags) \ Tcl_SetVar2(interp, varName, NULL, newValue, flags) +#undef Tcl_UnsetVar #define Tcl_UnsetVar(interp, varName, flags) \ Tcl_UnsetVar2(interp, varName, NULL, flags) +#undef Tcl_GetVar #define Tcl_GetVar(interp, varName, flags) \ Tcl_GetVar2(interp, varName, NULL, flags) +#undef Tcl_TraceVar #define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) +#undef Tcl_UntraceVar #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) +#undef Tcl_VarTraceInfo #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) +#undef Tcl_UpVar #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) +#undef Tcl_AddErrorInfo #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1)) +#undef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) +#ifdef TCL_NO_DEPRECATED +#undef Tcl_FreeResult +#undef Tcl_AppendResultVA +#undef Tcl_AppendStringsToObjVA +#undef Tcl_SetErrorCodeVA +#undef Tcl_VarEvalVA +#undef Tcl_PanicVA +#undef Tcl_GetStringResult +#undef Tcl_GetDefaultEncodingDir +#undef Tcl_SetDefaultEncodingDir +#undef Tcl_UniCharLen +#undef Tcl_UniCharNcmp +#undef Tcl_EvalTokens +#undef Tcl_UniCharNcasecmp +#undef Tcl_UniCharCaseMatch +#undef Tcl_GetMathFuncInfo +#undef Tcl_ListMathFuncs +#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) +#undef Tcl_Eval #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, 0) +#undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL) -#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) +#undef Tcl_SaveResult #define Tcl_SaveResult(interp, statePtr) \ do { \ - *(statePtr) = Tcl_GetObjResult(interp); \ - Tcl_IncrRefCount(*(statePtr)); \ + (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \ + Tcl_IncrRefCount((statePtr)->objResultPtr); \ Tcl_SetObjResult(interp, Tcl_NewObj()); \ } while(0) +#undef Tcl_RestoreResult #define Tcl_RestoreResult(interp, statePtr) \ do { \ Tcl_ResetResult(interp); \ - Tcl_SetObjResult(interp, *(statePtr)); \ - Tcl_DecrRefCount(*(statePtr)); \ + Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \ + Tcl_DecrRefCount((statePtr)->objResultPtr); \ } while(0) +#undef Tcl_DiscardResult #define Tcl_DiscardResult(statePtr) \ - Tcl_DecrRefCount(*(statePtr)) + Tcl_DecrRefCount((statePtr)->objResultPtr) +#undef Tcl_SetResult #define Tcl_SetResult(interp, result, freeProc) \ do { \ - char *__result = result; \ + const char *__result = result; \ Tcl_FreeProc *__freeProc = freeProc; \ Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \ if (__freeProc == TCL_DYNAMIC) { \ - Tcl_Free(__result); \ + ckfree((char *)__result); \ } else { \ - (*__freeProc)(__result); \ + (*__freeProc)((char *)__result); \ } \ } \ } while(0) +#endif /* TCL_NO_DEPRECATED */ #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) # if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the @@ -3808,10 +4083,14 @@ * without introducing a binary incompatibility. */ # undef Tcl_GetLongFromObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj +# undef Tcl_UniCharNcmp +# undef Tcl_UtfNcmp +# undef Tcl_UtfNcasecmp +# undef Tcl_UniCharNcasecmp # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) # define Tcl_ExprLong TclExprLong static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){ int intValue; int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue); @@ -3823,81 +4102,86 @@ int intValue; int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue); if (result == TCL_OK) *ptr = (long)intValue; return result; } +# define Tcl_UniCharNcmp(ucs,uct,n) \ + ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) +# define Tcl_UtfNcmp(s1,s2,n) \ + ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) +# define Tcl_UtfNcasecmp(s1,s2,n) \ + ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) +# define Tcl_UniCharNcasecmp(ucs,uct,n) \ + ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif -#ifdef TCL_MEM_DEBUG -# undef Tcl_Alloc -# define Tcl_Alloc(x) \ - (Tcl_DbCkalloc((x), __FILE__, __LINE__)) -# undef Tcl_Free -# define Tcl_Free(x) \ - Tcl_DbCkfree((x), __FILE__, __LINE__) -# undef Tcl_Realloc -# define Tcl_Realloc(x,y) \ - (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__)) -# undef Tcl_AttemptAlloc -# define Tcl_AttemptAlloc(x) \ - (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__)) -# undef Tcl_AttemptRealloc -# define Tcl_AttemptRealloc(x,y) \ - (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)) -#endif /* !TCL_MEM_DEBUG */ - -#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) -#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) -#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) -#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) -#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) -#define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) -#define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) -#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) +#undef Tcl_NewLongObj +#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) +#undef Tcl_NewIntObj +#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) +#undef Tcl_DbNewLongObj +#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) +#undef Tcl_SetIntObj +#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) +#undef Tcl_SetLongObj +#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) +#undef Tcl_GetUnicode +#define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) +#undef Tcl_BackgroundError +#define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) +#undef Tcl_StringMatch +#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) + +#if TCL_UTF_MAX <= 3 +# undef Tcl_UniCharToUtfDString +# define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString +# undef Tcl_UtfToUniCharDString +# define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString +# undef Tcl_UtfToUniChar +# define Tcl_UtfToUniChar Tcl_UtfToChar16 +#endif +#if defined(USE_TCL_STUBS) +# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ + ? (char *(*)(const wchar_t *, int, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ + : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) +# define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ + ? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ + : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) +# define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ + ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToChar16 \ + : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) +#else +# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ + ? (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_UniCharToUtfDString \ + : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) +# define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ + ? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \ + : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) +# define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ + ? (int (*)(const char *, wchar_t *))Tcl_UtfToChar16 \ + : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) +#endif /* * Deprecated Tcl procedures: */ +#undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) +#undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) -#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl) -# ifdef USE_TCL_STUBS -# undef Tcl_Gets -# undef Tcl_GetsObj -# undef Tcl_Read -# undef Tcl_Ungets -# undef Tcl_Write -# undef Tcl_ReadChars -# undef Tcl_WriteChars -# undef Tcl_WriteObj -# undef Tcl_ReadRaw -# undef Tcl_WriteRaw -# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1) -# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1) -# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1) -# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1) -# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1) -# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) -# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1) -# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1) -# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) -# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1) -# else -# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1) -# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1) -# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1) -# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1) -# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1) -# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) -# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1) -# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1) -# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) -# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1) -# endif +#if defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS) +#undef Tcl_Close +#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) +#endif + +#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX > 3) +# undef Tcl_UtfCharComplete +# define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \ + ? ((length) >= 4) : tclStubsPtr->tcl_UtfCharComplete((src), (length))) #endif #endif /* _TCLDECLS */ Index: generic/tclDictObj.c ================================================================== --- generic/tclDictObj.c +++ generic/tclDictObj.c @@ -9,11 +9,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" #include /* * Forward declaration. */ @@ -21,66 +21,48 @@ /* * Prototypes for functions defined later in this file: */ -static void DeleteDict(struct Dict *dict); -static int DictAppendCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictCreateCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictExistsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictFilterCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictGetCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictGetDefCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictIncrCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictInfoCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictKeysCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictLappendCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictMergeCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictRemoveCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictReplaceCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictValuesCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int DictWithCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeDictInternalRep(Tcl_Obj *dictPtr); -static void InvalidateDictChain(Tcl_Obj *dictObj); -static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfDict(Tcl_Obj *dictPtr); -static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr, void *keyPtr); -static inline void InitChainTable(struct Dict *dict); -static inline void DeleteChainTable(struct Dict *dict); -static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict, - Tcl_Obj *keyPtr, int *newPtr); -static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr); -static Tcl_NRPostProc FinalizeDictUpdate; -static Tcl_NRPostProc FinalizeDictWith; -static Tcl_ObjCmdProc DictForNRCmd; -static Tcl_ObjCmdProc DictMapNRCmd; -static Tcl_NRPostProc DictForLoopCallback; -static Tcl_NRPostProc DictMapLoopCallback; +static void DeleteDict(struct Dict *dict); +static Tcl_ObjCmdProc DictAppendCmd; +static Tcl_ObjCmdProc DictCreateCmd; +static Tcl_ObjCmdProc DictExistsCmd; +static Tcl_ObjCmdProc DictFilterCmd; +static Tcl_ObjCmdProc DictGetCmd; +static Tcl_ObjCmdProc DictGetDefCmd; +static Tcl_ObjCmdProc DictIncrCmd; +static Tcl_ObjCmdProc DictInfoCmd; +static Tcl_ObjCmdProc DictKeysCmd; +static Tcl_ObjCmdProc DictLappendCmd; +static Tcl_ObjCmdProc DictMergeCmd; +static Tcl_ObjCmdProc DictRemoveCmd; +static Tcl_ObjCmdProc DictReplaceCmd; +static Tcl_ObjCmdProc DictSetCmd; +static Tcl_ObjCmdProc DictSizeCmd; +static Tcl_ObjCmdProc DictUnsetCmd; +static Tcl_ObjCmdProc DictUpdateCmd; +static Tcl_ObjCmdProc DictValuesCmd; +static Tcl_ObjCmdProc DictWithCmd; +static Tcl_DupInternalRepProc DupDictInternalRep; +static Tcl_FreeInternalRepProc FreeDictInternalRep; +static void InvalidateDictChain(Tcl_Obj *dictObj); +static Tcl_SetFromAnyProc SetDictFromAny; +static Tcl_UpdateStringProc UpdateStringOfDict; +static Tcl_AllocHashEntryProc AllocChainEntry; +static inline void InitChainTable(struct Dict *dict); +static inline void DeleteChainTable(struct Dict *dict); +static inline Tcl_HashEntry * CreateChainEntry(struct Dict *dict, + Tcl_Obj *keyPtr, int *newPtr); +static inline int DeleteChainEntry(struct Dict *dict, + Tcl_Obj *keyPtr); +static Tcl_NRPostProc FinalizeDictUpdate; +static Tcl_NRPostProc FinalizeDictWith; +static Tcl_ObjCmdProc DictForNRCmd; +static Tcl_ObjCmdProc DictMapNRCmd; +static Tcl_NRPostProc DictForLoopCallback; +static Tcl_NRPostProc DictMapLoopCallback; /* * Table of dict subcommand names and implementations. */ @@ -145,11 +127,11 @@ * created. */ ChainEntry *entryChainTail; /* Other end of linked list of all entries in * the dictionary. Used for doing traversal of * the entries in the order that they are * created. */ - size_t epoch; /* Epoch counter */ + unsigned int epoch; /* Epoch counter */ size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ } Dict; @@ -177,11 +159,11 @@ #define DictGetIntRep(objPtr, dictRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclDictType); \ - (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The type of the specially adapted version of the Tcl_Obj*-containing hash * table defined in the tclObj.c code. This version differs in that it @@ -238,20 +220,20 @@ *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocChainEntry( - Tcl_HashTable *tablePtr, + TCL_UNUSED(Tcl_HashTable *), void *keyPtr) { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; ChainEntry *cPtr; - cPtr = Tcl_Alloc(sizeof(ChainEntry)); + cPtr = (ChainEntry *)ckalloc(sizeof(ChainEntry)); cPtr->entry.key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); - Tcl_SetHashValue(&cPtr->entry, NULL); + cPtr->entry.clientData = NULL; cPtr->prevPtr = cPtr->nextPtr = NULL; return &cPtr->entry; } @@ -277,11 +259,11 @@ Dict *dict) { ChainEntry *cPtr; for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) { - Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); TclDecrRefCount(valuePtr); } Tcl_DeleteHashTable(&dict->table); } @@ -324,11 +306,11 @@ Tcl_FindHashEntry(&dict->table, keyPtr); if (cPtr == NULL) { return 0; } else { - Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); TclDecrRefCount(valuePtr); } /* @@ -375,11 +357,11 @@ static void DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict, *newDict = Tcl_Alloc(sizeof(Dict)); + Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict)); ChainEntry *cPtr; DictGetIntRep(srcPtr, oldDict); /* @@ -386,12 +368,12 @@ * Copy values across from the old hash table. */ InitChainTable(newDict); for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) { - Tcl_Obj *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry); - Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + Tcl_Obj *key = (Tcl_Obj *)Tcl_GetHashKey(&oldDict->table, &cPtr->entry); + Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); int n; Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n); /* * Fill in the contents. @@ -470,11 +452,11 @@ static void DeleteDict( Dict *dict) { DeleteChainTable(dict); - Tcl_Free(dict); + ckfree(dict); } /* *---------------------------------------------------------------------- * @@ -504,20 +486,20 @@ #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - size_t i, length, bytesNeeded = 0; + int i, length, bytesNeeded = 0; const char *elem; char *dst; /* * This field is the most useful one in the whole hash structure, and it * is not exposed by any API function... */ - size_t numElems; + int numElems; DictGetIntRep(dictPtr, dict); assert (dict != NULL); @@ -534,26 +516,36 @@ */ if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = Tcl_Alloc(numElems); + flagPtr = (char *)ckalloc(numElems); } for (i=0,cPtr=dict->entryChainHead; inextPtr) { /* * Assume that cPtr is never NULL since we know the number of array * elements already. */ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); - keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); + keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); + if (bytesNeeded < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + flagPtr[i+1] = TCL_DONT_QUOTE_HASH; - valuePtr = Tcl_GetHashValue(&cPtr->entry); + valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = TclGetStringFromObj(valuePtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); + if (bytesNeeded < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + } + if (bytesNeeded > INT_MAX - numElems + 1) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; /* * Pass 2: copy into string rep buffer. @@ -561,25 +553,25 @@ dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); TclOOM(dst, bytesNeeded); for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); - keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); + keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; - valuePtr = Tcl_GetHashValue(&cPtr->entry); + valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = TclGetStringFromObj(valuePtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); if (flagPtr != localFlags) { - Tcl_Free(flagPtr); + ckfree(flagPtr); } } /* *---------------------------------------------------------------------- @@ -606,11 +598,11 @@ Tcl_Interp *interp, Tcl_Obj *objPtr) { Tcl_HashEntry *hPtr; int isNew; - Dict *dict = Tcl_Alloc(sizeof(Dict)); + Dict *dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); /* * Since lists and dictionaries have very closely-related string @@ -631,35 +623,34 @@ for (i=0 ; irefCount++; TclFreeIntRep(dictPtr) DictSetIntRep(dictPtr, dict); Tcl_IncrRefCount(valuePtr); if (!isNew) { - Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr); + Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); dict->epoch++; @@ -1010,11 +1001,11 @@ hPtr = Tcl_FindHashEntry(&dict->table, keyPtr); if (hPtr == NULL) { *valuePtrPtr = NULL; } else { - *valuePtrPtr = Tcl_GetHashValue(hPtr); + *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); } return TCL_OK; } /* @@ -1151,14 +1142,14 @@ searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; dict->refCount++; if (keyPtrPtr != NULL) { - *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); + *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); } if (valuePtrPtr != NULL) { - *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry); + *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); } } return TCL_OK; } @@ -1217,25 +1208,25 @@ if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) { Tcl_Panic("concurrent dictionary modification and search"); } - cPtr = searchPtr->next; + cPtr = (ChainEntry *)searchPtr->next; if (cPtr == NULL) { Tcl_DictObjDone(searchPtr); *donePtr = 1; return; } searchPtr->next = cPtr->nextPtr; *donePtr = 0; if (keyPtrPtr != NULL) { - *keyPtrPtr = Tcl_GetHashKey( + *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey( &((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry); } if (valuePtrPtr != NULL) { - *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry); + *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); } } /* *---------------------------------------------------------------------- @@ -1318,11 +1309,11 @@ DictGetIntRep(dictPtr, dict); assert(dict != NULL); hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { - Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr); + Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); InvalidateDictChain(dictPtr); @@ -1413,11 +1404,11 @@ Tcl_Obj *dictPtr; Dict *dict; TclNewObj(dictPtr); TclInvalidateStringRep(dictPtr); - dict = Tcl_Alloc(sizeof(Dict)); + dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 1; dict->chain = NULL; dict->refCount = 1; DictSetIntRep(dictPtr, dict); @@ -1450,32 +1441,38 @@ * None. * *---------------------------------------------------------------------- */ +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDictObj( const char *file, int line) { -#ifdef TCL_MEM_DEBUG Tcl_Obj *dictPtr; Dict *dict; TclDbNewObj(dictPtr, file, line); TclInvalidateStringRep(dictPtr); - dict = Tcl_Alloc(sizeof(Dict)); + dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 1; dict->chain = NULL; dict->refCount = 1; DictSetIntRep(dictPtr, dict); return dictPtr; +} #else /* !TCL_MEM_DEBUG */ +Tcl_Obj * +Tcl_DbNewDictObj( + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ return Tcl_NewDictObj(); -#endif } +#endif /***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/ /* *---------------------------------------------------------------------- @@ -1495,11 +1492,11 @@ *---------------------------------------------------------------------- */ static int DictCreateCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictObj; @@ -1545,11 +1542,11 @@ *---------------------------------------------------------------------- */ static int DictGetCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr = NULL; @@ -1638,11 +1635,11 @@ *---------------------------------------------------------------------- */ static int DictGetDefCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr; @@ -1703,11 +1700,11 @@ *---------------------------------------------------------------------- */ static int DictReplaceCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; @@ -1751,11 +1748,11 @@ *---------------------------------------------------------------------- */ static int DictRemoveCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; @@ -1799,11 +1796,11 @@ *---------------------------------------------------------------------- */ static int DictMergeCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL; @@ -1886,11 +1883,11 @@ *---------------------------------------------------------------------- */ static int DictKeysCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *listPtr; @@ -1965,11 +1962,11 @@ *---------------------------------------------------------------------- */ static int DictValuesCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *valuePtr = NULL, *listPtr; @@ -2025,11 +2022,11 @@ *---------------------------------------------------------------------- */ static int DictSizeCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int result, size; @@ -2063,11 +2060,11 @@ *---------------------------------------------------------------------- */ static int DictExistsCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr; @@ -2105,11 +2102,11 @@ *---------------------------------------------------------------------- */ static int DictInfoCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Dict *dict; @@ -2125,11 +2122,11 @@ return TCL_ERROR; } statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); - Tcl_Free(statsStr); + ckfree(statsStr); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -2149,11 +2146,11 @@ *---------------------------------------------------------------------- */ static int DictIncrCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int code = TCL_OK; @@ -2269,11 +2266,11 @@ *---------------------------------------------------------------------- */ static int DictLappendCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; @@ -2356,11 +2353,11 @@ *---------------------------------------------------------------------- */ static int DictAppendCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; @@ -2458,11 +2455,11 @@ *---------------------------------------------------------------------- */ static int DictForNRCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -2488,11 +2485,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL); return TCL_ERROR; } - searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch)); + searchPtr = (Tcl_DictSearch *)TclStackAlloc(interp, sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj, &done) != TCL_OK) { TclStackFree(interp, searchPtr); return TCL_ERROR; } @@ -2558,14 +2555,14 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - Tcl_DictSearch *searchPtr = data[0]; - Tcl_Obj *keyVarObj = data[1]; - Tcl_Obj *valueVarObj = data[2]; - Tcl_Obj *scriptObj = data[3]; + Tcl_DictSearch *searchPtr = (Tcl_DictSearch *)data[0]; + Tcl_Obj *keyVarObj = (Tcl_Obj *)data[1]; + Tcl_Obj *valueVarObj = (Tcl_Obj *)data[2]; + Tcl_Obj *scriptObj = (Tcl_Obj *)data[3]; Tcl_Obj *keyObj, *valueObj; int done; /* * Process the result from the previous execution of the script body. @@ -2653,11 +2650,11 @@ *---------------------------------------------------------------------- */ static int DictMapNRCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -2682,11 +2679,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL); return TCL_ERROR; } - storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage)); + storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage)); if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj, &valueObj, &done) != TCL_OK) { TclStackFree(interp, storagePtr); return TCL_ERROR; } @@ -2762,11 +2759,11 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - DictMapStorage *storagePtr = data[0]; + DictMapStorage *storagePtr = (DictMapStorage *)data[0]; Tcl_Obj *keyObj, *valueObj; int done; /* * Process the result from the previous execution of the script body. @@ -2865,11 +2862,11 @@ *---------------------------------------------------------------------- */ static int DictSetCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *resultPtr; @@ -2925,11 +2922,11 @@ *---------------------------------------------------------------------- */ static int DictUnsetCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *resultPtr; @@ -2984,11 +2981,11 @@ *---------------------------------------------------------------------- */ static int DictFilterCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -3200,10 +3197,11 @@ * do. */ Tcl_ResetResult(interp); Tcl_DictObjDone(&search); + /* FALLTHRU */ case TCL_CONTINUE: result = TCL_OK; break; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -3268,11 +3266,11 @@ *---------------------------------------------------------------------- */ static int DictUpdateCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -3298,11 +3296,11 @@ TclDecrRefCount(dictPtr); return TCL_ERROR; } if (objPtr == NULL) { /* ??? */ - Tcl_UnsetVar(interp, TclGetString(objv[i+1]), 0); + Tcl_UnsetVar2(interp, Tcl_GetString(objv[i+1]), NULL, 0); } else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(dictPtr); return TCL_ERROR; } @@ -3329,12 +3327,12 @@ int result) { Tcl_Obj *dictPtr, *objPtr, **objv; Tcl_InterpState state; int i, objc; - Tcl_Obj *varName = data[0]; - Tcl_Obj *argsObj = data[1]; + Tcl_Obj *varName = (Tcl_Obj *)data[0]; + Tcl_Obj *argsObj = (Tcl_Obj *)data[1]; /* * ErrorInfo handling. */ @@ -3426,11 +3424,11 @@ *---------------------------------------------------------------------- */ static int DictWithCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -3480,13 +3478,13 @@ int result) { Tcl_Obj **pathv; int pathc; Tcl_InterpState state; - Tcl_Obj *varName = data[0]; - Tcl_Obj *keysPtr = data[1]; - Tcl_Obj *pathPtr = data[2]; + Tcl_Obj *varName = (Tcl_Obj *)data[0]; + Tcl_Obj *keysPtr = (Tcl_Obj *)data[1]; + Tcl_Obj *pathPtr = (Tcl_Obj *)data[2]; Var *varPtr, *arrayPtr; if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")"); } Index: generic/tclDisassemble.c ================================================================== --- generic/tclDisassemble.c +++ generic/tclDisassemble.c @@ -19,14 +19,12 @@ /* * Prototypes for procedures defined later in this file: */ -static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Interp *interp, - Tcl_Obj *objPtr); -static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); +static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Obj *objPtr); +static Tcl_Obj * DisassembleByteCodeObj(Tcl_Obj *objPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void GetLocationInformation(Proc *procPtr, Tcl_Obj **fileObjPtr, int *linePtr); static void PrintSourceToObj(Tcl_Obj *appendObj, @@ -130,14 +128,14 @@ *---------------------------------------------------------------------- */ void TclPrintByteCodeObj( - Tcl_Interp *interp, /* Used only for getting location info. */ + TCL_UNUSED(Tcl_Interp *), /* Stuck with this in internal stubs */ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { - Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr); + Tcl_Obj *bufPtr = DisassembleByteCodeObj(objPtr); fprintf(stdout, "\n%s", TclGetString(bufPtr)); Tcl_DecrRefCount(bufPtr); } @@ -193,14 +191,14 @@ void TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ - size_t maxChars) /* Maximum number of chars to print. */ + int maxChars) /* Maximum number of chars to print. */ { char *bytes; - size_t length; + int length; bytes = TclGetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); } @@ -224,11 +222,11 @@ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ - size_t maxChars) /* Maximum number of chars to print. */ + int maxChars) /* Maximum number of chars to print. */ { Tcl_Obj *bufferObj; TclNewObj(bufferObj); PrintSourceToObj(bufferObj, stringPtr, maxChars); @@ -249,11 +247,10 @@ *---------------------------------------------------------------------- */ static Tcl_Obj * DisassembleByteCodeObj( - Tcl_Interp *interp, Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { ByteCode *codePtr; unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; @@ -278,19 +275,20 @@ /* * Print header lines describing the ByteCode. */ Tcl_AppendPrintfToObj(bufferObj, - "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n", - codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); + "ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n", + codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, + iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(codePtr->procPtr, &fileObj, &line); if (line > -1 && fileObj != NULL) { Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d", - TclGetString(fileObj), line); + Tcl_GetString(fileObj), line); } Tcl_AppendPrintfToObj(bufferObj, "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, @@ -322,11 +320,11 @@ if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; int numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n", + " Proc %p, refCt %u, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { CompiledLocal *localPtr = procPtr->firstLocalPtr; @@ -406,40 +404,40 @@ codeLengthNext = codePtr->codeLengthStart; srcDeltaNext = codePtr->srcDeltaStart; srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if (*codeDeltaNext == 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; } else { delta = TclGetInt1AtPtr(codeDeltaNext); codeDeltaNext++; } codeOffset += delta; - if (*codeLengthNext == 0xFF) { + if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; } else { codeLen = TclGetInt1AtPtr(codeLengthNext); codeLengthNext++; } - if (*srcDeltaNext == 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; } else { delta = TclGetInt1AtPtr(srcDeltaNext); srcDeltaNext++; } srcOffset += delta; - if (*srcLengthNext == 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; } else { srcLen = TclGetInt1AtPtr(srcLengthNext); @@ -465,31 +463,31 @@ srcDeltaNext = codePtr->srcDeltaStart; srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; pc = codeStart; for (i = 0; i < numCmds; i++) { - if (*codeDeltaNext == 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; } else { delta = TclGetInt1AtPtr(codeDeltaNext); codeDeltaNext++; } codeOffset += delta; - if (*srcDeltaNext == 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; } else { delta = TclGetInt1AtPtr(srcDeltaNext); srcDeltaNext++; } srcOffset += delta; - if (*srcLengthNext == 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; } else { srcLen = TclGetInt1AtPtr(srcLengthNext); @@ -539,11 +537,11 @@ const unsigned char *pc, /* Points to first byte of instruction. */ Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; - register const InstructionDesc *instDesc = &tclInstructionTable[opCode]; + const InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; @@ -565,19 +563,19 @@ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_UINT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; - Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { sprintf(suffixBuffer+strlen(suffixBuffer), ", %u cmds start here", opnd); } - Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_OFFSET1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; sprintf(suffixBuffer, "pc %u", pcOffset+opnd); Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); @@ -592,20 +590,20 @@ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_LIT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; suffixObj = codePtr->objArrayPtr[opnd]; - Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_LIT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; suffixObj = codePtr->objArrayPtr[opnd]; - Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_AUX4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; - Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); auxPtr = &codePtr->auxDataArrayPtr[opnd]; break; case OPERAND_IDX4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opnd >= -1) { @@ -625,23 +623,23 @@ numBytes += 4; printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", - opnd, localCt); + (unsigned) opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { - sprintf(suffixBuffer, "temp var %u", opnd); + sprintf(suffixBuffer, "temp var %u", (unsigned) opnd); } else { sprintf(suffixBuffer, "var "); suffixSrc = localPtr->name; } } - Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd); break; case OPERAND_SCLS1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%s ", tclStringClassTable[opnd].name); @@ -651,11 +649,11 @@ break; } } if (suffixObj) { const char *bytes; - size_t length; + int length; Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length); PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { @@ -838,11 +836,11 @@ TclOOM(dst, TCL_INTEGER_SPACE + 5); sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; - size_t len = strlen(s); + unsigned int len = strlen(s); dst = Tcl_InitStringRep(objPtr, s, len); TclOOM(dst, len); } } @@ -860,25 +858,25 @@ PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { - register const char *p; - register int i = 0, len; - Tcl_UniChar ch = 0; + const char *p; + int i = 0, len; if (stringPtr == NULL) { Tcl_AppendToObj(appendObj, "\"\"", -1); return; } Tcl_AppendToObj(appendObj, "\"", -1); p = stringPtr; for (; (*p != '\0') && (i < maxChars); p+=len) { + int ucs4; - len = TclUtfToUniChar(p, &ch); - switch (ch) { + len = TclUtfToUCS4(p, &ucs4); + switch (ucs4) { case '"': Tcl_AppendToObj(appendObj, "\\\"", -1); i += 2; continue; case '\f': @@ -900,32 +898,18 @@ case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: -#if TCL_UTF_MAX > 4 - if (ch > 0xffff) { - Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch); - i += 10; - } else -#else - /* If len == 0, this means we have a char > 0xffff, resulting in - * TclUtfToUniChar producing a surrogate pair. We want to output - * this pair as a single Unicode character. - */ - if (len == 0) { - int upper = ((ch & 0x3ff) + 1) << 10; - len = TclUtfToUniChar(p, &ch); - Tcl_AppendPrintfToObj(appendObj, "\\U%08x", upper + (ch & 0x3ff)); - i += 10; - } else -#endif - if (ch < 0x20 || ch >= 0x7f) { - Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch); + if (ucs4 > 0xFFFF) { + Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ucs4); + i += 10; + } else if (ucs4 < 0x20 || ucs4 >= 0x7F) { + Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ucs4); i += 6; } else { - Tcl_AppendPrintfToObj(appendObj, "%c", ch); + Tcl_AppendPrintfToObj(appendObj, "%c", ucs4); i++; } continue; } } @@ -949,12 +933,10 @@ *---------------------------------------------------------------------- */ static Tcl_Obj * DisassembleByteCodeAsDicts( - Tcl_Interp *interp, /* Used for looking up the CmdFrame for the - * procedure, if one exists. */ Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */ { ByteCode *codePtr; Tcl_Obj *description, *literals, *variables, *instructions, *inst; Tcl_Obj *aux, *exn, *commands, *file; @@ -1574,11 +1556,11 @@ "unknown method \"%s\"", TclGetString(objv[3]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[3]), NULL); return TCL_ERROR; } - procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); + procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); @@ -1621,14 +1603,14 @@ "BYTECODE", NULL); return TCL_ERROR; } if (clientData) { Tcl_SetObjResult(interp, - DisassembleByteCodeAsDicts(interp, codeObjPtr)); + DisassembleByteCodeAsDicts(codeObjPtr)); } else { Tcl_SetObjResult(interp, - DisassembleByteCodeObj(interp, codeObjPtr)); + DisassembleByteCodeObj(codeObjPtr)); } return TCL_OK; } /* Index: generic/tclEncoding.c ================================================================== --- generic/tclEncoding.c +++ generic/tclEncoding.c @@ -81,11 +81,11 @@ * the value in the matrix is 0x0000. * malloc'd. */ } TableEncodingData; /* - * The following structures is the clientData for a dynamically-loaded, + * Each of the following structures is the clientData for a dynamically-loaded * escape-driven encoding that is itself comprised of other simpler encodings. * An example is "iso-2022-jp", which uses escape sequences to switch between * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven" * does not necessarily mean that the ESCAPE character is the character used * for switching character sets. @@ -115,12 +115,12 @@ * the following array, the corresponding * entry in this array is 1, otherwise it is * 0. */ int numSubTables; /* Length of following array. */ EscapeSubTable subTables[1];/* Information about each EscapeSubTable used - * by this encoding type. The actual size will - * be as large as necessary to hold all + * by this encoding type. The actual size is + * as large as necessary to hold all * EscapeSubTables. */ } EscapeEncodingData; /* * Constants used when loading an encoding file to identify the type of the @@ -154,11 +154,11 @@ /* * A list of directories making up the "library path". Historically this * search path has served many uses, but the only one remaining is a base for * the encodingSearchPath above. If the application does not explicitly set - * the encodingSearchPath, then it will be initialized by appending /encoding + * the encodingSearchPath, then it is initialized by appending /encoding * to each directory in this "libraryPath". */ static ProcessGlobalValue libraryPath = { 0, 0, NULL, NULL, TclpInitLibraryPath, NULL, NULL @@ -175,11 +175,11 @@ TCL_DECLARE_MUTEX(encodingMutex) /* * The following are used to hold the default and current system encodings. * If NULL is passed to one of the conversion routines, the current setting of - * the system encoding will be used to perform the conversion. + * the system encoding is used to perform the conversion. */ static Tcl_Encoding defaultEncoding = NULL; static Tcl_Encoding systemEncoding = NULL; Tcl_Encoding tclIdentityEncoding = NULL; @@ -193,84 +193,45 @@ /* * Functions used only in this module. */ -static int BinaryProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static void DupEncodingIntRep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); -static void EscapeFreeProc(ClientData clientData); -static int EscapeFromUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int EscapeToUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static void FillEncodingFileMap(void); -static void FreeEncoding(Tcl_Encoding encoding); -static void FreeEncodingIntRep(Tcl_Obj *objPtr); -static Encoding * GetTableEncoding(EscapeEncodingData *dataPtr, - int state); -static Tcl_Encoding LoadEncodingFile(Tcl_Interp *interp, const char *name); -static Tcl_Encoding LoadTableEncoding(const char *name, int type, - Tcl_Channel chan); -static Tcl_Encoding LoadEscapeEncoding(const char *name, Tcl_Channel chan); -static Tcl_Channel OpenEncodingFileChannel(Tcl_Interp *interp, - const char *name); -static void TableFreeProc(ClientData clientData); -static int TableFromUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int TableToUtfProc(ClientData clientData, const char *src, - int srcLen, int flags, Tcl_EncodingState *statePtr, - char *dst, int dstLen, int *srcReadPtr, - int *dstWrotePtr, int *dstCharsPtr); -static size_t unilen(const char *src); -static int UniCharToUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int UtfToUniCharProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int UtfToUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr, int pureNullMode); -static int UtfIntToUtfExtProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int UtfExtToUtfIntProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int Iso88591FromUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, - int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); -static int Iso88591ToUtfProc(ClientData clientData, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, - int dstLen, int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr); +static Tcl_EncodingConvertProc BinaryProc; +static Tcl_DupInternalRepProc DupEncodingIntRep; +static Tcl_EncodingFreeProc EscapeFreeProc; +static Tcl_EncodingConvertProc EscapeFromUtfProc; +static Tcl_EncodingConvertProc EscapeToUtfProc; +static void FillEncodingFileMap(void); +static void FreeEncoding(Tcl_Encoding encoding); +static Tcl_FreeInternalRepProc FreeEncodingIntRep; +static Encoding * GetTableEncoding(EscapeEncodingData *dataPtr, + int state); +static Tcl_Encoding LoadEncodingFile(Tcl_Interp *interp, + const char *name); +static Tcl_Encoding LoadTableEncoding(const char *name, int type, + Tcl_Channel chan); +static Tcl_Encoding LoadEscapeEncoding(const char *name, + Tcl_Channel chan); +static Tcl_Channel OpenEncodingFileChannel(Tcl_Interp *interp, + const char *name); +static Tcl_EncodingFreeProc TableFreeProc; +static Tcl_EncodingConvertProc TableFromUtfProc; +static Tcl_EncodingConvertProc TableToUtfProc; +static size_t unilen(const char *src); +static Tcl_EncodingConvertProc Utf16ToUtfProc; +static Tcl_EncodingConvertProc UtfToUtf16Proc; +static Tcl_EncodingConvertProc UtfToUcs2Proc; +static int UtfToUtfProc(ClientData clientData, + const char *src, int srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, + int dstLen, int *srcReadPtr, + int *dstWrotePtr, int *dstCharsPtr, + int pureNullMode); +static Tcl_EncodingConvertProc UtfIntToUtfExtProc; +static Tcl_EncodingConvertProc UtfExtToUtfIntProc; +static Tcl_EncodingConvertProc Iso88591FromUtfProc; +static Tcl_EncodingConvertProc Iso88591ToUtfProc; /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the intrep. This should help the lifetime of encodings be more useful. * See concerns raised in [Bug 1077262]. @@ -289,11 +250,11 @@ #define EncodingGetIntRep(objPtr, encoding) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep ((objPtr), &encodingType); \ - (encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* *---------------------------------------------------------------------- @@ -444,13 +405,12 @@ * TclSetLibraryPath -- * * Keeps the per-thread copy of the library path current with changes to * the global copy. * - * NOTE: this routine returns void, so there's no way to report the error - * that searchPath is not a valid list. In that case, this routine will - * silently do nothing. + * Since the result of this routine is void, if searchPath is not a valid + * list this routine silently does nothing. * *---------------------------------------------------------------------- */ void @@ -468,21 +428,20 @@ /* *--------------------------------------------------------------------------- * * FillEncodingFileMap -- * - * Called to bring the encoding file map in sync with the current value + * Called to update the encoding file map with the current value * of the encoding search path. * - * Scan the directories on the encoding search path, find the *.enc - * files, and store the found pathnames in a map associated with the - * encoding name. - * - * In particular, if $dir is on the encoding search path, and the file - * $dir/foo.enc is found, then store a "foo" -> $dir entry in the map. - * Later, any need for the "foo" encoding will quickly * be able to - * construct the $dir/foo.enc pathname for reading the encoding data. + * Finds *.end files in the directories on the encoding search path and + * stores the found pathnames in a map associated with the encoding name. + * + * If $dir is on the encoding search path and the file $dir/foo.enc is + * found, stores a "foo" -> $dir entry in the map. if the "foo" encoding + * is needed later, the $dir/foo.enc name can be quickly constructed in + * order to read the encoding data. * * Results: * None. * * Side effects: @@ -562,23 +521,28 @@ { Tcl_EncodingType type; TableEncodingData *dataPtr; unsigned size; unsigned short i; + union { + char c; + short s; + } isLe; if (encodingsInitialized) { return; } + isLe.s = 1; Tcl_MutexLock(&encodingMutex); Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&encodingMutex); /* - * Create a few initial encodings. Note that the UTF-8 to UTF-8 - * translation is not a no-op, because it will turn a stream of improperly - * formed UTF-8 into a properly formed stream. + * Create a few initial encodings. UTF-8 to UTF-8 translation is not a + * no-op because it turns a stream of improperly formed UTF-8 into a + * properly formed stream. */ type.encodingName = NULL; type.toUtfProc = BinaryProc; type.fromUtfProc = BinaryProc; @@ -593,33 +557,58 @@ type.freeProc = NULL; type.nullSize = 1; type.clientData = NULL; Tcl_CreateEncoding(&type); - type.encodingName = "unicode"; - type.toUtfProc = UniCharToUtfProc; - type.fromUtfProc = UtfToUniCharProc; + type.toUtfProc = Utf16ToUtfProc; + type.fromUtfProc = UtfToUcs2Proc; + type.freeProc = NULL; + type.nullSize = 2; + type.encodingName = "ucs-2le"; + type.clientData = INT2PTR(1); + Tcl_CreateEncoding(&type); + type.encodingName = "ucs-2be"; + type.clientData = INT2PTR(0); + Tcl_CreateEncoding(&type); + type.encodingName = "ucs-2"; + type.clientData = INT2PTR(isLe.c); + Tcl_CreateEncoding(&type); + + type.toUtfProc = Utf16ToUtfProc; + type.fromUtfProc = UtfToUtf16Proc; type.freeProc = NULL; type.nullSize = 2; - type.clientData = NULL; + type.encodingName = "utf-16le"; + type.clientData = INT2PTR(1); + Tcl_CreateEncoding(&type); + type.encodingName = "utf-16be"; + type.clientData = INT2PTR(0); + Tcl_CreateEncoding(&type); + type.encodingName = "utf-16"; + type.clientData = INT2PTR(isLe.c); + Tcl_CreateEncoding(&type); + +#ifndef TCL_NO_DEPRECATED + type.encodingName = "unicode"; Tcl_CreateEncoding(&type); +#endif /* * Need the iso8859-1 encoding in order to process binary data, so force * it to always be embedded. Note that this encoding *must* be a proper * table encoding or some of the escape encodings crash! Hence the ugly * code to duplicate the structure of a table encoding here. */ - dataPtr = Tcl_Alloc(sizeof(TableEncodingData)); + dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = '?'; size = 256*(sizeof(unsigned short *) + sizeof(unsigned short)); - dataPtr->toUnicode = Tcl_Alloc(size); + dataPtr->toUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->toUnicode, 0, size); - dataPtr->fromUnicode = Tcl_Alloc(size); + dataPtr->fromUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->fromUnicode, 0, size); dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256); dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256); for (i=1 ; i<256 ; i++) { @@ -681,18 +670,82 @@ * like escape encodings use. [Bug 524674] Make sure to call * Tcl_FirstHashEntry repeatedly so that all encodings are eventually * cleaned up. */ - FreeEncoding(Tcl_GetHashValue(hPtr)); + FreeEncoding((Tcl_Encoding)Tcl_GetHashValue(hPtr)); hPtr = Tcl_FirstHashEntry(&encodingTable, &search); } Tcl_DeleteHashTable(&encodingTable); Tcl_MutexUnlock(&encodingMutex); } +/* + *------------------------------------------------------------------------- + * + * Tcl_GetDefaultEncodingDir -- + * + * Legacy public interface to retrieve first directory in the encoding + * searchPath. + * + * Results: + * The directory pathname, as a string, or NULL for an empty encoding + * search path. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +const char * +Tcl_GetDefaultEncodingDir(void) +{ + int numDirs; + Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); + + Tcl_ListObjLength(NULL, searchPath, &numDirs); + if (numDirs == 0) { + return NULL; + } + Tcl_ListObjIndex(NULL, searchPath, 0, &first); + + return TclGetString(first); +} + +/* + *------------------------------------------------------------------------- + * + * Tcl_SetDefaultEncodingDir -- + * + * Legacy public interface to set the first directory in the encoding + * search path. + * + * Results: + * None. + * + * Side effects: + * Modifies the encoding search path. + * + *------------------------------------------------------------------------- + */ + +void +Tcl_SetDefaultEncodingDir( + const char *path) +{ + Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); + Tcl_Obj *directory = Tcl_NewStringObj(path, -1); + + searchPath = Tcl_DuplicateObj(searchPath); + Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); + Tcl_SetEncodingSearchPath(searchPath); +} +#endif + /* *------------------------------------------------------------------------- * * Tcl_GetEncoding -- * @@ -705,15 +758,11 @@ * to any known or loadable encoding, NULL is returned. If NULL was * returned, an error message is left in interp's result object, unless * interp was NULL. * * Side effects: - * The new encoding type is entered into a table visible to all - * interpreters, keyed off the encoding's name. For each call to this - * function, there should eventually be a call to Tcl_FreeEncoding, so - * that the database can be cleaned up when encodings aren't needed - * anymore. + * LoadEncodingFile is called if necessary. * *------------------------------------------------------------------------- */ Tcl_Encoding @@ -732,11 +781,11 @@ return systemEncoding; } hPtr = Tcl_FindHashEntry(&encodingTable, name); if (hPtr != NULL) { - encodingPtr = Tcl_GetHashValue(hPtr); + encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr); encodingPtr->refCount++; Tcl_MutexUnlock(&encodingMutex); return (Tcl_Encoding) encodingPtr; } Tcl_MutexUnlock(&encodingMutex); @@ -747,19 +796,19 @@ /* *--------------------------------------------------------------------------- * * Tcl_FreeEncoding -- * - * This function is called to release an encoding allocated by - * Tcl_CreateEncoding() or Tcl_GetEncoding(). + * Releases an encoding allocated by Tcl_CreateEncoding() or + * Tcl_GetEncoding(). * * Results: * None. * * Side effects: * The reference count associated with the encoding is decremented and - * the encoding may be deleted if nothing is using it anymore. + * the encoding is deleted if nothing is using it anymore. * *--------------------------------------------------------------------------- */ void @@ -774,17 +823,18 @@ /* *---------------------------------------------------------------------- * * FreeEncoding -- * - * This function is called to release an encoding by functions that - * already have the encodingMutex. + * Decrements the reference count of an encoding. The caller must hold + * encodingMutes. * * Results: * None. * * Side effects: + * Releases the resource for an encoding if it is now unused. * The reference count associated with the encoding is decremented and * the encoding may be deleted if nothing is using it anymore. * *---------------------------------------------------------------------- */ @@ -804,13 +854,13 @@ } if (encodingPtr->hPtr != NULL) { Tcl_DeleteHashEntry(encodingPtr->hPtr); } if (encodingPtr->name) { - Tcl_Free(encodingPtr->name); + ckfree(encodingPtr->name); } - Tcl_Free(encodingPtr); + ckfree(encodingPtr); } } /* *------------------------------------------------------------------------- @@ -876,11 +926,11 @@ */ Tcl_MutexLock(&encodingMutex); for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Encoding *encodingPtr = Tcl_GetHashValue(hPtr); + Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr); Tcl_CreateHashEntry(&table, Tcl_NewStringObj(encodingPtr->name, -1), &dummy); } Tcl_MutexUnlock(&encodingMutex); @@ -968,37 +1018,36 @@ /* *--------------------------------------------------------------------------- * * Tcl_CreateEncoding -- * - * This function is called to define a new encoding and the functions - * that are used to convert between the specified encoding and Unicode. + * Defines a new encoding, along with the functions that are used to + * convert to and from Unicode. * * Results: * Returns a token that represents the encoding. If an encoding with the * same name already existed, the old encoding token remains valid and - * continues to behave as it used to, and will eventually be garbage - * collected when the last reference to it goes away. Any subsequent - * calls to Tcl_GetEncoding with the specified name will retrieve the - * most recent encoding token. + * continues to behave as it used to, and is eventually garbage collected + * when the last reference to it goes away. Any subsequent calls to + * Tcl_GetEncoding with the specified name retrieve the most recent + * encoding token. * * Side effects: - * The new encoding type is entered into a table visible to all - * interpreters, keyed off the encoding's name. For each call to this - * function, there should eventually be a call to Tcl_FreeEncoding, so - * that the database can be cleaned up when encodings aren't needed - * anymore. + * A new record having the name of the encoding is entered into a table of + * encodings visible to all interpreters. For each call to this function, + * there should eventually be a call to Tcl_FreeEncoding, which cleans + * deletes the record in the table when an encoding is no longer needed. * *--------------------------------------------------------------------------- */ Tcl_Encoding Tcl_CreateEncoding( const Tcl_EncodingType *typePtr) /* The encoding type. */ { - Encoding *encodingPtr = Tcl_Alloc(sizeof(Encoding)); + Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding)); encodingPtr->name = NULL; encodingPtr->toUtfProc = typePtr->toUtfProc; encodingPtr->fromUtfProc = typePtr->fromUtfProc; encodingPtr->freeProc = typePtr->freeProc; encodingPtr->nullSize = typePtr->nullSize; @@ -1022,15 +1071,15 @@ /* * Remove old encoding from hash table, but don't delete it until last * reference goes away. */ - Encoding *replaceMe = Tcl_GetHashValue(hPtr); + Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr); replaceMe->hPtr = NULL; } - name = Tcl_Alloc(strlen(typePtr->encodingName) + 1); + name = (char *)ckalloc(strlen(typePtr->encodingName) + 1); encodingPtr->name = strcpy(name, typePtr->encodingName); encodingPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, encodingPtr); Tcl_MutexUnlock(&encodingMutex); @@ -1062,20 +1111,19 @@ char * Tcl_ExternalToUtfDString( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - size_t srcLen, /* Source string length in bytes, or -1 for + int srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int flags, result, soFar, srcRead, dstWrote, dstChars; - size_t dstLen; + int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; @@ -1084,11 +1132,11 @@ } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; - } else if (srcLen == TCL_AUTO_LENGTH) { + } else if (srcLen < 0) { srcLen = encodingPtr->lengthProc(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; @@ -1132,25 +1180,25 @@ *------------------------------------------------------------------------- */ int Tcl_ExternalToUtf( - Tcl_Interp *interp, /* Interp for error return, if not NULL. */ + TCL_UNUSED(Tcl_Interp *), /* TODO: Re-examine this. */ Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - size_t srcLen, /* Source string length in bytes, or -1 - * for encoding-specific string length. */ + int srcLen, /* Source string length in bytes, or < 0 for + * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ - size_t dstLen, /* The maximum length of output buffer in + int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source @@ -1174,11 +1222,11 @@ } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; - } else if (srcLen == TCL_AUTO_LENGTH) { + } else if (srcLen < 0) { srcLen = encodingPtr->lengthProc(src); } if (statePtr == NULL) { flags |= TCL_ENCODING_START | TCL_ENCODING_END; statePtr = &state; @@ -1214,11 +1262,11 @@ flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr); if (*dstCharsPtr <= maxChars) { break; } - dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX; + dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1); flags = savedFlags; *statePtr = savedState; } while (1); if (!noTerminate) { /* ...and then append it */ @@ -1232,14 +1280,13 @@ /* *------------------------------------------------------------------------- * * Tcl_UtfToExternalDString -- * - * Convert a source buffer from UTF-8 into the specified encoding. If any + * Convert a source buffer from UTF-8 to the specified encoding. If any * of the bytes in the source buffer are invalid or cannot be represented - * in the target encoding, a default fallback character will be - * substituted. + * in the target encoding, a default fallback character is substituted. * * Results: * The converted bytes are stored in the DString, which is then NULL * terminated in an encoding-specific manner. The return value is a * pointer to the value stored in the DString. @@ -1253,20 +1300,19 @@ char * Tcl_UtfToExternalDString( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - size_t srcLen, /* Source string length in bytes, or -1 for + int srcLen, /* Source string length in bytes, or < 0 for * strlen(). */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int flags, result, soFar, srcRead, dstWrote, dstChars; - size_t dstLen; + int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; @@ -1275,11 +1321,11 @@ } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; - } else if (srcLen == TCL_AUTO_LENGTH) { + } else if (srcLen < 0) { srcLen = strlen(src); } flags = TCL_ENCODING_START | TCL_ENCODING_END; while (1) { result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, @@ -1325,25 +1371,25 @@ *------------------------------------------------------------------------- */ int Tcl_UtfToExternal( - Tcl_Interp *interp, /* Interp for error return, if not NULL. */ + TCL_UNUSED(Tcl_Interp *), /* TODO: Re-examine this. */ Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - size_t srcLen, /* Source string length in bytes, or -1 - * for strlen(). */ + int srcLen, /* Source string length in bytes, or < 0 for + * strlen(). */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise * conversion. Contents of statePtr are * initialized and/or reset by conversion * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string * is stored. */ - size_t dstLen, /* The maximum length of output buffer in + int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may * be less than the original source length if * there was a problem converting some source @@ -1364,11 +1410,11 @@ } encodingPtr = (Encoding *) encoding; if (src == NULL) { srcLen = 0; - } else if (srcLen == TCL_AUTO_LENGTH) { + } else if (srcLen < 0) { srcLen = strlen(src); } if (statePtr == NULL) { flags |= TCL_ENCODING_START | TCL_ENCODING_END; statePtr = &state; @@ -1416,11 +1462,11 @@ void Tcl_FindExecutable( const char *argv0) /* The value of the application's argv[0] * (native). */ { - TclInitSubsystems(); + Tcl_InitSubsystems(); TclpSetInitialEncodings(); TclpFindExecutable(argv0); } /* @@ -1547,26 +1593,26 @@ * * Read a file that describes an encoding and create a new Encoding from * the data. * * Results: - * The return value is the newly loaded Encoding, or NULL if the file - * didn't exist of was in the incorrect format. If NULL was returned, an - * error message is left in interp's result object, unless interp was - * NULL. + * The return value is the newly loaded Tcl_Encoding or NULL if the file + * didn't exist or could not be processed. If NULL is returned and interp + * is not NULL, an error message is left in interp's result object. * * Side effects: - * File read from disk. + * A corresponding encoding file might be read from persistent storage, in + * which case LoadTableEncoding is called. * *--------------------------------------------------------------------------- */ static Tcl_Encoding LoadEncodingFile( Tcl_Interp *interp, /* Interp for error reporting, if not NULL. */ - const char *name) /* The name of the encoding file on disk and - * also the name for new encoding. */ + const char *name) /* The name of both the encoding file + * and the new encoding. */ { Tcl_Channel chan = NULL; Tcl_Encoding encoding = NULL; int ch; @@ -1616,31 +1662,31 @@ /* *------------------------------------------------------------------------- * * LoadTableEncoding -- * - * Helper function for LoadEncodingTable(). Loads a table to that - * converts between Unicode and some other encoding and creates an - * encoding (using a TableEncoding structure) from that information. + * Helper function for LoadEncodingFile(). Creates a Tcl_EncodingType + * structure along with its corresponding TableEncodingData structure, and + * passes it to Tcl_Createncoding. * - * File contains binary data, but begins with a marker to indicate - * byte-ordering, so that same binary file can be read on either endian - * platforms. + * The file contains binary data but begins with a marker to indicate + * byte-ordering so a single binary file can be read on big or + * little-endian systems. * * Results: - * The return value is the new encoding, or NULL if the encoding could - * not be created (because the file contained invalid data). + * Returns the new Tcl_Encoding, or NULL if it could could + * not be created because the file contained invalid data. * * Side effects: - * None. + * See Tcl_CreateEncoding(). * *------------------------------------------------------------------------- */ static Tcl_Encoding LoadTableEncoding( - const char *name, /* Name for new encoding. */ + const char *name, /* Name of the new encoding. */ int type, /* Type of encoding (ENCODING_?????). */ Tcl_Channel chan) /* File containing new encoding. */ { Tcl_DString lineString; Tcl_Obj *objPtr; @@ -1696,11 +1742,11 @@ memset(used, 0, sizeof(used)); #undef PAGESIZE #define PAGESIZE (256 * sizeof(unsigned short)) - dataPtr = Tcl_Alloc(sizeof(TableEncodingData)); + dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = fallback; /* @@ -1708,30 +1754,30 @@ * malloc to get the memory for the array and all the pages needed by the * array. */ size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; - dataPtr->toUnicode = Tcl_Alloc(size); + dataPtr->toUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->toUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); for (i = 0; i < numPages; i++) { int ch; const char *p; - size_t expected = 3 + 16 * (16 * 4 + 1); + int expected = 3 + 16 * (16 * 4 + 1); if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) { return NULL; } p = TclGetString(objPtr); hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])]; dataPtr->toUnicode[hi] = pageMemPtr; p += 2; for (lo = 0; lo < 256; lo++) { - if ((lo & 0x0f) == 0) { + if ((lo & 0x0F) == 0) { p++; } ch = (staticHex[UCHAR(p[0])] << 12) + (staticHex[UCHAR(p[1])] << 8) + (staticHex[UCHAR(p[2])] << 4) + staticHex[UCHAR(p[3])]; if (ch != 0) { @@ -1753,14 +1799,14 @@ } } } /* - * Invert toUnicode array to produce the fromUnicode array. Performs a + * Invert the toUnicode array to produce the fromUnicode array. Performs a * single malloc to get the memory for the array and all the pages needed - * by the array. While reading in the toUnicode array, we remembered what - * pages that would be needed for the fromUnicode array. + * by the array. While reading in the toUnicode array remember what + * pages are needed for the fromUnicode array. */ if (symbol) { used[0] = 1; } @@ -1769,11 +1815,11 @@ if (used[hi]) { numPages++; } } size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; - dataPtr->fromUnicode = Tcl_Alloc(size); + dataPtr->fromUnicode = (unsigned short **)ckalloc(size); memset(dataPtr->fromUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256); for (hi = 0; hi < 256; hi++) { if (dataPtr->toUnicode[hi] == NULL) { @@ -1788,37 +1834,37 @@ if (page == NULL) { page = pageMemPtr; pageMemPtr += 256; dataPtr->fromUnicode[ch >> 8] = page; } - page[ch & 0xff] = (unsigned short) ((hi << 8) + lo); + page[ch & 0xFF] = (unsigned short) ((hi << 8) + lo); } } } if (type == ENCODING_MULTIBYTE) { /* * If multibyte encodings don't have a backslash character, define - * one. Otherwise, on Windows, native file names won't work because - * the backslash in the file name will map to the unknown character + * one. Otherwise, on Windows, native file names don't work because + * the backslash in the file name maps to the unknown character * (question mark) when converting from UTF-8 to external encoding. */ if (dataPtr->fromUnicode[0] != NULL) { - if (dataPtr->fromUnicode[0]['\\'] == '\0') { - dataPtr->fromUnicode[0]['\\'] = '\\'; + if (dataPtr->fromUnicode[0][(int)'\\'] == '\0') { + dataPtr->fromUnicode[0][(int)'\\'] = '\\'; } } } if (symbol) { /* - * Make a special symbol encoding that not only maps the symbol - * characters from their Unicode code points down into page 0, but - * also ensure that the characters on page 0 map to themselves. This - * is so that a symbol font can be used to display a simple string - * like "abcd" and have alpha, beta, chi, delta show up, rather than - * have "unknown" chars show up because strictly speaking the symbol - * font doesn't have glyphs for those low ASCII chars. + * Make a special symbol encoding that maps each symbol character from + * its Unicode code point down into page 0, and also ensure that each + * characters on page 0 maps to itself so that a symbol font can be + * used to display a simple string like "abcd" and have alpha, beta, + * chi, delta show up, rather than have "unknown" chars show up because + * strictly speaking the symbol font doesn't have glyphs for those low + * ASCII chars. */ page = dataPtr->fromUnicode[0]; if (page == NULL) { page = pageMemPtr; @@ -1861,15 +1907,15 @@ if (line[0] != 'R') { goto doneParse; } /* - * Read lines from the encoding until EOF. + * Read lines until EOF. */ for (TclDStringClear(&lineString); - (len = Tcl_Gets(chan, &lineString)) != -1; + (len = Tcl_Gets(chan, &lineString)) >= 0; TclDStringClear(&lineString)) { const unsigned char *p; int to, from; /* @@ -1894,11 +1940,11 @@ from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8) + (staticHex[p[2]] << 4) + staticHex[p[3]]; if (from == 0) { continue; } - dataPtr->fromUnicode[from >> 8][from & 0xff] = to; + dataPtr->fromUnicode[from >> 8][from & 0xFF] = to; } } doneParse: Tcl_DStringFree(&lineString); @@ -1938,11 +1984,11 @@ *------------------------------------------------------------------------- */ static Tcl_Encoding LoadEscapeEncoding( - const char *name, /* Name for new encoding. */ + const char *name, /* Name of the new encoding. */ Tcl_Channel chan) /* File containing new encoding. */ { int i; unsigned size; Tcl_DString escapeData; @@ -1959,11 +2005,11 @@ const char **argv; char *line; Tcl_DString lineString; Tcl_DStringInit(&lineString); - if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) { + if (Tcl_Gets(chan, &lineString) < 0) { break; } line = Tcl_DStringValue(&lineString); if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) { Tcl_DStringFree(&lineString); @@ -2001,17 +2047,17 @@ } est.encodingPtr = e; Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est)); } } - Tcl_Free((void *)argv); + ckfree(argv); Tcl_DStringFree(&lineString); } size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData); - dataPtr = Tcl_Alloc(size); + dataPtr = (EscapeEncodingData *)ckalloc(size); dataPtr->initLen = strlen(init); memcpy(dataPtr->init, init, dataPtr->initLen + 1); dataPtr->finalLen = strlen(final); memcpy(dataPtr->final, final, dataPtr->finalLen + 1); dataPtr->numSubTables = @@ -2063,19 +2109,15 @@ *------------------------------------------------------------------------- */ static int BinaryProc( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), const char *src, /* Source string (unknown encoding). */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Place for conversion routine to store state - * information used during a piecewise - * conversion. Contents of statePtr are - * initialized and/or reset by conversion - * routine under control of flags argument. */ + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the @@ -2110,14 +2152,14 @@ } /* *------------------------------------------------------------------------- * - * UtfExtToUtfIntProc -- + * UtfIntToUtfExtProc -- * * Convert from UTF-8 to UTF-8. While converting null-bytes from the - * Tcl's internal representation (0xc0, 0x80) to the official + * Tcl's internal representation (0xC0, 0x80) to the official * representation (0x00). See UtfToUtfProc for details. * * Results: * Returns TCL_OK if conversion was successful. * @@ -2127,11 +2169,11 @@ *------------------------------------------------------------------------- */ static int UtfIntToUtfExtProc( - ClientData clientData, /* Not used. */ + ClientData clientData, const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -2162,11 +2204,11 @@ *------------------------------------------------------------------------- * * UtfExtToUtfIntProc -- * * Convert from UTF-8 to UTF-8 while converting null-bytes from the - * official representation (0x00) to Tcl's internal representation (0xc0, + * official representation (0x00) to Tcl's internal representation (0xC0, * 0x80). See UtfToUtfProc for details. * * Results: * Returns TCL_OK if conversion was successful. * @@ -2176,11 +2218,11 @@ *------------------------------------------------------------------------- */ static int UtfExtToUtfIntProc( - ClientData clientData, /* Not used. */ + ClientData clientData, const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -2225,11 +2267,11 @@ *------------------------------------------------------------------------- */ static int UtfToUtfProc( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -2251,16 +2293,16 @@ int *dstCharsPtr, /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ int pureNullMode) /* Convert embedded nulls from internal * representation to real null-bytes or vice - * versa. */ + * versa. Also combine or separate surrogate pairs */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int result, numChars, charLimit = INT_MAX; - Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr; + int *chPtr = (int *) statePtr; if (flags & TCL_ENCODING_START) { *statePtr = 0; } result = TCL_OK; @@ -2267,21 +2309,21 @@ srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { - srcClose -= TCL_UTF_MAX; + srcClose -= 6; } if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { - if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { + if ((src > srcClose) && (!TclUCS4Complete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. */ @@ -2293,78 +2335,83 @@ break; } if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) { /* * Copy 7bit characters, but skip null-bytes when we are in input - * mode, so that they get converted to 0xc080. + * mode, so that they get converted to 0xC080. */ *dst++ = *src++; - } else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 && + *chPtr = 0; /* reset surrogate handling */ + } else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 && (src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) { /* - * Convert 0xc080 to real nulls when we are in output mode. + * Convert 0xC080 to real nulls when we are in output mode. */ *dst++ = 0; + *chPtr = 0; /* reset surrogate handling */ src += 2; - } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) { + } else if (!TclUCS4Complete(src, srcEnd - src)) { /* - * Always check before using TclUtfToUniChar. Not doing can so + * Always check before using TclUtfToUCS4. Not doing can so * cause it run beyond the end of the buffer! If we happen such an * incomplete char its bytes are made to represent themselves. */ - *chPtr = (unsigned char) *src; + *chPtr = UCHAR(*src); src += 1; dst += Tcl_UniCharToUtf(*chPtr, dst); } else { - int len = TclUtfToUniChar(src, chPtr); - src += len; - dst += Tcl_UniCharToUtf(*chPtr, dst); -#if TCL_UTF_MAX <= 4 - if ((*chPtr >= 0xD800) && (len < 3)) { - src += TclUtfToUniChar(src + len, chPtr); - dst += Tcl_UniCharToUtf(*chPtr, dst); - } -#endif - } - } - - *srcReadPtr = src - srcStart; - *dstWrotePtr = dst - dstStart; - *dstCharsPtr = numChars; - return result; -} - -/* - *------------------------------------------------------------------------- - * - * UniCharToUtfProc -- - * - * Convert from Unicode to UTF-8. - * - * Results: - * Returns TCL_OK if conversion was successful. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -static int -UniCharToUtfProc( - ClientData clientData, /* Not used. */ + src += TclUtfToUCS4(src, chPtr); + if ((*chPtr | 0x7FF) == 0xDFFF) { + /* A surrogate character is detected, handle especially */ + int low = *chPtr; + size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0; + if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) { + *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF); + *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF); + *dst++ = (char) ((*chPtr | 0x80) & 0xBF); + continue; + } + src += len; + dst += Tcl_UniCharToUtf(*chPtr, dst); + *chPtr = low; + } + dst += Tcl_UniCharToUtf(*chPtr, dst); + } + } + + *srcReadPtr = src - srcStart; + *dstWrotePtr = dst - dstStart; + *dstCharsPtr = numChars; + return result; +} + +/* + *------------------------------------------------------------------------- + * + * Utf16ToUtfProc -- + * + * Convert from UTF-16 to UTF-8. + * + * Results: + * Returns TCL_OK if conversion was successful. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Utf16ToUtfProc( + ClientData clientData, /* != NULL means LE, == NUL means BE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Place for conversion routine to store state - * information used during a piecewise - * conversion. Contents of statePtr are - * initialized and/or reset by conversion - * routine under control of flags argument. */ + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the @@ -2386,14 +2433,20 @@ if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } result = TCL_OK; - if ((srcLen % sizeof(unsigned short)) != 0) { + + /* check alignment with utf-16 (2 == sizeof(UTF-16)) */ + if ((srcLen % 2) != 0) { + result = TCL_CONVERT_MULTIBYTE; + srcLen--; + } + /* If last code point is a high surrogate, we cannot handle that yet */ + if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) { result = TCL_CONVERT_MULTIBYTE; - srcLen /= sizeof(unsigned short); - srcLen *= sizeof(unsigned short); + srcLen-= 2; } srcStart = src; srcEnd = src + srcLen; @@ -2404,16 +2457,19 @@ if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; } + if (clientData) { + ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF); + } else { + ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF); + } /* * Special case for 1-byte utf chars for speed. Make sure we work with * unsigned short-size data. */ - - ch = *(unsigned short *)src; if (ch && ch < 0x80) { *dst++ = (ch & 0xFF); } else { dst += Tcl_UniCharToUtf(ch, dst); } @@ -2427,13 +2483,13 @@ } /* *------------------------------------------------------------------------- * - * UtfToUniCharProc -- + * UtfToUtf16Proc -- * - * Convert from UTF-8 to Unicode. + * Convert from UTF-8 to UTF-16. * * Results: * Returns TCL_OK if conversion was successful. * * Side effects: @@ -2441,13 +2497,12 @@ * *------------------------------------------------------------------------- */ static int -UtfToUniCharProc( - ClientData clientData, /* TableEncodingData that specifies - * encoding. */ +UtfToUtf16Proc( + ClientData clientData, /* != NULL means LE, == NUL means BE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -2502,53 +2557,151 @@ result = TCL_CONVERT_NOSPACE; break; } src += TclUtfToUniChar(src, chPtr); + if (clientData) { +#if TCL_UTF_MAX > 3 + if (*chPtr <= 0xFFFF) { + *dst++ = (*chPtr & 0xFF); + *dst++ = (*chPtr >> 8); + } else { + *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); + *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; + *dst++ = (*chPtr & 0xFF); + *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; + } +#else + *dst++ = (*chPtr & 0xFF); + *dst++ = (*chPtr >> 8); +#endif + } else { +#if TCL_UTF_MAX > 3 + if (*chPtr <= 0xFFFF) { + *dst++ = (*chPtr >> 8); + *dst++ = (*chPtr & 0xFF); + } else { + *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; + *dst++ = (*chPtr & 0xFF); + *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; + *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); + } +#else + *dst++ = (*chPtr >> 8); + *dst++ = (*chPtr & 0xFF); +#endif + } + } + *srcReadPtr = src - srcStart; + *dstWrotePtr = dst - dstStart; + *dstCharsPtr = numChars; + return result; +} + +/* + *------------------------------------------------------------------------- + * + * UtfToUcs2Proc -- + * + * Convert from UTF-8 to UCS-2. + * + * Results: + * Returns TCL_OK if conversion was successful. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +UtfToUcs2Proc( + ClientData clientData, /* != NULL means LE, == NUL means BE */ + const char *src, /* Source string in UTF-8. */ + int srcLen, /* Source string length in bytes. */ + int flags, /* Conversion control flags. */ + TCL_UNUSED(Tcl_EncodingState *), + char *dst, /* Output buffer in which converted string is + * stored. */ + int dstLen, /* The maximum length of output buffer in + * bytes. */ + int *srcReadPtr, /* Filled with the number of bytes from the + * source string that were converted. This may + * be less than the original source length if + * there was a problem converting some source + * characters. */ + int *dstWrotePtr, /* Filled with the number of bytes that were + * stored in the output buffer as a result of + * the conversion. */ + int *dstCharsPtr) /* Filled with the number of characters that + * correspond to the bytes stored in the + * output buffer. */ +{ + const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; + int result, numChars; +#if TCL_UTF_MAX <= 3 + int len; +#endif + Tcl_UniChar ch = 0; + + srcStart = src; + srcEnd = src + srcLen; + srcClose = srcEnd; + if ((flags & TCL_ENCODING_END) == 0) { + srcClose -= TCL_UTF_MAX; + } + + dstStart = dst; + dstEnd = dst + dstLen - sizeof(Tcl_UniChar); + + result = TCL_OK; + for (numChars = 0; src < srcEnd; numChars++) { + if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { + /* + * If there is more string to follow, this will ensure that the + * last UTF-8 character in the source buffer hasn't been cut off. + */ + + result = TCL_CONVERT_MULTIBYTE; + break; + } + if (dst > dstEnd) { + result = TCL_CONVERT_NOSPACE; + break; + } +#if TCL_UTF_MAX <= 3 + src += (len = TclUtfToUniChar(src, &ch)); + if ((ch >= 0xD800) && (len < 3)) { + src += TclUtfToUniChar(src, &ch); + ch = 0xFFFD; + } +#else + src += TclUtfToUniChar(src, &ch); + if (ch > 0xFFFF) { + ch = 0xFFFD; + } +#endif + /* * Need to handle this in a way that won't cause misalignment by * casting dst to a Tcl_UniChar. [Bug 1122671] */ -#ifdef WORDS_BIGENDIAN -#if TCL_UTF_MAX > 4 - if (*chPtr <= 0xFFFF) { - *dst++ = (*chPtr >> 8); - *dst++ = (*chPtr & 0xFF); - } else { - *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; - *dst++ = (*chPtr & 0xFF); - *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; - *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); - } -#else - *dst++ = (*chPtr >> 8); - *dst++ = (*chPtr & 0xFF); -#endif -#else -#if TCL_UTF_MAX > 4 - if (*chPtr <= 0xFFFF) { - *dst++ = (*chPtr & 0xFF); - *dst++ = (*chPtr >> 8); - } else { - *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF); - *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8; - *dst++ = (*chPtr & 0xFF); - *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC; - } -#else - *dst++ = (*chPtr & 0xFF); - *dst++ = (*chPtr >> 8); -#endif -#endif + if (clientData) { + *dst++ = (ch & 0xFF); + *dst++ = (ch >> 8); + } else { + *dst++ = (ch >> 8); + *dst++ = (ch & 0xFF); + } } *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; return result; } - + /* *------------------------------------------------------------------------- * * TableToUtfProc -- * @@ -2569,15 +2722,11 @@ ClientData clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Place for conversion routine to store state - * information used during a piecewise - * conversion. Contents of statePtr are - * initialized and/or reset by conversion - * routine under control of flags argument. */ + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the @@ -2596,11 +2745,11 @@ const char *dstEnd, *dstStart, *prefixBytes; int result, byte, numChars, charLimit = INT_MAX; Tcl_UniChar ch = 0; const unsigned short *const *toUnicode; const unsigned short *pageZero; - TableEncodingData *dataPtr = clientData; + TableEncodingData *dataPtr = (TableEncodingData *)clientData; if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } srcStart = src; @@ -2682,15 +2831,11 @@ ClientData clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Place for conversion routine to store state - * information used during a piecewise - * conversion. Contents of statePtr are - * initialized and/or reset by conversion - * routine under control of flags argument. */ + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the @@ -2707,11 +2852,11 @@ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd, *prefixBytes; Tcl_UniChar ch = 0; int result, len, word, numChars; - TableEncodingData *dataPtr = clientData; + TableEncodingData *dataPtr = (TableEncodingData *)clientData; const unsigned short *const *fromUnicode; result = TCL_OK; prefixBytes = dataPtr->prefixBytes; @@ -2737,25 +2882,25 @@ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); -#if TCL_UTF_MAX > 4 +#if TCL_UTF_MAX > 3 /* * This prevents a crash condition. More evaluation is required for * full support of int Tcl_UniChar. [Bug 1004065] */ - if (ch & 0xffff0000) { + if (ch & 0xFFFF0000) { word = 0; } else #else if (!len) { word = 0; } else #endif - word = fromUnicode[(ch >> 8)][ch & 0xff]; + word = fromUnicode[(ch >> 8)][ch & 0xFF]; if ((word == 0) && (ch != 0)) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; @@ -2803,19 +2948,15 @@ *------------------------------------------------------------------------- */ static int Iso88591ToUtfProc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Place for conversion routine to store state - * information used during a piecewise - * conversion. Contents of statePtr are - * initialized and/or reset by conversion - * routine under control of flags argument. */ + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the @@ -2887,19 +3028,15 @@ *------------------------------------------------------------------------- */ static int Iso88591FromUtfProc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Place for conversion routine to store state - * information used during a piecewise - * conversion. Contents of statePtr are - * initialized and/or reset by conversion - * routine under control of flags argument. */ + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer in which converted string is * stored. */ int dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the @@ -2914,13 +3051,12 @@ * correspond to the bytes stored in the * output buffer. */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; - int result, numChars; - - result = TCL_OK; + int result = TCL_OK, numChars; + Tcl_UniChar ch = 0; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { @@ -2929,11 +3065,10 @@ dstStart = dst; dstEnd = dst + dstLen - 1; for (numChars = 0; src < srcEnd; numChars++) { - Tcl_UniChar ch = 0; int len; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the @@ -2947,20 +3082,20 @@ /* * Check for illegal characters. */ - if (ch > 0xff -#if TCL_UTF_MAX <= 4 + if (ch > 0xFF +#if TCL_UTF_MAX <= 3 || ((ch >= 0xD800) && (len < 3)) #endif ) { if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) len = 4; #endif /* * Plunge on, using '?' as a fallback character. */ @@ -3002,21 +3137,21 @@ static void TableFreeProc( ClientData clientData) /* TableEncodingData that specifies * encoding. */ { - TableEncodingData *dataPtr = clientData; + TableEncodingData *dataPtr = (TableEncodingData *)clientData; /* * Make sure we aren't freeing twice on shutdown. [Bug 219314] */ - Tcl_Free(dataPtr->toUnicode); + ckfree(dataPtr->toUnicode); dataPtr->toUnicode = NULL; - Tcl_Free(dataPtr->fromUnicode); + ckfree(dataPtr->fromUnicode); dataPtr->fromUnicode = NULL; - Tcl_Free(dataPtr); + ckfree(dataPtr); } /* *------------------------------------------------------------------------- * @@ -3060,11 +3195,11 @@ * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { - EscapeEncodingData *dataPtr = clientData; + EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd; const unsigned short *const *tableToUnicode; const Encoding *encodingPtr; int state, result, numChars, charLimit = INT_MAX; const char *dstStart, *dstEnd; @@ -3071,12 +3206,12 @@ if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } result = TCL_OK; - tablePrefixBytes = NULL; /* lint. */ - tableToUnicode = NULL; /* lint. */ + tablePrefixBytes = NULL; + tableToUnicode = NULL; prefixBytes = dataPtr->prefixBytes; encodingPtr = NULL; srcStart = src; srcEnd = src + srcLen; @@ -3196,11 +3331,11 @@ if (encodingPtr == NULL) { TableEncodingData *tableDataPtr; encodingPtr = GetTableEncoding(dataPtr, state); - tableDataPtr = encodingPtr->clientData; + tableDataPtr = (TableEncodingData *)encodingPtr->clientData; tablePrefixBytes = tableDataPtr->prefixBytes; tableToUnicode = (const unsigned short *const*) tableDataPtr->toUnicode; } @@ -3274,18 +3409,19 @@ * the conversion. */ int *dstCharsPtr) /* Filled with the number of characters that * correspond to the bytes stored in the * output buffer. */ { - EscapeEncodingData *dataPtr = clientData; + EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; const Encoding *encodingPtr; const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; int state, result, numChars; const TableEncodingData *tableDataPtr; const char *tablePrefixBytes; const unsigned short *const *tableFromUnicode; + Tcl_UniChar ch = 0; result = TCL_OK; srcStart = src; srcEnd = src + srcLen; @@ -3314,19 +3450,18 @@ } else { state = PTR2INT(*statePtr); } encodingPtr = GetTableEncoding(dataPtr, state); - tableDataPtr = encodingPtr->clientData; + tableDataPtr = (const TableEncodingData *)encodingPtr->clientData; tablePrefixBytes = tableDataPtr->prefixBytes; tableFromUnicode = (const unsigned short *const *) tableDataPtr->fromUnicode; for (numChars = 0; src < srcEnd; numChars++) { unsigned len; int word; - Tcl_UniChar ch = 0; if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the * last UTF-8 character in the source buffer hasn't been cut off. @@ -3334,21 +3469,21 @@ result = TCL_CONVERT_MULTIBYTE; break; } len = TclUtfToUniChar(src, &ch); - word = tableFromUnicode[(ch >> 8)][ch & 0xff]; + word = tableFromUnicode[(ch >> 8)][ch & 0xFF]; if ((word == 0) && (ch != 0)) { int oldState; const EscapeSubTable *subTablePtr; oldState = state; for (state = 0; state < dataPtr->numSubTables; state++) { encodingPtr = GetTableEncoding(dataPtr, state); - tableDataPtr = encodingPtr->clientData; - word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff]; + tableDataPtr = (const TableEncodingData *)encodingPtr->clientData; + word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xFF]; if (word != 0) { break; } } @@ -3357,11 +3492,11 @@ if (flags & TCL_ENCODING_STOPONERROR) { result = TCL_CONVERT_UNKNOWN; break; } encodingPtr = GetTableEncoding(dataPtr, state); - tableDataPtr = encodingPtr->clientData; + tableDataPtr = (const TableEncodingData *)encodingPtr->clientData; word = tableDataPtr->fallback; } tablePrefixBytes = (const char *) tableDataPtr->prefixBytes; tableFromUnicode = (const unsigned short *const *) @@ -3385,11 +3520,12 @@ state = oldState; result = TCL_CONVERT_NOSPACE; break; } - memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen); + memcpy(dst, subTablePtr->sequence, + subTablePtr->sequenceLen); dst += subTablePtr->sequenceLen; } } if (tablePrefixBytes[(word >> 8)] != 0) { @@ -3446,28 +3582,27 @@ /* *--------------------------------------------------------------------------- * * EscapeFreeProc -- * - * This function is invoked when an EscapeEncodingData encoding is - * deleted. It deletes the memory used by the encoding. + * Frees resources used by the encoding. * * Results: * None. * * Side effects: - * Memory freed. + * Memory is freed. * *--------------------------------------------------------------------------- */ static void EscapeFreeProc( ClientData clientData) /* EscapeEncodingData that specifies * encoding. */ { - EscapeEncodingData *dataPtr = clientData; + EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; EscapeSubTable *subTablePtr; int i; if (dataPtr == NULL) { return; @@ -3490,11 +3625,11 @@ FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr); subTablePtr->encodingPtr = NULL; subTablePtr++; } } - Tcl_Free(dataPtr); + ckfree(dataPtr); } /* *--------------------------------------------------------------------------- * @@ -3591,11 +3726,11 @@ */ static void InitializeEncodingSearchPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; int i, numDirs; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; @@ -3625,12 +3760,14 @@ Tcl_DecrRefCount(encodingObj); *encodingPtr = libraryPath.encoding; if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } - bytes = TclGetStringFromObj(searchPathObj, lengthPtr); - *valuePtr = Tcl_Alloc(*lengthPtr + 1); + bytes = TclGetString(searchPathObj); + + *lengthPtr = searchPathObj->length; + *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, bytes, *lengthPtr + 1); Tcl_DecrRefCount(searchPathObj); } /* Index: generic/tclEnsemble.c ================================================================== --- generic/tclEnsemble.c +++ generic/tclEnsemble.c @@ -94,20 +94,20 @@ #define ECRGetIntRep(objPtr, ecRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &ensembleCmdType); \ - (ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The internal rep for caching ensemble subcommand lookups and spelling * corrections. */ typedef struct { - size_t epoch; /* Used to confirm when the data in this + unsigned int epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this * structure is a cache of the resolution. */ Tcl_Obj *fix; /* Corrected spelling, if needed. */ @@ -117,11 +117,11 @@ static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { - register Namespace *nsPtr = (Namespace *) namespacePtr; + Namespace *nsPtr = (Namespace *) namespacePtr; if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } return Tcl_NewStringObj(nsPtr->fullName, -1); @@ -149,11 +149,11 @@ *---------------------------------------------------------------------- */ int TclNamespaceEnsembleCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Namespace *namespacePtr; @@ -673,16 +673,16 @@ { Namespace *nsPtr = (Namespace *) ensembleNsPtr; EnsembleConfig *ensemblePtr; Tcl_Command token; - ensemblePtr = Tcl_Alloc(sizeof(EnsembleConfig)); + ensemblePtr = (EnsembleConfig *)ckalloc(sizeof(EnsembleConfig)); token = TclNRCreateCommandInNs(interp, name, (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd, NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig); if (token == NULL) { - Tcl_Free(ensemblePtr); + ckfree(ensemblePtr); return NULL; } ensemblePtr->nsPtr = nsPtr; ensemblePtr->epoch = 0; @@ -796,11 +796,11 @@ if (length < 1) { subcmdList = NULL; } } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldList = ensemblePtr->subcmdList; ensemblePtr->subcmdList = subcmdList; if (subcmdList != NULL) { Tcl_IncrRefCount(subcmdList); } @@ -872,11 +872,11 @@ if (length < 1) { paramList = NULL; } } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldList = ensemblePtr->parameterList; ensemblePtr->parameterList = paramList; if (paramList != NULL) { Tcl_IncrRefCount(paramList); } @@ -972,11 +972,11 @@ if (size < 1) { mapDict = NULL; } } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldDict = ensemblePtr->subcommandDict; ensemblePtr->subcommandDict = mapDict; if (mapDict != NULL) { Tcl_IncrRefCount(mapDict); } @@ -1047,11 +1047,11 @@ if (length < 1) { unknownList = NULL; } } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; oldList = ensemblePtr->unknownHandler; ensemblePtr->unknownHandler = unknownList; if (unknownList != NULL) { Tcl_IncrRefCount(unknownList); } @@ -1103,11 +1103,11 @@ "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE; /* * This API refuses to set the ENSEMBLE_DEAD flag... */ @@ -1181,11 +1181,11 @@ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *subcmdListPtr = ensemblePtr->subcmdList; return TCL_OK; } /* @@ -1223,11 +1223,11 @@ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *paramListPtr = ensemblePtr->parameterList; return TCL_OK; } /* @@ -1265,11 +1265,11 @@ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *mapDictPtr = ensemblePtr->subcommandDict; return TCL_OK; } /* @@ -1306,11 +1306,11 @@ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *unknownListPtr = ensemblePtr->unknownHandler; return TCL_OK; } /* @@ -1347,11 +1347,11 @@ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *flagsPtr = ensemblePtr->flags; return TCL_OK; } /* @@ -1388,11 +1388,11 @@ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } - ensemblePtr = cmdPtr->objClientData; + ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr; return TCL_OK; } /* @@ -1622,11 +1622,11 @@ Tcl_NRCreateCommand(interp, "___tmp", map[i].proc, map[i].nreProc, map[i].clientData, NULL); Tcl_DStringSetLength(&hiddenBuf, hiddenLen); if (Tcl_HideCommand(interp, "___tmp", Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) { - Tcl_Panic("%s", Tcl_GetStringResult(interp)); + Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } } else { /* * Not hidden, so just create it. Yay! */ @@ -1643,11 +1643,11 @@ } Tcl_DStringFree(&buf); Tcl_DStringFree(&hiddenBuf); if (nameParts != NULL) { - Tcl_Free((void *)nameParts); + ckfree(nameParts); } return ensemble; } /* @@ -1688,11 +1688,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - EnsembleConfig *ensemblePtr = clientData; + EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData; /* The ensemble itself. */ Tcl_Obj *prefixObj; /* An object containing the prefix words of * the command that implements the * subcommand. */ Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully @@ -1699,20 +1699,20 @@ * specified but not yet cached command * names. */ int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ Tcl_Obj *subObj; - size_t subIdx; + int subIdx; /* * Must recheck objc, since numParameters might have changed. Cf. test * namespace-53.9. */ restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; - if ((size_t)objc < subIdx + 1) { + if (objc < subIdx + 1) { /* * We don't have a subcommand argument. Make error message. */ Tcl_DString buf; /* Message being built */ @@ -1761,11 +1761,11 @@ ECRGetIntRep(subObj, ensembleCmd); if (ensembleCmd) { if (ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == (Command *)ensemblePtr->token) { - prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr); + prefixObj = (Tcl_Obj *)Tcl_GetHashValue(ensembleCmd->hPtr); Tcl_IncrRefCount(prefixObj); if (ensembleCmd->fix) { TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix); } goto runResultingSubcommand; @@ -1805,17 +1805,17 @@ const char *subcmdName; /* Name of the subcommand, or unique prefix of * it (will be an error for a non-unique * prefix). */ char *fullName = NULL; /* Full name of the subcommand. */ - size_t stringLength, i; - size_t tableLength = ensemblePtr->subcommandTable.numEntries; + int stringLength, i; + int tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = TclGetStringFromObj(subObj, &stringLength); for (i=0 ; isubcommandArrayPtr[i], stringLength); if (cmp == 0) { if (fullName != NULL) { @@ -1864,11 +1864,11 @@ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix); TclSpellFix(interp, objv, objc, subIdx, subObj, fix); } - prefixObj = Tcl_GetHashValue(hPtr); + prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_IncrRefCount(prefixObj); runResultingSubcommand: /* * Do the real work of execution of the subcommand by building an array of @@ -1970,11 +1970,11 @@ (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""), TclGetString(subObj)); if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { - size_t i; + int i; for (i=0 ; isubcommandTable.numEntries-1 ; i++) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); Tcl_AppendToObj(errorObj, ", ", 2); } @@ -1985,11 +1985,11 @@ return TCL_ERROR; } int TclClearRootEnsemble( - ClientData data[], + TCL_UNUSED(ClientData *), Tcl_Interp *interp, int result) { TclResetRewriteEnsemble(interp, 1); return result; @@ -2015,12 +2015,12 @@ */ int TclInitRewriteEnsemble( Tcl_Interp *interp, - size_t numRemoved, - size_t numInserted, + int numRemoved, + int numInserted, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); @@ -2028,11 +2028,11 @@ if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { - size_t numIns = iPtr->ensembleRewrite.numInsertedObjs; + int numIns = iPtr->ensembleRewrite.numInsertedObjs; if (numIns < numRemoved) { iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { @@ -2092,35 +2092,35 @@ */ static int FreeER( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { Tcl_Obj **tmp = (Tcl_Obj **) data[0]; Tcl_Obj **store = (Tcl_Obj **) data[1]; - Tcl_Free(store); - Tcl_Free(tmp); + ckfree(store); + ckfree(tmp); return result; } void TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, - size_t badIdx, + int badIdx, Tcl_Obj *bad, Tcl_Obj *fix) { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *search; Tcl_Obj **store; - size_t idx; - size_t size; + int idx; + int size; if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; @@ -2174,13 +2174,13 @@ search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { store = (Tcl_Obj **) search[2]; } else { - Tcl_Obj **tmp = Tcl_Alloc(3 * sizeof(Tcl_Obj *)); + Tcl_Obj **tmp = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *)); - store = Tcl_Alloc(size * sizeof(Tcl_Obj *)); + store = (Tcl_Obj **)ckalloc(size * sizeof(Tcl_Obj *)); memcpy(store, iPtr->ensembleRewrite.sourceObjs, size * sizeof(Tcl_Obj *)); /* * Awful casting abuse here! Note that the NULL in the first element @@ -2402,11 +2402,11 @@ Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix) { - register EnsembleCmdRep *ensembleCmd; + EnsembleCmdRep *ensembleCmd; ECRGetIntRep(objPtr, ensembleCmd); if (ensembleCmd) { TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { @@ -2416,11 +2416,11 @@ /* * Kill the old internal rep, and replace it with a brand new one of * our own. */ - ensembleCmd = Tcl_Alloc(sizeof(EnsembleCmdRep)); + ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); ECRSetIntRep(objPtr, ensembleCmd); } /* * Populate the internal rep. @@ -2465,24 +2465,24 @@ if (hash->numEntries != 0) { Tcl_HashSearch search; Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); while (hPtr != NULL) { - Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr); + Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } - Tcl_Free(ensemblePtr->subcommandArrayPtr); + ckfree((char *) ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } static void DeleteEnsembleConfig( ClientData clientData) { - EnsembleConfig *ensemblePtr = clientData; + EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData; Namespace *nsPtr = ensemblePtr->nsPtr; /* * Unlink from the ensemble chain if it has not been marked as having been * done already. @@ -2566,12 +2566,11 @@ EnsembleConfig *ensemblePtr) { Tcl_HashSearch search; /* Used for scanning the set of commands in * the namespace that backs up this * ensemble. */ - size_t i, j; - int isNew; + int i, j, isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; Tcl_Obj *mapDict = ensemblePtr->subcommandDict; Tcl_Obj *subList = ensemblePtr->subcmdList; @@ -2579,11 +2578,11 @@ Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { int subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; - char *name; + const char *name; /* * There is a list of exactly what subcommands go in the table. * Must determine the target for each. */ @@ -2593,11 +2592,11 @@ /* * Strange case where explicit list of subcommands is same value * as the dict mapping to targets. */ - for (i = 0; i < (size_t)subc; i += 2) { + for (i = 0; i < subc; i += 2) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(cmdObj); @@ -2617,11 +2616,11 @@ } else { /* * Usual case where we can freely act on the list and dict. */ - for (i = 0; i < (size_t)subc; i++) { + for (i = 0; i < subc; i++) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { continue; } @@ -2664,11 +2663,11 @@ int done; Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, &keyObj, &valueObj, &done); while (!done) { - char *name = TclGetString(keyObj); + const char *name = TclGetString(keyObj); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); Tcl_SetHashValue(hPtr, valueObj); Tcl_IncrRefCount(valueObj); Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); @@ -2690,11 +2689,11 @@ */ hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search); for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) { char *nsCmdName = /* Name of command in namespace. */ - Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr); + (char *)Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr); for (i=0 ; insPtr->numExportPatterns ; i++) { if (Tcl_StringMatch(nsCmdName, ensemblePtr->nsPtr->exportArrayPtr[i])) { hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew); @@ -2739,11 +2738,11 @@ * directly to save a copy, since any time we change the array we change * the hash too, and vice versa) and running quicksort over the array. */ ensemblePtr->subcommandArrayPtr = - Tcl_Alloc(sizeof(char *) * hash->numEntries); + (char **)ckalloc(sizeof(char *) * hash->numEntries); /* * Fill array from both ends as this makes us less likely to end up with * performance problems in qsort(), which is good. Note that doing this * makes this code much more opaque, but the naive alternatve: @@ -2763,16 +2762,16 @@ i = 0; j = hash->numEntries; hPtr = Tcl_FirstHashEntry(hash, &search); while (hPtr != NULL) { - ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr); + ensemblePtr->subcommandArrayPtr[i++] = (char *)Tcl_GetHashKey(hash, hPtr); hPtr = Tcl_NextHashEntry(&search); if (hPtr == NULL) { break; } - ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr); + ensemblePtr->subcommandArrayPtr[--j] = (char *)Tcl_GetHashKey(hash, hPtr); hPtr = Tcl_NextHashEntry(&search); } if (hash->numEntries > 1) { qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries, sizeof(char *), NsEnsembleStringOrder); @@ -2833,11 +2832,11 @@ ECRGetIntRep(objPtr, ensembleCmd); TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } - Tcl_Free(ensembleCmd); + ckfree(ensembleCmd); } /* *---------------------------------------------------------------------- * @@ -2860,11 +2859,11 @@ DupEnsembleCmdRep( Tcl_Obj *objPtr, Tcl_Obj *copyPtr) { EnsembleCmdRep *ensembleCmd; - EnsembleCmdRep *ensembleCopy = Tcl_Alloc(sizeof(EnsembleCmdRep)); + EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); ECRGetIntRep(objPtr, ensembleCmd); ECRSetIntRep(copyPtr, ensembleCopy); ensembleCopy->epoch = ensembleCmd->epoch; @@ -2905,20 +2904,20 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; Tcl_Obj *replaced = Tcl_NewObj(), *replacement; Tcl_Command ensemble = (Tcl_Command) cmdPtr; Command *oldCmdPtr = cmdPtr, *newCmdPtr; int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; int ourResult = TCL_ERROR; - size_t numBytes; + unsigned numBytes; const char *word; - DefineLineInformation; Tcl_IncrRefCount(replaced); if (parsePtr->numWords < depth + 1) { goto failed; } @@ -2982,20 +2981,20 @@ * list filters the entries in the map. */ (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); if (listObj != NULL) { - size_t sclen; + int sclen; const char *str; Tcl_Obj *matchObj = NULL; if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto failed; } for (i=0 ; inuloc - 1 > eclIndex) { mapPtr->nuloc--; - Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); + ckfree(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } /* * Reset the index of next command. Toss out any from failed nested @@ -3243,20 +3242,20 @@ Tcl_Parse *parsePtr, int depth, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; int result, i; Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; int savedStackDepth = envPtr->currStackDepth; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; int savedAuxDataArrayNext = envPtr->auxDataArrayNext; int savedExceptArrayNext = envPtr->exceptArrayNext; #ifdef TCL_COMPILE_DEBUG int savedExceptDepth = envPtr->exceptDepth; #endif - DefineLineInformation; if (cmdPtr->compileProc == NULL) { return TCL_ERROR; } @@ -3354,11 +3353,11 @@ int diff = envPtr->currStackDepth - savedStackDepth; if (diff != 1) { Tcl_Panic("bad stack adjustment when compiling" - " %.*s (was %d instead of 1)", (int)parsePtr->tokenPtr->size, + " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, diff); } #endif } @@ -3376,16 +3375,15 @@ Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { + DefineLineInformation; Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; - char *bytes; + const char *bytes; int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; - size_t length; - DefineLineInformation; /* * Push the words of the command. Take care; the command words may be * scripts that have backslashes in them, and [info frame 0] can see the * difference. Hence the call to TclContinuationsEnterDerived... @@ -3393,12 +3391,12 @@ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { - bytes = TclGetStringFromObj(words[i-1], &length); - PushLiteral(envPtr, bytes, length); + bytes = TclGetString(words[i-1]); + PushLiteral(envPtr, bytes, words[i-1]->length); continue; } SetLineInformation(i); if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { @@ -3422,15 +3420,15 @@ * the implementation. */ objPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); - bytes = TclGetStringFromObj(objPtr, &length); + bytes = TclGetString(objPtr); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } - cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); + cmdLit = TclRegisterLiteral(envPtr, bytes, objPtr->length, extraLiteralFlags); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); /* Index: generic/tclEnv.c ================================================================== --- generic/tclEnv.c +++ generic/tclEnv.c @@ -14,27 +14,48 @@ */ #include "tclInt.h" TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ + +#if defined(_WIN32) +# define tenviron _wenviron +# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))) +# define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ + (const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr))) +# define techar WCHAR +# ifdef USE_PUTENV +# define putenv(env) _wputenv((const wchar_t *)env) +# endif +#else +# define tenviron environ +# define tenviron2utfdstr(tenvstr, len, dstr) \ + Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr) +# define utf2tenvirondstr(str, len, dstr) \ + Tcl_UtfToExternalDString(NULL, str, len, dstr) +# define techar char +#endif static struct { - size_t cacheSize; /* Number of env strings in cache. */ + int cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV - char **ourEnviron; /* Cache of the array that we allocate. We + techar **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another * subsystem swaps around the environ array * like we do. */ - size_t ourEnvironSize; /* Non-zero means that the environ array was + int ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment * array is in its original static state. */ #endif } env; + +#define tNTL sizeof(techar) /* * Declarations for local functions defined in this file: */ @@ -104,28 +125,39 @@ Tcl_InitObjHashTable(&namesHash); varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY, /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); TclFindArrayPtrElements(varPtr, &namesHash); +#if defined(_WIN32) + if (tenviron == NULL) { + /* + * When we are started from main(), the _wenviron array could + * be NULL and will be initialized by the first _wgetenv() call. + */ + + (void) _wgetenv(L"WINDIR"); + } +#endif + /* * Go through the environment array and transfer its values into Tcl. At * the same time, remove those elements we add/update from the hash table * of existing elements, so that after this part processes, that table * will hold just the parts to remove. */ - if (environ[0] != NULL) { + if (tenviron[0] != NULL) { int i; Tcl_MutexLock(&envMutex); - for (i = 0; environ[i] != NULL; i++) { + for (i = 0; tenviron[i] != NULL; i++) { Tcl_Obj *obj1, *obj2; const char *p1; char *p2; - p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString); - p2 = strchr(p1, '='); + p1 = tenviron2utfdstr(tenviron[i], -1, &envString); + p2 = (char *)strchr(p1, '='); if (p2 == NULL) { /* * This condition seem to happen occasionally under some * versions of Solaris, or when encoding accidents swallow the * '='; ignore the entry. @@ -170,11 +202,11 @@ * counterparts in the environment array. */ for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL; hPtr=Tcl_NextHashEntry(&search)) { - Tcl_Obj *elemName = Tcl_GetHashValue(hPtr); + Tcl_Obj *elemName = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY); } Tcl_DeleteHashTable(&namesHash); Tcl_DecrRefCount(varNamePtr); @@ -214,14 +246,14 @@ const char *name, /* Name of variable whose value is to be set * (UTF-8). */ const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; - size_t nameLength, valueLength; - size_t index, length; + unsigned nameLength, valueLength; + int index, length; char *p, *oldValue; - const char *p2; + const techar *p2; /* * Figure out where the entry is going to go. If the name doesn't already * exist, enlarge the array if necessary to make room. If the name exists, * free its old entry. @@ -228,53 +260,53 @@ */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); - if (index == TCL_INDEX_NONE) { + if (index == -1) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed * outside our control. ourEnvironSize is only valid if the current * environment is the one we allocated. [Bug 979640] */ - if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) { - char **newEnviron = Tcl_Alloc((length + 5) * sizeof(char *)); + if ((env.ourEnviron != tenviron) || (length+2 > env.ourEnvironSize)) { + techar **newEnviron = (techar **)ckalloc((length + 5) * sizeof(techar *)); - memcpy(newEnviron, environ, length * sizeof(char *)); + memcpy(newEnviron, tenviron, length * sizeof(techar *)); if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { - Tcl_Free(env.ourEnviron); + ckfree(env.ourEnviron); } - environ = env.ourEnviron = newEnviron; + tenviron = (env.ourEnviron = newEnviron); env.ourEnvironSize = length + 5; } index = length; - environ[index + 1] = NULL; + tenviron[index + 1] = NULL; #endif /* USE_PUTENV */ oldValue = NULL; nameLength = strlen(name); } else { - const char *env; + const char *oldEnv; /* * Compare the new value to the existing value. If they're the same * then quit immediately (e.g. don't rewrite the value or propagate it * to other interpreters). Otherwise, when there are N interpreters * there will be N! propagations of the same value among the * interpreters. */ - env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString); - if (strcmp(value, env + (length + 1)) == 0) { + oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString); + if (strcmp(value, oldEnv + (length + 1)) == 0) { Tcl_DStringFree(&envString); Tcl_MutexUnlock(&envMutex); return; } Tcl_DStringFree(&envString); - oldValue = environ[index]; + oldValue = (char *)tenviron[index]; nameLength = length; } /* * Create a new entry. Build a complete UTF string that contains a @@ -281,22 +313,22 @@ * "name=value" pattern. Then convert the string to the native encoding, * and set the environ array value. */ valueLength = strlen(value); - p = Tcl_Alloc(nameLength + valueLength + 2); + p = (char *)ckalloc(nameLength + valueLength + 2); memcpy(p, name, nameLength); p[nameLength] = '='; memcpy(p+nameLength+1, value, valueLength+1); - p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString); + p2 = utf2tenvirondstr(p, -1, &envString); /* * Copy the native string to heap memory. */ - p = Tcl_Realloc(p, Tcl_DStringLength(&envString) + 1); - memcpy(p, p2, Tcl_DStringLength(&envString) + 1); + p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + tNTL); + memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); #ifdef USE_PUTENV /* * Update the system environment. @@ -303,28 +335,28 @@ */ putenv(p); index = TclpFindVariable(name, &length); #else - environ[index] = p; + tenviron[index] = (techar *)p; #endif /* USE_PUTENV */ /* * Watch out for versions of putenv that copy the string (e.g. VC++). In * this case we need to free the string immediately. Otherwise update the * string in the cache. */ - if ((index != TCL_INDEX_NONE) && (environ[index] == p)) { + if ((index != -1) && (tenviron[index] == (techar *)p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { /* * This putenv() copies instead of taking ownership. */ - Tcl_Free(p); + ckfree(p); #endif /* HAVE_PUTENV_THAT_COPIES */ } Tcl_MutexUnlock(&envMutex); @@ -377,11 +409,11 @@ * First convert the native string to UTF. Then separate the string into * name and value parts, and call TclSetEnv to do all of the real work. */ name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); - value = strchr(name, '='); + value = (char *)strchr(name, '='); if ((value != NULL) && (value != name)) { value[0] = '\0'; TclSetEnv(name, value+1); } @@ -412,11 +444,12 @@ void TclUnsetEnv( const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; - size_t length, index; + int length; + int index; #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; #else char **envPtr; @@ -428,20 +461,20 @@ /* * First make sure that the environment variable exists to avoid doing * needless work and to avoid recursion on the unset. */ - if (index == TCL_AUTO_LENGTH) { + if (index == -1) { Tcl_MutexUnlock(&envMutex); return; } /* * Remember the old value so we can free it if Tcl created the string. */ - oldValue = environ[index]; + oldValue = (char *)tenviron[index]; /* * Update the system environment. This must be done before we update the * interpreters or we will recurse. */ @@ -451,24 +484,24 @@ * For those platforms that support putenv to unset, Linux indicates * that no = should be included, and Windows requires it. */ #if defined(_WIN32) - string = Tcl_Alloc(length + 2); + string = (char *)ckalloc(length + 2); memcpy(string, name, length); string[length] = '='; string[length+1] = '\0'; #else - string = Tcl_Alloc(length + 1); + string = (char *)ckalloc(length + 1); memcpy(string, name, length); string[length] = '\0'; #endif /* _WIN32 */ - Tcl_UtfToExternalDString(NULL, string, -1, &envString); - string = Tcl_Realloc(string, Tcl_DStringLength(&envString) + 1); + utf2tenvirondstr(string, -1, &envString); + string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL); memcpy(string, Tcl_DStringValue(&envString), - Tcl_DStringLength(&envString)+1); + Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); putenv(string); /* @@ -475,23 +508,23 @@ * Watch out for versions of putenv that copy the string (e.g. VC++). In * this case we need to free the string immediately. Otherwise update the * string in the cache. */ - if (environ[index] == string) { + if (tenviron[index] == (techar *)string) { ReplaceString(oldValue, string); #ifdef HAVE_PUTENV_THAT_COPIES } else { /* * This putenv() copies instead of taking ownership. */ - Tcl_Free(string); + ckfree(string); #endif /* HAVE_PUTENV_THAT_COPIES */ } #else /* !USE_PUTENV_FOR_UNSET */ - for (envPtr = environ+index+1; ; envPtr++) { + for (envPtr = (char **)(tenviron+index+1); ; envPtr++) { envPtr[-1] = *envPtr; if (*envPtr == NULL) { break; } } @@ -527,20 +560,20 @@ * (UTF-8). */ Tcl_DString *valuePtr) /* Uninitialized or free DString in which the * value of the environment variable is * stored. */ { - size_t length, index; + int length, index; const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); result = NULL; - if (index != TCL_AUTO_LENGTH) { + if (index != -1) { Tcl_DString envStr; - result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr); + result = tenviron2utfdstr(tenviron[index], -1, &envStr); result += length; if (*result == '=') { result++; Tcl_DStringInit(valuePtr); Tcl_DStringAppend(valuePtr, result, -1); @@ -573,14 +606,13 @@ * this happens because the whole interpreter is being deleted). * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static char * EnvTraceProc( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter whose "env" variable is being * modified. */ const char *name1, /* Better be "env". */ const char *name2, /* Name of variable being modified, or NULL if * whole array is being deleted (UTF-8). */ @@ -660,11 +692,11 @@ static void ReplaceString( const char *oldStr, /* Old environment string. */ char *newStr) /* New environment string. */ { - size_t i; + int i; /* * Check to see if the old value was allocated by Tcl. If so, it needs to * be deallocated to avoid memory leaks. Note that this algorithm is O(n), * not O(1). This will result in n-squared behavior if lots of environment @@ -680,11 +712,11 @@ /* * Replace or delete the old value. */ if (env.cache[i]) { - Tcl_Free(env.cache[i]); + ckfree(env.cache[i]); } if (newStr) { env.cache[i] = newStr; } else { @@ -698,15 +730,15 @@ * We need to grow the cache in order to hold the new string. */ const int growth = 5; - env.cache = Tcl_Realloc(env.cache, + env.cache = (char **)ckrealloc(env.cache, (env.cacheSize + growth) * sizeof(char *)); env.cache[env.cacheSize] = newStr; (void) memset(env.cache+env.cacheSize+1, 0, - (growth-1) * sizeof(char *)); + (size_t) (growth-1) * sizeof(char *)); env.cacheSize += growth; } } /* @@ -741,19 +773,19 @@ if (env.cache) { #ifdef PURIFY int i; for (i = 0; i < env.cacheSize; i++) { - Tcl_Free(env.cache[i]); + ckfree(env.cache[i]); } #endif - Tcl_Free(env.cache); + ckfree(env.cache); env.cache = NULL; env.cacheSize = 0; #ifndef USE_PUTENV if ((env.ourEnviron != NULL)) { - Tcl_Free(env.ourEnviron); + ckfree(env.ourEnviron); env.ourEnviron = NULL; } env.ourEnvironSize = 0; #endif } Index: generic/tclEvent.c ================================================================== --- generic/tclEvent.c +++ generic/tclEvent.c @@ -53,11 +53,11 @@ * there is a structure of the following type: */ typedef struct ExitHandler { Tcl_ExitProc *proc; /* Function to call when process exits. */ - ClientData clientData; /* One word of information to pass to proc. */ + void *clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this * application, or NULL for end of list. */ } ExitHandler; /* @@ -101,32 +101,32 @@ static Tcl_ThreadDataKey dataKey; #if TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ - ClientData clientData; /* The one argument to Main() */ + void *clientData; /* The one argument to Main() */ } ThreadClientData; -static Tcl_ThreadCreateType NewThreadProc(ClientData clientData); +static Tcl_ThreadCreateType NewThreadProc(void *clientData); #endif /* TCL_THREADS */ /* * Prototypes for functions referenced only in this file: */ -static void BgErrorDeleteProc(ClientData clientData, +static void BgErrorDeleteProc(void *clientData, Tcl_Interp *interp); -static void HandleBgErrors(ClientData clientData); -static char * VwaitVarProc(ClientData clientData, +static void HandleBgErrors(void *clientData); +static char * VwaitVarProc(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void InvokeExitHandlers(void); static void FinalizeThread(int quick); /* *---------------------------------------------------------------------- * - * Tcl_BackgroundException -- + * Tcl_BackgroundError -- * * This function is invoked to handle errors that occur in Tcl commands * that are invoked in "background" (e.g. from event or timer bindings). * * Results: @@ -137,10 +137,21 @@ * error, passing it the interp result and return options. * *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#undef Tcl_BackgroundError +void +Tcl_BackgroundError( + Tcl_Interp *interp) /* Interpreter in which an error has + * occurred. */ +{ + Tcl_BackgroundException(interp, TCL_ERROR); +} +#endif /* TCL_NO_DEPRECATED */ + void Tcl_BackgroundException( Tcl_Interp *interp, /* Interpreter in which an exception has * occurred. */ int code) /* The exception code value */ @@ -150,19 +161,19 @@ if (code == TCL_OK) { return; } - errPtr = Tcl_Alloc(sizeof(BgError)); + errPtr = (BgError*)ckalloc(sizeof(BgError)); errPtr->errorMsg = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errPtr->errorMsg); errPtr->returnOpts = Tcl_GetReturnOptions(interp, code); Tcl_IncrRefCount(errPtr->returnOpts); errPtr->nextPtr = NULL; (void) TclGetBgErrorHandler(interp); - assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); + assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); if (assocPtr->firstBgPtr == NULL) { assocPtr->firstBgPtr = errPtr; Tcl_DoWhenIdle(HandleBgErrors, assocPtr); } else { assocPtr->lastBgPtr->nextPtr = errPtr; @@ -188,13 +199,13 @@ *---------------------------------------------------------------------- */ static void HandleBgErrors( - ClientData clientData) /* Pointer to ErrAssocData structure. */ + void *clientData) /* Pointer to ErrAssocData structure. */ { - ErrAssocData *assocPtr = clientData; + ErrAssocData *assocPtr = (ErrAssocData *)clientData; Tcl_Interp *interp = assocPtr->interp; BgError *errPtr; /* * Not bothering to save/restore the interp state. Assume that any code @@ -217,11 +228,11 @@ Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); errPtr = assocPtr->firstBgPtr; Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); - tempObjv = Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *)); + tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; tempObjv[prefixObjc+1] = errPtr->returnOpts; Tcl_AllowExceptions(interp); code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL); @@ -232,12 +243,12 @@ Tcl_DecrRefCount(copyObj); Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); assocPtr->firstBgPtr = errPtr->nextPtr; - Tcl_Free(errPtr); - Tcl_Free(tempObjv); + ckfree(errPtr); + ckfree(tempObjv); if (code == TCL_BREAK) { /* * Break means cancel any remaining error reports for this * interpreter. @@ -246,11 +257,11 @@ while (assocPtr->firstBgPtr != NULL) { errPtr = assocPtr->firstBgPtr; assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - Tcl_Free(errPtr); + ckfree(errPtr); } } else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel != NULL) { @@ -298,11 +309,11 @@ *---------------------------------------------------------------------- */ int TclDefaultBgErrorHandlerObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *keyPtr, *valuePtr; @@ -505,21 +516,21 @@ void TclSetBgErrorHandler( Tcl_Interp *interp, Tcl_Obj *cmdPrefix) { - ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); + ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); if (cmdPrefix == NULL) { Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument"); } if (assocPtr == NULL) { /* * First access: initialize. */ - assocPtr = Tcl_Alloc(sizeof(ErrAssocData)); + assocPtr = (ErrAssocData*)ckalloc(sizeof(ErrAssocData)); assocPtr->interp = interp; assocPtr->cmdPrefix = NULL; assocPtr->firstBgPtr = NULL; assocPtr->lastBgPtr = NULL; Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr); @@ -550,18 +561,18 @@ Tcl_Obj * TclGetBgErrorHandler( Tcl_Interp *interp) { - ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); + ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); if (assocPtr == NULL) { Tcl_Obj *bgerrorObj; TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror"); TclSetBgErrorHandler(interp, bgerrorObj); - assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); + assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL); } return assocPtr->cmdPrefix; } /* @@ -583,22 +594,22 @@ *---------------------------------------------------------------------- */ static void BgErrorDeleteProc( - ClientData clientData, /* Pointer to ErrAssocData structure. */ - Tcl_Interp *interp) /* Interpreter being deleted. */ + void *clientData, /* Pointer to ErrAssocData structure. */ + TCL_UNUSED(Tcl_Interp *)) { - ErrAssocData *assocPtr = clientData; + ErrAssocData *assocPtr = (ErrAssocData *)clientData; BgError *errPtr; while (assocPtr->firstBgPtr != NULL) { errPtr = assocPtr->firstBgPtr; assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - Tcl_Free(errPtr); + ckfree(errPtr); } Tcl_CancelIdleCall(HandleBgErrors, assocPtr); Tcl_DecrRefCount(assocPtr->cmdPrefix); Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC); } @@ -622,13 +633,13 @@ */ void Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - ClientData clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr = Tcl_Alloc(sizeof(ExitHandler)); + ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); exitPtr->nextPtr = firstExitPtr; @@ -655,13 +666,13 @@ */ void TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - ClientData clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr = Tcl_Alloc(sizeof(ExitHandler)); + ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); exitPtr->nextPtr = firstLateExitPtr; @@ -688,11 +699,11 @@ */ void Tcl_DeleteExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - ClientData clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL; @@ -702,11 +713,11 @@ if (prevPtr == NULL) { firstExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } - Tcl_Free(exitPtr); + ckfree(exitPtr); break; } } Tcl_MutexUnlock(&exitMutex); return; @@ -731,11 +742,11 @@ */ void TclDeleteLateExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - ClientData clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL; @@ -745,11 +756,11 @@ if (prevPtr == NULL) { firstLateExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } - Tcl_Free(exitPtr); + ckfree(exitPtr); break; } } Tcl_MutexUnlock(&exitMutex); return; @@ -774,16 +785,16 @@ */ void Tcl_CreateThreadExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - ClientData clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - exitPtr = Tcl_Alloc(sizeof(ExitHandler)); + exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; exitPtr->nextPtr = tsdPtr->firstExitPtr; tsdPtr->firstExitPtr = exitPtr; } @@ -807,11 +818,11 @@ */ void Tcl_DeleteThreadExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - ClientData clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; @@ -821,11 +832,11 @@ if (prevPtr == NULL) { tsdPtr->firstExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } - Tcl_Free(exitPtr); + ckfree(exitPtr); return; } } } @@ -899,11 +910,11 @@ */ firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - Tcl_Free(exitPtr); + ckfree(exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); } @@ -989,11 +1000,11 @@ } /* *------------------------------------------------------------------------- * - * TclInitSubsystems -- + * Tcl_InitSubsystems -- * * Initialize various subsytems in Tcl. This should be called the first * time an interp is created, or before any of the subsystems are used. * This function ensures an order for the initialization of subsystems: * @@ -1012,14 +1023,14 @@ * *------------------------------------------------------------------------- */ void -TclInitSubsystems(void) +Tcl_InitSubsystems(void) { if (inExit != 0) { - Tcl_Panic("TclInitSubsystems called while exiting"); + Tcl_Panic("Tcl_InitSubsystems called while exiting"); } if (subsystemsInitialized == 0) { /* * Double check inside the mutex. There are definitly calls back into @@ -1127,11 +1138,11 @@ */ firstLateExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - Tcl_Free(exitPtr); + ckfree(exitPtr); Tcl_MutexLock(&exitMutex); } firstLateExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); @@ -1238,11 +1249,11 @@ TclFinalizeLoad(); TclResetFilesystem(); /* - * At this point, there should no longer be any Tcl_Alloc'ed memory. + * At this point, there should no longer be any ckalloc'ed memory. */ TclFinalizeMemorySubsystem(); alreadyFinalized: @@ -1283,11 +1294,11 @@ * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because * we don't want to initialize the data block if it hasn't been * initialized already. */ - tsdPtr = TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData*)TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { tsdPtr->inExit = 1; for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; exitPtr = tsdPtr->firstExitPtr) { @@ -1297,11 +1308,11 @@ * callback should call Tcl_DeleteThreadExitHandler on itself. */ tsdPtr->firstExitPtr = exitPtr->nextPtr; exitPtr->proc(exitPtr->clientData); - Tcl_Free(exitPtr); + ckfree(exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); TclFinalizeAsync(); TclFinalizeThreadObjects(); @@ -1358,11 +1369,11 @@ */ int TclInThreadExit(void) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { return 0; } return tsdPtr->inExit; @@ -1383,14 +1394,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_VwaitObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int done, foundEvent; @@ -1398,11 +1408,11 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - nameString = TclGetString(objv[1]); + nameString = Tcl_GetString(objv[1]); if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done) != TCL_OK) { return TCL_ERROR; }; @@ -1447,23 +1457,22 @@ Tcl_ResetResult(interp); return TCL_OK; } - /* ARGSUSED */ static char * VwaitVarProc( - ClientData clientData, /* Pointer to integer to set to 1. */ + void *clientData, /* Pointer to integer to set to 1. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ - int flags) /* Information about what happened. */ + TCL_UNUSED(int) /*flags*/) /* Information about what happened. */ { - int *donePtr = clientData; + int *donePtr = (int *)clientData; *donePtr = 1; - Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_UntraceVar2(interp, name1, name2, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, clientData); return NULL; } /* @@ -1481,14 +1490,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_UpdateObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int optionIndex; @@ -1552,19 +1560,19 @@ *---------------------------------------------------------------------- */ static Tcl_ThreadCreateType NewThreadProc( - ClientData clientData) + void *clientData) { - ThreadClientData *cdPtr = clientData; - ClientData threadClientData; + ThreadClientData *cdPtr = (ThreadClientData *)clientData; + void *threadClientData; Tcl_ThreadCreateProc *threadProc; threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; - Tcl_Free(clientData); /* Allocated in Tcl_CreateThread() */ + ckfree(clientData); /* Allocated in Tcl_CreateThread() */ threadProc(threadClientData); TCL_THREAD_CREATE_RETURN; } @@ -1591,24 +1599,24 @@ int Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - ClientData clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + void *clientData, /* The one argument to Main() */ + int stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #if TCL_THREADS - ThreadClientData *cdPtr = Tcl_Alloc(sizeof(ThreadClientData)); + ThreadClientData *cdPtr = (ThreadClientData *)ckalloc(sizeof(ThreadClientData)); int result; cdPtr->proc = proc; cdPtr->clientData = clientData; result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags); if (result != TCL_OK) { - Tcl_Free(cdPtr); + ckfree(cdPtr); } return result; #else return TCL_ERROR; #endif /* TCL_THREADS */ Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -16,11 +16,11 @@ */ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" -#include "tommath.h" +#include "tclTomMath.h" #include #include /* * Hack to determine whether we may expect IEEE floating point. The hack is @@ -71,15 +71,15 @@ * Mapping from expression instruction opcodes to strings; used for error * messages. Note that these entries must match the order and number of the * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is - * disjoint for backward-compatibility reasons. + * disjoint for backward-compatability reasons. */ static const char *const operatorStrings[] = { - "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", + "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", "+", "-", "*", "/", "%", "+", "-", "~", "!" }; /* * Mapping from Tcl result codes to strings; used for error and debugging @@ -99,18 +99,76 @@ #ifdef TCL_COMPILE_STATS size_t tclObjsAlloced = 0; size_t tclObjsFreed = 0; size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ + +/* + * Support pre-8.5 bytecodes unless specifically requested otherwise. + */ + +#ifndef TCL_SUPPORT_84_BYTECODE +#define TCL_SUPPORT_84_BYTECODE 1 +#endif + +#if TCL_SUPPORT_84_BYTECODE +/* + * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 + * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. + */ + +typedef struct { + const char *name; /* Name of function. */ + int numArgs; /* Number of arguments for function. */ +} BuiltinFunc; + +/* + * Table describing the built-in math functions. Entries in this table are + * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's + * operand byte. + */ + +static BuiltinFunc const tclBuiltinFuncTable[] = { + {"acos", 1}, + {"asin", 1}, + {"atan", 1}, + {"atan2", 2}, + {"ceil", 1}, + {"cos", 1}, + {"cosh", 1}, + {"exp", 1}, + {"floor", 1}, + {"fmod", 2}, + {"hypot", 2}, + {"log", 1}, + {"log10", 1}, + {"pow", 2}, + {"sin", 1}, + {"sinh", 1}, + {"sqrt", 1}, + {"tan", 1}, + {"tanh", 1}, + {"abs", 1}, + {"double", 1}, + {"int", 1}, + {"rand", 0}, + {"round", 1}, + {"srand", 1}, + {"wide", 1}, + {NULL, 0}, +}; + +#define LAST_BUILTIN_FUNC 25 +#endif /* * NR_TEBC * Helpers for NR - non-recursive calls to TEBC * Minimal data required to fully reconstruct the execution state. */ -typedef struct { +typedef struct TEBCdata { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ ptrdiff_t *catchTop; /* These fields are used on return TO this */ Tcl_Obj *auxObjList; /* this level: they record the state when a */ CmdFrame cmdFrame; /* new codePtr was received for NR */ @@ -142,11 +200,11 @@ } while (0) #define POP_TAUX_OBJ() \ do { \ tmpPtr = auxObjList; \ - auxObjList = tmpPtr->internalRep.twoPtrValue.ptr1; \ + auxObjList = (Tcl_Obj *)tmpPtr->internalRep.twoPtrValue.ptr1; \ Tcl_DecrRefCount(tmpPtr); \ } while (0) /* * These variable-access macros have to coincide with those in tclVar.c @@ -257,44 +315,54 @@ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ + break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ do { \ pc += (pcAdjustment); \ switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ } else { \ objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ + break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ do{ \ @@ -441,17 +509,17 @@ */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ ((TclHasIntRep((objPtr), &tclIntType)) \ ? (*(tPtr) = TCL_NUMBER_INT, \ - *(ptrPtr) = (void *) \ + *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ TclHasIntRep((objPtr), &tclDoubleType) \ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ ? (*(tPtr) = TCL_NUMBER_NAN) \ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ - *(ptrPtr) = (void *) \ + *(ptrPtr) = (ClientData) \ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ ? TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) @@ -592,10 +660,11 @@ */ #define DIVIDED_BY_ZERO ((Tcl_Obj *) -1) #define EXPONENT_OF_ZERO ((Tcl_Obj *) -2) #define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3) +#define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ @@ -623,22 +692,22 @@ Tcl_Obj *valuePtr); static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int searchMode, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, - ByteCode *codePtr, size_t *lengthPtr, + ByteCode *codePtr, int *lengthPtr, const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); static void IllegalExprOperandType(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); static inline int wordSkip(void *ptr); static void ReleaseDictIterator(Tcl_Obj *objPtr); /* Useful elsewhere, make available in tclInt.h or stubs? */ -static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, size_t numWords); -static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, size_t numWords); +static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); +static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; static Tcl_NRPostProc FinalizeOONext; static Tcl_NRPostProc FinalizeOONextFilter; static Tcl_NRPostProc TEBCresume; @@ -698,15 +767,15 @@ /* * First kill the search, and then release the reference to the dictionary * that we were holding. */ - searchPtr = irPtr->twoPtrValue.ptr1; + searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1; Tcl_DictObjDone(searchPtr); - Tcl_Free(searchPtr); + ckfree(searchPtr); - dictPtr = irPtr->twoPtrValue.ptr2; + dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2; TclDecrRefCount(dictPtr); } /* *---------------------------------------------------------------------- @@ -727,26 +796,36 @@ * "tcl_traceExec" and C "tclTraceExec" variables. * *---------------------------------------------------------------------- */ +#if defined(TCL_COMPILE_STATS) || defined(TCL_COMPILE_DEBUG) static void InitByteCodeExecution( Tcl_Interp *interp) /* Interpreter for which the Tcl variable * "tcl_traceExec" is linked to control * instruction tracing. */ { #ifdef TCL_COMPILE_DEBUG - if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec, + if (Tcl_LinkVar(interp, "tcl_traceExec", &tclTraceExec, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable"); } #endif #ifdef TCL_COMPILE_STATS Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL); #endif /* TCL_COMPILE_STATS */ } + +#else + +static void +InitByteCodeExecution( + TCL_UNUSED(Tcl_Interp *)) +{ +} +#endif /* *---------------------------------------------------------------------- * * TclCreateExecEnv -- @@ -770,16 +849,16 @@ ExecEnv * TclCreateExecEnv( Tcl_Interp *interp, /* Interpreter for which the execution * environment is being created. */ - size_t size) /* The initial stack size, in number of words + int size) /* The initial stack size, in number of words * [sizeof(Tcl_Obj*)] */ { - ExecEnv *eePtr = Tcl_Alloc(sizeof(ExecEnv)); - ExecStack *esPtr = Tcl_Alloc(sizeof(ExecStack) - + (size-1) * sizeof(Tcl_Obj *)); + ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv)); + ExecStack *esPtr = (ExecStack *)ckalloc(sizeof(ExecStack) + + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; TclNewIntObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); TclNewIntObj(eePtr->constants[1], 1); @@ -834,11 +913,11 @@ esPtr->prevPtr->nextPtr = esPtr->nextPtr; } if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } - Tcl_Free(esPtr); + ckfree(esPtr); } void TclDeleteExecEnv( ExecEnv *eePtr) /* Execution environment to free. */ @@ -866,11 +945,11 @@ Tcl_Panic("Deleting execEnv with pending TEOV callbacks!"); } if (eePtr->corPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with existing coroutine"); } - Tcl_Free(eePtr); + ckfree(eePtr); } /* *---------------------------------------------------------------------- * @@ -957,12 +1036,12 @@ int growth, /* How much larger than the current used * size. */ int move) /* 1 if move words since last marker. */ { ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; - size_t newBytes; - int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); + int newBytes, newElems, currElems; + int needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; int moveWords = 0; if (move) { if (!markerPtr) { @@ -1043,11 +1122,11 @@ #endif newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); oldPtr = esPtr; - esPtr = Tcl_Alloc(newBytes); + esPtr = (ExecStack *)ckalloc(newBytes); oldPtr->nextPtr = esPtr; esPtr->prevPtr = oldPtr; esPtr->nextPtr = NULL; esPtr->endPtr = &esPtr->stackWords[newElems-1]; @@ -1103,11 +1182,11 @@ */ static Tcl_Obj ** StackAllocWords( Tcl_Interp *interp, - size_t numWords) + int numWords) { /* * Note that GrowEvaluationStack sets a marker in the stack. This marker * is read when rewinding, e.g., by TclStackFree. */ @@ -1121,11 +1200,11 @@ } static Tcl_Obj ** StackReallocWords( Tcl_Interp *interp, - size_t numWords) + int numWords) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1); @@ -1142,11 +1221,11 @@ ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr, *marker; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - Tcl_Free(freePtr); + ckfree(freePtr); return; } /* * Rewind the stack to the previous marker position. The current marker, @@ -1200,36 +1279,36 @@ } void * TclStackAlloc( Tcl_Interp *interp, - size_t numBytes) + int numBytes) { Interp *iPtr = (Interp *) interp; - size_t numWords; + int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) Tcl_Alloc(numBytes); + return (void *) ckalloc(numBytes); } numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); - return StackAllocWords(interp, numWords); + return (void *) StackAllocWords(interp, numWords); } void * TclStackRealloc( Tcl_Interp *interp, void *ptr, - size_t numBytes) + int numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr; - size_t numWords; + int numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return Tcl_Realloc(ptr, numBytes); + return (void *) ckrealloc((char *) ptr, numBytes); } eePtr = iPtr->execEnvPtr; esPtr = eePtr->execStackPtr; markerPtr = esPtr->markerPtr; @@ -1267,11 +1346,11 @@ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Points to Tcl object containing expression + Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ { NRE_callback *rootPtr = TOP_CB(interp); @@ -1285,15 +1364,15 @@ } static int CopyCallback( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { - Tcl_Obj **resultPtrPtr = data[0]; - Tcl_Obj *resultPtr = data[1]; + Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0]; + Tcl_Obj *resultPtr = (Tcl_Obj *)data[1]; if (result == TCL_OK) { *resultPtrPtr = resultPtr; Tcl_IncrRefCount(resultPtr); } else { @@ -1346,12 +1425,12 @@ ExprObjCallback( ClientData data[], Tcl_Interp *interp, int result) { - Tcl_InterpState state = data[0]; - Tcl_Obj *resultPtr = data[1]; + Tcl_InterpState state = (Tcl_InterpState)data[0]; + Tcl_Obj *resultPtr = (Tcl_Obj *)data[1]; if (result == TCL_OK) { TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp)); (void) Tcl_RestoreInterpState(interp, state); } else { @@ -1413,15 +1492,14 @@ if (codePtr == NULL) { /* * TIP #280: No invoker (yet) - Expression compilation. */ - size_t length; - const char *string = TclGetStringFromObj(objPtr, &length); + const char *string = TclGetString(objPtr); - TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); - TclCompileExpr(interp, string, length, &compEnv, 0); + TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0); + TclCompileExpr(interp, string, objPtr->length, &compEnv, 0); /* * Successful compilation. If the expression yielded no instructions, * push an zero object as the expression's result. */ @@ -1481,12 +1559,12 @@ *---------------------------------------------------------------------- */ static void DupExprCodeInternalRep( - Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr) + TCL_UNUSED(Tcl_Obj *), + TCL_UNUSED(Tcl_Obj *)) { return; } /* @@ -1634,13 +1712,13 @@ if (!hePtr) { return codePtr; } - eclPtr = Tcl_GetHashValue(hePtr); + eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); redo = 0; - ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + ctxCopyPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *ctxCopyPtr = *invoker; if (invoker->type == TCL_LOCATION_BC) { /* * Note: Type BC => ctx.data.eval.path is not used. @@ -1732,10 +1810,11 @@ Tcl_Obj *incrPtr) { ClientData ptr1, ptr2; int type1, type2; mp_int value, incr; + mp_err err; if (Tcl_IsShared(valuePtr)) { Tcl_Panic("%s called with shared object", "TclIncrObj"); } @@ -1790,12 +1869,15 @@ } } Tcl_TakeBignumFromObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); - mp_add(&value, &incr, &value); + err = mp_add(&value, &incr, &value); mp_clear(&incr); + if (err != MP_OKAY) { + return TCL_ERROR; + } Tcl_SetBignumObj(valuePtr, &value); return TCL_OK; } /* @@ -1922,11 +2004,18 @@ /* * Push the callback for bytecode execution */ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, - /* cleanup */ INT2PTR(0), NULL); + /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags)); + + /* + * Reset discard result flag - because it is applicable for this call only, + * and should not affect all the nested invocations may return result. + */ + iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT; + return TCL_OK; } static int TEBCresume( @@ -1980,22 +2069,23 @@ /* * These macros are just meant to save some global variables that are not * used too frequently */ - TEBCdata *TD = data[0]; + TEBCdata *TD = (TEBCdata *)data[0]; #define auxObjList (TD->auxObjList) #define catchTop (TD->catchTop) #define codePtr (TD->codePtr) +#define curEvalFlags PTR2INT(data[3]) /* calling iPtr->evalFlags */ /* * Globals: variables that store state, must remain valid at all times. */ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ - const unsigned char *pc = data[1]; + const unsigned char *pc = (const unsigned char *)data[1]; /* The current program counter. */ unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while @@ -2002,21 +2092,21 @@ * executing an instruction. */ int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* * Locals - variables that are used within opcodes or bounded sections of * the file (jumps between opcodes within a family). * NOTE: These are now mostly defined locally where needed. */ Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr; - Tcl_Obj **objv; + Tcl_Obj **objv = NULL; int objc = 0; int opnd, length, pcAdjustment; Var *varPtr, *arrayPtr; #ifdef TCL_COMPILE_DEBUG char cmdNameBuf[21]; @@ -2037,11 +2127,10 @@ } #endif if (!pc) { /* bytecode is starting from scratch */ - checkInterp = 0; pc = codePtr->codeStart; goto cleanup0; } else { /* resume from invocation */ CACHE_STACK_INFO(); @@ -2059,12 +2148,13 @@ if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; goto abnormalReturn; } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { - iPtr->flags |= ERR_ALREADY_LOGGED; codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; + checkInterp = 1; + iPtr->flags |= ERR_ALREADY_LOGGED; } if (result != TCL_OK) { pc--; goto processExceptionReturn; @@ -2120,14 +2210,16 @@ cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } + /* FALLTHRU */ case 2: cleanup2_pushObjResultPtr: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); + /* FALLTHRU */ case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; TclDecrRefCount(objPtr); } @@ -2140,18 +2232,21 @@ cleanup -= 2; while (cleanup--) { objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); } + /* FALLTHRU */ case 2: cleanup2: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); + /* FALLTHRU */ case 1: cleanup1: objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); + /* FALLTHRU */ case 0: /* * We really want to do nothing now, but this is needed for some * compilers (SunPro CC). */ @@ -2235,16 +2330,16 @@ * Peephole: do not run INST_START_CMD, just skip it */ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (checkInterp) { - checkInterp = 0; if (((codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { goto instStartCmdFailed; } + checkInterp = 0; } inst = *(pc += 9); goto peepholeStart; } else if (inst == INST_NOP) { #ifndef TCL_COMPILE_DEBUG @@ -2467,10 +2562,18 @@ goto processExceptionReturn; } case INST_DONE: if (tosPtr > initTosPtr) { + + if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) { + /* simulate pop & fast done (like it does continue in loop) */ + TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); + objPtr = POP_OBJECT(); + TclDecrRefCount(objPtr); + goto abnormalReturn; + } /* * Set the interpreter's object result to point to the topmost * object from the stack, and check for a possible [catch]. The * stackTop's level and refCount will be handled by "processCatch" * or "abnormalReturn". @@ -2491,27 +2594,31 @@ case INST_PUSH4: objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); NEXT_INST_F(5, 0, 1); + break; case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); NEXT_INST_F(1, 0, 0); + break; case INST_DUP: objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); + break; case INST_REVERSE: { Tcl_Obj **a, **b; opnd = TclGetUInt4AtPtr(pc+1); @@ -2524,10 +2631,11 @@ a++; b--; } TRACE(("%u => OK\n", opnd)); NEXT_INST_F(5, 0, 0); } + break; case INST_STR_CONCAT1: opnd = TclGetUInt1AtPtr(pc+1); objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1), @@ -2537,10 +2645,11 @@ goto gotError; } TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); + break; case INST_CONCAT_STK: /* * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, * and then decrement their ref counts. @@ -2548,19 +2657,20 @@ opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); + break; case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current * stack depth - i.e., the point in the stack where the expanded * command starts. * * Use a Tcl_Obj as linked list element; slight mem waste, but faster - * allocation than Tcl_Alloc. This also abuses the Tcl_Obj structure, as + * allocation than ckalloc. This also abuses the Tcl_Obj structure, as * we do not define a special tclObjType for it. It is not dangerous * as the obj is never passed anywhere, so that all manipulations are * performed here and in INST_INVOKE_EXPANDED (in case of an expansion * error, also in INST_EXPAND_STKTOP). */ @@ -2569,10 +2679,11 @@ objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH); objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); + break; case INST_EXPAND_DROP: /* * Drops an element of the auxObjList, popping stack elements to * restore the stack to the state before the point where the aux @@ -2647,10 +2758,11 @@ TRACE_APPEND(("OK\n")); Tcl_DecrRefCount(objPtr); NEXT_INST_F(5, 0, 0); } + break; case INST_EXPR_STK: { ByteCode *newCodePtr; bcFramePtr->data.tebc.pc = (char *) pc; @@ -2666,19 +2778,22 @@ /* * INVOCATION BLOCK */ - instEvalStk: case INST_EVAL_STK: + instEvalStk: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; cleanup = 1; pc += 1; + /* yield next instruction */ TEBC_YIELD(); - return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0); + /* add TEBCResume for object at top of stack */ + return TclNRExecuteByteCode(interp, + TclCompileObj(interp, OBJ_AT_TOS, NULL, 0)); case INST_INVOKE_EXPANDED: CLANG_ASSERT(auxObjList); objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2); POP_TAUX_OBJ(); @@ -2691,10 +2806,11 @@ * Nothing was expanded, return {}. */ TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; goto doInvocation; @@ -2745,10 +2861,95 @@ pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); + +#if TCL_SUPPORT_84_BYTECODE + case INST_CALL_BUILTIN_FUNC1: + /* + * Call one of the built-in pre-8.5 Tcl math functions. This + * translates to INST_INVOKE_STK1 with the first argument of + * ::tcl::mathfunc::$objv[0]. We need to insert the named math + * function into the stack. + */ + + opnd = TclGetUInt1AtPtr(pc+1); + if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { + TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); + Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); + } + + TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); + Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); + + /* + * Only 0, 1 or 2 args. + */ + + { + int numArgs = tclBuiltinFuncTable[opnd].numArgs; + Tcl_Obj *tmpPtr1, *tmpPtr2; + + if (numArgs == 0) { + PUSH_OBJECT(objPtr); + } else if (numArgs == 1) { + tmpPtr1 = POP_OBJECT(); + PUSH_OBJECT(objPtr); + PUSH_OBJECT(tmpPtr1); + Tcl_DecrRefCount(tmpPtr1); + } else { + tmpPtr2 = POP_OBJECT(); + tmpPtr1 = POP_OBJECT(); + PUSH_OBJECT(objPtr); + PUSH_OBJECT(tmpPtr1); + PUSH_OBJECT(tmpPtr2); + Tcl_DecrRefCount(tmpPtr1); + Tcl_DecrRefCount(tmpPtr2); + } + objc = numArgs + 1; + } + pcAdjustment = 2; + goto doInvocation; + + case INST_CALL_FUNC1: + /* + * Call a non-builtin Tcl math function previously registered by a + * call to Tcl_CreateMathFunc pre-8.5. This is essentially + * INST_INVOKE_STK1 converting the first arg to + * ::tcl::mathfunc::$objv[0]. + */ + + objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function + * name is the 0-th argument. */ + + objPtr = OBJ_AT_DEPTH(objc-1); + TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); + Tcl_AppendObjToObj(tmpPtr, objPtr); + Tcl_DecrRefCount(objPtr); + + /* + * Variation of PUSH_OBJECT. + */ + + OBJ_AT_DEPTH(objc-1) = tmpPtr; + Tcl_IncrRefCount(tmpPtr); + + pcAdjustment = 2; + goto doInvocation; +#else + /* + * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the + * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support + * remains for existing bytecode precompiled files. + */ + + case INST_CALL_BUILTIN_FUNC1: + Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); + case INST_CALL_FUNC1: + Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); +#endif case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); objPtr = POP_OBJECT(); @@ -3566,11 +3767,11 @@ varPtr = varPtr->value.linkPtr; } arrayPtr = NULL; part1Ptr = part2Ptr = NULL; cleanup = 0; - TRACE(("%u %s => ", opnd, TclGetString(incrPtr))); + TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr))); doIncrVar: if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) { objPtr = varPtr->value.objPtr; if (Tcl_IsShared(objPtr)) { @@ -3833,11 +4034,35 @@ errorInUnset: CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; + + /* + * This is really an unset operation these days. Do not issue. + */ + + case INST_DICT_DONE: + opnd = TclGetUInt4AtPtr(pc+1); + TRACE(("%u => OK\n", opnd)); + varPtr = LOCAL(opnd); + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { + if (!TclIsVarUndefined(varPtr)) { + TclDecrRefCount(varPtr->value.objPtr); + } + varPtr->value.objPtr = NULL; + } else { + DECACHE_STACK_INFO(); + TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd); + CACHE_STACK_INFO(); + } + NEXT_INST_F(5, 0, 0); } + break; /* * End of INST_UNSET instructions. * ----------------------------------------------------------------- * Start of INST_ARRAY instructions. @@ -4051,10 +4276,11 @@ */ TRACE_APPEND(("link made\n")); NEXT_INST_F(5, 1, 0); } + break; /* * End of variable linking instructions. * ----------------------------------------------------------------- */ @@ -4062,10 +4288,11 @@ case INST_JUMP1: opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); + break; case INST_JUMP4: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); @@ -4124,10 +4351,11 @@ } } #endif NEXT_INST_F(jmpOffset[b], 1, 0); } + break; case INST_JUMP_TABLE: { Tcl_HashEntry *hPtr; JumptableInfo *jtPtr; @@ -4149,10 +4377,56 @@ } else { TRACE_APPEND(("not found in table\n")); NEXT_INST_F(5, 1, 0); } } + break; + + /* + * These two instructions are now redundant: the complete logic of the LOR + * and LAND is now handled by the expression compiler. + */ + + case INST_LOR: + case INST_LAND: { + /* + * Operands must be boolean or numeric. No int->double conversions are + * performed. + */ + + int i1, i2, iResult; + + value2Ptr = OBJ_AT_TOS; + valuePtr = OBJ_UNDER_TOS; + if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { + TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), + (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); + IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); + goto gotError; + } + + if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { + TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), + (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); + IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); + goto gotError; + } + + if (*pc == INST_LOR) { + iResult = (i1 || i2); + } else { + iResult = (i1 && i2); + } + objResultPtr = TCONST(iResult); + TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult)); + NEXT_INST_F(1, 2, 1); + } + break; /* * ----------------------------------------------------------------- * Start of general introspector instructions. */ @@ -4167,10 +4441,11 @@ strlen(currNsPtr->fullName)); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } + break; case INST_COROUTINE_NAME: { CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; TclNewObj(objResultPtr); if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) { @@ -4178,14 +4453,16 @@ objResultPtr); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } + break; case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; @@ -4272,11 +4549,11 @@ DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } - contextPtr = framePtr->clientData; + contextPtr = (CallContext *)framePtr->clientData; /* * Call out to get the name; it's expensive to compute but cached. */ @@ -4300,11 +4577,11 @@ DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } - contextPtr = framePtr->clientData; + contextPtr = (CallContext *)framePtr->clientData; oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr); if (oPtr == NULL) { TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr))); goto gotError; @@ -4399,11 +4676,11 @@ DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); CACHE_STACK_INFO(); goto gotError; } - contextPtr = framePtr->clientData; + contextPtr = (CallContext *)framePtr->clientData; newDepth = contextPtr->index + 1; if (newDepth >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless @@ -4527,12 +4804,12 @@ * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ { - int numIndices, nocase, match, cflags; - size_t slength, length2, fromIdx, toIdx, index, s1len, s2len; + int index, numIndices, fromIdx, toIdx; + int nocase, match, length2, cflags, s1len, s2len; const char *s1, *s2; case INST_LIST: /* * Pop the opnd (objc) top stack elements into a new list obj and then @@ -4611,11 +4888,11 @@ index = TclIndexDecode(opnd, objc - 1); pcAdjustment = 5; lindexFastPath: - if (index < (size_t)objc) { + if (index >= 0 && index < objc) { objResultPtr = objv[index]; } else { TclNewObj(objResultPtr); } @@ -4774,17 +5051,17 @@ objResultPtr = Tcl_NewObj(); TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); } toIdx = TclIndexDecode(toIdx, objc - 1); - if (toIdx == TCL_INDEX_NONE) { + if (toIdx < 0) { goto emptyList; - } else if (toIdx + 1 >= (size_t)objc + 1) { + } else if (toIdx >= objc) { toIdx = objc - 1; } - assert (toIdx < (size_t)objc); + assert ( toIdx >= 0 && toIdx < objc); /* assert ( fromIdx != TCL_INDEX_NONE ); * * Extra safety for legacy bytecodes: */ @@ -4936,62 +5213,62 @@ (match < 0 ? -1 : match > 0 ? 1 : 0))); JUMP_PEEPHOLE_F(match, 1, 2); case INST_STR_LEN: valuePtr = OBJ_AT_TOS; - slength = Tcl_GetCharLength(valuePtr); - objResultPtr = TclNewWideIntObjFromSize(slength); - TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength)); + length = Tcl_GetCharLength(valuePtr); + TclNewIntObj(objResultPtr, length); + TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &slength); - TclNewStringObj(objResultPtr, s1, slength); - slength = Tcl_UtfToUpper(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, slength); + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToUpper(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - slength = Tcl_UtfToUpper(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, slength); + length = Tcl_UtfToUpper(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_STR_LOWER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &slength); - TclNewStringObj(objResultPtr, s1, slength); - slength = Tcl_UtfToLower(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, slength); + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToLower(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - slength = Tcl_UtfToLower(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, slength); + length = Tcl_UtfToLower(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_STR_TITLE: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &slength); - TclNewStringObj(objResultPtr, s1, slength); - slength = Tcl_UtfToTitle(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, slength); + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToTitle(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - slength = Tcl_UtfToTitle(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, slength); + length = Tcl_UtfToTitle(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -5002,22 +5279,22 @@ /* * Get char length to calulate what 'end' means. */ - slength = Tcl_GetCharLength(valuePtr); - if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) { + length = Tcl_GetCharLength(valuePtr); + if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } - if (index >= slength) { + if ((index < 0) || (index >= length)) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1); - } else if (valuePtr->bytes && slength == valuePtr->length) { + } else if (valuePtr->bytes && length == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { char buf[4] = ""; int ch = Tcl_GetUniChar(valuePtr, index); @@ -5028,40 +5305,40 @@ * practical use. */ if (ch == -1) { objResultPtr = Tcl_NewObj(); } else { - slength = Tcl_UniCharToUtf(ch, buf); - if ((ch >= 0xD800) && (slength < 3)) { - slength += Tcl_UniCharToUtf(-1, buf + slength); + length = Tcl_UniCharToUtf(ch, buf); + if ((ch >= 0xD800) && (length < 3)) { + length += Tcl_UniCharToUtf(-1, buf + length); } - objResultPtr = Tcl_NewStringObj(buf, slength); + objResultPtr = Tcl_NewStringObj(buf, length); } } TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_RANGE: TRACE(("\"%.20s\" %.20s %.20s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); - slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, + length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, &fromIdx) != TCL_OK - || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, + || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, &toIdx) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } - if (fromIdx == TCL_INDEX_NONE) { - fromIdx = TCL_INDEX_START; + if (fromIdx < 0) { + fromIdx = 0; } - if (toIdx + 1 >= slength + 1) { - toIdx = slength; + if (toIdx >= length) { + toIdx = length; } - if (toIdx + 1 >= fromIdx + 1) { + if (toIdx >= fromIdx) { objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); } else { TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); @@ -5069,15 +5346,15 @@ case INST_STR_RANGE_IMM: valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); - slength = Tcl_GetCharLength(valuePtr); - TRACE(("\"%.20s\" %" TCL_LL_MODIFIER "d %" TCL_LL_MODIFIER "d => ", O2S(valuePtr), TclWideIntFromSize(fromIdx), TclWideIntFromSize(toIdx))); + length = Tcl_GetCharLength(valuePtr); + TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx)); /* Every range of an empty value is an empty value */ - if (slength == 0) { + if (length == 0) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } /* Decode index operands. */ @@ -5089,18 +5366,18 @@ */ if (toIdx == TCL_INDEX_NONE) { goto emptyRange; } - toIdx = TclIndexDecode(toIdx, slength - 1); - if (toIdx == TCL_INDEX_NONE) { + toIdx = TclIndexDecode(toIdx, length - 1); + if (toIdx < 0) { goto emptyRange; - } else if (toIdx >= slength) { - toIdx = slength - 1; + } else if (toIdx >= length) { + toIdx = length - 1; } - assert ( toIdx != TCL_INDEX_NONE && toIdx < slength ); + assert ( toIdx >= 0 && toIdx < length ); /* assert ( fromIdx != TCL_INDEX_NONE ); * * Extra safety for legacy bytecodes: @@ -5107,16 +5384,16 @@ */ if (fromIdx == TCL_INDEX_NONE) { fromIdx = TCL_INDEX_START; } - fromIdx = TclIndexDecode(fromIdx, slength - 1); - if (fromIdx == TCL_INDEX_NONE) { - fromIdx = TCL_INDEX_START; + fromIdx = TclIndexDecode(fromIdx, length - 1); + if (fromIdx < 0) { + fromIdx = 0; } - if (fromIdx + 1 <= toIdx + 1) { + if (fromIdx <= toIdx) { objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } else { emptyRange: TclNewObj(objResultPtr); } @@ -5123,22 +5400,22 @@ TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; - size_t length3; + int length3, endIdx; Tcl_Obj *value3Ptr; case INST_STR_REPLACE: value3Ptr = POP_OBJECT(); valuePtr = OBJ_AT_DEPTH(2); - slength = Tcl_GetCharLength(valuePtr) - 1; + endIdx = Tcl_GetCharLength(valuePtr) - 1; TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx, &fromIdx) != TCL_OK - || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, + || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx, &toIdx) != TCL_OK) { TclDecrRefCount(value3Ptr); TRACE_ERROR(interp); goto gotError; } @@ -5145,27 +5422,27 @@ TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); - if ((toIdx == TCL_INDEX_NONE) || - (fromIdx + 1 > slength + 1) || - (toIdx + 1 < fromIdx + 1)) { + if ((toIdx < 0) || + (fromIdx > endIdx) || + (toIdx < fromIdx)) { TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); TclDecrRefCount(value3Ptr); NEXT_INST_F(1, 0, 0); } - if (fromIdx == TCL_INDEX_NONE) { - fromIdx = TCL_INDEX_START; + if (fromIdx < 0) { + fromIdx = 0; } - if (toIdx + 1 > slength + 1) { - toIdx = slength; + if (toIdx > endIdx) { + toIdx = endIdx; } - if ((fromIdx == TCL_INDEX_START) && (toIdx == slength)) { + if (fromIdx == 0 && toIdx == endIdx) { TclDecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = value3Ptr; TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); NEXT_INST_F(1, 0, 0); } @@ -5193,32 +5470,32 @@ goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; goto doneStringMap; } - ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); - if (slength == 0) { + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); + if (length == 0) { objResultPtr = valuePtr; goto doneStringMap; } - ustring2 = TclGetUnicodeFromObj(value2Ptr, &length2); - if (length2 > slength || length2 == 0) { + ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); + if (length2 > length || length2 == 0) { objResultPtr = valuePtr; goto doneStringMap; - } else if (length2 == slength) { - if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * slength)) { + } else if (length2 == length) { + if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } goto doneStringMap; } - ustring3 = TclGetUnicodeFromObj(value3Ptr, &length3); + ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; - end = ustring1 + slength; + end = ustring1 + length; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { @@ -5243,36 +5520,36 @@ TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: - slength = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); + objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0); - TRACE(("%.20s %.20s => %" TCL_LL_MODIFIER "d\n", - O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), TclWideIntFromSize(slength))); - objResultPtr = TclNewWideIntObjFromSize(slength); + TRACE(("%.20s %.20s => %d\n", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: - slength = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, TCL_INDEX_END); + objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1); - TRACE(("%.20s %.20s => %" TCL_LL_MODIFIER "d\n", - O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), TclWideIntFromSize(slength))); - objResultPtr = TclNewWideIntObjFromSize(slength); + TRACE(("%.20s %.20s => %d\n", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: opnd = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); - ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); match = 1; - if (slength > 0) { - end = ustring1 + slength; - for (p=ustring1 ; p 0) { + int ch; + end = ustring1 + length; + for (p=ustring1 ; p> ((int) w2); goto wideResultOfArithmetic; } + break; case INST_LSHIFT: if (w2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); @@ -5841,10 +6119,11 @@ NEXT_INST_F(1, 2, 1); } TclSetIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); + break; case INST_DIV: if (w2 == 0) { TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr), O2S(value2Ptr))); @@ -5898,10 +6177,13 @@ TRACE_APPEND(("EXPONENT OF ZERO\n")); goto exponOfZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { TRACE_ERROR(interp); goto gotError; + } else if (objResultPtr == OUT_OF_MEMORY) { + TRACE_APPEND(("OUT OF MEMORY\n")); + goto outOfMemory; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } else { TRACE_APPEND(("%s\n", O2S(objResultPtr))); @@ -5980,10 +6262,11 @@ switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); + break; case TCL_NUMBER_INT: w1 = *((const Tcl_WideInt *) ptr1); if (w1 != WIDE_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewIntObj(objResultPtr, -w1); @@ -6088,10 +6371,11 @@ } TclInvalidateStringRep(valuePtr); TRACE_APPEND(("numeric, same Tcl_Obj\n")); NEXT_INST_F(1, 0, 0); } + break; /* * End of numeric operator instructions. * ----------------------------------------------------------------- */ @@ -6104,10 +6388,11 @@ int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(result); } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_BREAK: /* DECACHE_STACK_INFO(); Tcl_ResetResult(interp); @@ -6127,10 +6412,174 @@ result = TCL_CONTINUE; cleanup = 0; TRACE(("=> CONTINUE!\n")); goto processExceptionReturn; + { + ForeachInfo *infoPtr; + Var *iterVarPtr, *listVarPtr; + Tcl_Obj *oldValuePtr, *listPtr, **elements; + ForeachVarList *varListPtr; + int numLists, listTmpIndex, listLen, numVars; + size_t iterNum; + int varIndex, valIndex, continueLoop, j, iterTmpIndex; + long i; + + case INST_FOREACH_START4: /* DEPRECATED */ + /* + * Initialize the temporary local var that holds the count of the + * number of iterations of the loop body to -1. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData; + iterTmpIndex = infoPtr->loopCtTemp; + iterVarPtr = LOCAL(iterTmpIndex); + oldValuePtr = iterVarPtr->value.objPtr; + + if (oldValuePtr == NULL) { + TclNewIntObj(iterVarPtr->value.objPtr, -1); + Tcl_IncrRefCount(iterVarPtr->value.objPtr); + } else { + TclSetIntObj(oldValuePtr, -1); + } + TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex)); + +#ifndef TCL_COMPILE_DEBUG + /* + * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately + * after INST_FOREACH_START4 - let us just fall through instead of + * jumping back to the top. + */ + + pc += 5; + TCL_DTRACE_INST_NEXT(); +#else + NEXT_INST_F(5, 0, 0); +#endif + + case INST_FOREACH_STEP4: /* DEPRECATED */ + /* + * "Step" a foreach loop (i.e., begin its next iteration) by assigning + * the next value list element to each loop var. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + TRACE(("%u => ", opnd)); + infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData; + numLists = infoPtr->numLists; + + /* + * Increment the temp holding the loop iteration number. + */ + + iterVarPtr = LOCAL(infoPtr->loopCtTemp); + valuePtr = iterVarPtr->value.objPtr; + iterNum = (size_t)valuePtr->internalRep.wideValue + 1; + TclSetIntObj(valuePtr, iterNum); + + /* + * Check whether all value lists are exhausted and we should stop the + * loop. + */ + + continueLoop = 0; + listTmpIndex = infoPtr->firstValueTemp; + for (i = 0; i < numLists; i++) { + varListPtr = infoPtr->varLists[i]; + numVars = varListPtr->numVars; + + listVarPtr = LOCAL(listTmpIndex); + listPtr = listVarPtr->value.objPtr; + if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { + TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", + i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); + goto gotError; + } + if ((size_t)listLen > iterNum * numVars) { + continueLoop = 1; + } + listTmpIndex++; + } + + /* + * If some var in some var list still has a remaining list element + * iterate one more time. Assign to var the next element from its + * value list. We already checked above that each list temp holds a + * valid list object (by calling Tcl_ListObjLength), but cannot rely + * on that check remaining valid: one list could have been shimmered + * as a side effect of setting a traced variable. + */ + + if (continueLoop) { + listTmpIndex = infoPtr->firstValueTemp; + for (i = 0; i < numLists; i++) { + varListPtr = infoPtr->varLists[i]; + numVars = varListPtr->numVars; + + listVarPtr = LOCAL(listTmpIndex); + listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); + TclListObjGetElements(interp, listPtr, &listLen, &elements); + + valIndex = (iterNum * numVars); + for (j = 0; j < numVars; j++) { + if (valIndex >= listLen) { + TclNewObj(valuePtr); + } else { + valuePtr = elements[valIndex]; + } + + varIndex = varListPtr->varIndexes[j]; + varPtr = LOCAL(varIndex); + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + if (TclIsVarDirectWritable(varPtr)) { + value2Ptr = varPtr->value.objPtr; + if (valuePtr != value2Ptr) { + if (value2Ptr != NULL) { + TclDecrRefCount(value2Ptr); + } + varPtr->value.objPtr = valuePtr; + Tcl_IncrRefCount(valuePtr); + } + } else { + DECACHE_STACK_INFO(); + if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, + valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ + CACHE_STACK_INFO(); + TRACE_APPEND(( + "ERROR init. index temp %d: %s\n", + varIndex, O2S(Tcl_GetObjResult(interp)))); + TclDecrRefCount(listPtr); + goto gotError; + } + CACHE_STACK_INFO(); + } + valIndex++; + } + TclDecrRefCount(listPtr); + listTmpIndex++; + } + } + TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n", + numLists, iterNum, (continueLoop? "continue" : "exit"))); + + /* + * Run-time peep-hole optimisation: the compiler ALWAYS follows + * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that + * instruction and jump direct from here. + */ + + pc += 5; + if (*pc == INST_JUMP_FALSE1) { + NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); + } else { + NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); + } + + } { ForeachInfo *infoPtr; Tcl_Obj *listPtr, **elements, *tmpPtr; ForeachVarList *varListPtr; int numLists, listLen, numVars; @@ -6144,11 +6593,11 @@ * Initialize the data for the looping construct, pushing the * corresponding Tcl_Objs to the stack. */ opnd = TclGetUInt4AtPtr(pc+1); - infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; + infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData; numLists = infoPtr->numLists; TRACE(("%u => ", opnd)); /* * Compute the number of iterations that will be run: iterMax @@ -6212,11 +6661,11 @@ * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. */ tmpPtr = OBJ_AT_TOS; - infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; + infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE(("=> ")); tmpPtr = OBJ_AT_DEPTH(1); iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1; @@ -6296,11 +6745,11 @@ #endif case INST_FOREACH_END: /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */ tmpPtr = OBJ_AT_TOS; - infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; + infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE(("=> loop terminated\n")); NEXT_INST_V(1, numLists+2, 0); case INST_LMAP_COLLECT: @@ -6313,18 +6762,19 @@ * - collecting obj (unshared) * The instruction lappends the result to the collecting obj. */ tmpPtr = OBJ_AT_DEPTH(1); - infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; + infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists)); objPtr = OBJ_AT_DEPTH(3 + numLists); Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS); NEXT_INST_F(1, 1, 0); } + break; case INST_BEGIN_CATCH4: /* * Record start of the catch command with exception range index equal * to the operand. Push the current stack depth onto the special catch @@ -6334,19 +6784,21 @@ *(++catchTop) = CURR_DEPTH; TRACE(("%u => catchTop=%d, stackTop=%d\n", TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); + break; case INST_END_CATCH: catchTop--; DECACHE_STACK_INFO(); Tcl_ResetResult(interp); CACHE_STACK_INFO(); result = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); + break; case INST_PUSH_RESULT: objResultPtr = Tcl_GetObjResult(interp); TRACE_WITH_OBJ(("=> "), objResultPtr); @@ -6356,22 +6808,25 @@ TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); + break; case INST_PUSH_RETURN_CODE: TclNewIntObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); + break; case INST_PUSH_RETURN_OPTIONS: DECACHE_STACK_INFO(); objResultPtr = Tcl_GetReturnOptions(interp, result); CACHE_STACK_INFO(); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + break; case INST_RETURN_CODE_BRANCH: { int code; if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) { @@ -6407,10 +6862,11 @@ O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); + break; case INST_DICT_EXISTS: { int found; opnd = TclGetUInt4AtPtr(pc+1); @@ -6753,11 +7209,11 @@ case INST_DICT_FIRST: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = POP_OBJECT(); - searchPtr = Tcl_Alloc(sizeof(Tcl_DictSearch)); + searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr, &valuePtr, &done) != TCL_OK) { /* * dictPtr is no longer on the stack, and we're not @@ -6764,11 +7220,11 @@ * moving it into the intrep of an iterator. We need * to drop the refcount [Tcl Bug 9b352768e6]. */ Tcl_DecrRefCount(dictPtr); - Tcl_Free(searchPtr); + ckfree(searchPtr); TRACE_ERROR(interp); goto gotError; } { Tcl_ObjIntRep ir; @@ -6795,11 +7251,11 @@ { const Tcl_ObjIntRep *irPtr; if (statePtr && (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) { - searchPtr = irPtr->twoPtrValue.ptr1; + searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1; Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done); } else { Tcl_Panic("mis-issued dictNext!"); } } @@ -6827,11 +7283,11 @@ case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); - duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; + duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6849,11 +7305,11 @@ if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } - if ((size_t)length != duiPtr->length) { + if (length != duiPtr->length) { Tcl_Panic("dictUpdateStart argument length mismatch"); } for (i=0 ; i ", opnd)); varPtr = LOCAL(opnd); - duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; + duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -7030,10 +7486,11 @@ goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(5, 2, 0); } + break; /* * End of dictionary-related instructions. * ----------------------------------------------------------------- */ @@ -7067,10 +7524,11 @@ } objResultPtr = Tcl_NewWideIntObj(wval); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(2, 0, 1); } + break; default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); } /* end of switch on opCode */ @@ -7174,10 +7632,17 @@ DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; + outOfMemory: + Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", NULL); + CACHE_STACK_INFO(); + goto gotError; + /* * Exponentiation of zero by negative number in an expression. Control * only reaches this point by "goto exponOfZero". */ @@ -7209,16 +7674,15 @@ if (iPtr->execEnvPtr->rewind) { goto abnormalReturn; } if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; - size_t xxx1length; - bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL); DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, - bytes ? xxx1length : 0, pcBeg, tosPtr); + bytes ? length : 0, pcBeg, tosPtr); CACHE_STACK_INFO(); } iPtr->flags &= ~ERR_ALREADY_LOGGED; /* @@ -7322,11 +7786,11 @@ /* * end of infinite loop dispatching on instructions. */ /* - * Abnormal return code. Restore the stack to state it had when + * Done or abnormal return code. Restore the stack to state it had when * starting to execute the ByteCode. Panic if the stack is below the * initial level. */ abnormalReturn: @@ -7376,31 +7840,33 @@ */ instStartCmdFailed: { const char *bytes; - size_t xxx1length; - - checkInterp = 1; - xxx1length = 0; - - /* - * We used to switch to direct eval; for NRE-awareness we now - * compile and eval the command so that this evaluation does not - * add a new TEBC instance. [Bug 2910748] - */ + + length = 0; if (TclInterpReady(interp) == TCL_ERROR) { goto gotError; } + /* + * We used to switch to direct eval; for NRE-awareness we now + * compile and eval the command so that this evaluation does not + * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07] + * + * TODO: recompile, search this command and eval a code starting from, + * so that this evaluation does not add a new TEBC instance without + * NRE-trampoline. + */ + codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, NULL, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); assert(bytes); - PUSH_OBJECT(Tcl_NewStringObj(bytes, xxx1length)); + PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); goto instEvalStk; } } #undef codePtr @@ -7418,17 +7884,17 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - CallContext *contextPtr = data[1]; + CallContext *contextPtr = (CallContext *)data[1]; /* * Reset the variable lookup frame. */ - iPtr->varFramePtr = data[0]; + iPtr->varFramePtr = (CallFrame *)data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ @@ -7444,17 +7910,17 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - CallContext *contextPtr = data[1]; + CallContext *contextPtr = (CallContext *)data[1]; /* * Reset the variable lookup frame. */ - iPtr->varFramePtr = data[0]; + iPtr->varFramePtr = (CallFrame *)data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ @@ -7612,10 +8078,11 @@ Tcl_WideInt w1, w2, wResult; mp_int big1, big2, bigResult, bigRemainder; Tcl_Obj *objResultPtr; int invalid, zero; long shift; + mp_err err; (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); switch (opcode) { @@ -7668,18 +8135,23 @@ } Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); /* TODO: internals intrusion */ - if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) { + if ((w1 > ((Tcl_WideInt) 0)) ^ !mp_isneg(&big2)) { /* * Arguments are opposite sign; remainder is sum. */ - TclInitBignumFromWideInt(&big1, w1); - mp_add(&big2, &big1, &big2); - mp_clear(&big1); + err = mp_init_i64(&big1, w1); + if (err == MP_OKAY) { + err = mp_add(&big2, &big1, &big2); + mp_clear(&big1); + } + if (err != MP_OKAY) { + return OUT_OF_MEMORY; + } BIG_RESULT(&big2); } /* * Arguments are same sign; remainder is first operand. @@ -7688,25 +8160,31 @@ mp_clear(&big2); return NULL; } Tcl_GetBignumFromObj(NULL, valuePtr, &big1); Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); - mp_init(&bigResult); - mp_init(&bigRemainder); - mp_div(&big1, &big2, &bigResult, &bigRemainder); - if ((bigRemainder.used != 0) && (bigRemainder.sign != big2.sign)) { + err = mp_init_multi(&bigResult, &bigRemainder, NULL); + if (err == MP_OKAY) { + err = mp_div(&big1, &big2, &bigResult, &bigRemainder); + } + if ((err == MP_OKAY) && !mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* * Convert to Tcl's integer division rules. */ - mp_sub_d(&bigResult, 1, &bigResult); - mp_add(&bigRemainder, &big2, &bigRemainder); + if ((mp_sub_d(&bigResult, 1, &bigResult) != MP_OKAY) + || (mp_add(&bigRemainder, &big2, &bigRemainder) != MP_OKAY)) { + return OUT_OF_MEMORY; + } } - mp_copy(&bigRemainder, &bigResult); + err = mp_copy(&bigRemainder, &bigResult); mp_clear(&bigRemainder); mp_clear(&big1); mp_clear(&big2); + if (err != MP_OKAY) { + return OUT_OF_MEMORY; + } BIG_RESULT(&bigResult); case INST_LSHIFT: case INST_RSHIFT: { /* @@ -7717,11 +8195,11 @@ case TCL_NUMBER_INT: invalid = (*((const Tcl_WideInt *)ptr2) < 0); break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); - invalid = big2.sign != MP_ZPOS; + invalid = mp_isneg(&big2); mp_clear(&big2); break; default: /* Unused, here to silence compiler warning */ invalid = 0; @@ -7796,11 +8274,11 @@ case TCL_NUMBER_INT: zero = (*(const Tcl_WideInt *)ptr1 > 0); break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); - zero = (big1.sign == MP_ZPOS); + zero = !mp_isneg(&big1); mp_clear(&big1); break; default: /* Unused, here to silence compiler warning. */ zero = 0; @@ -7828,15 +8306,20 @@ } } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); - mp_init(&bigResult); - if (opcode == INST_LSHIFT) { - mp_mul_2d(&big1, shift, &bigResult); - } else { - mp_signed_rsh(&big1, shift, &bigResult); + err = mp_init(&bigResult); + if (err == MP_OKAY) { + if (opcode == INST_LSHIFT) { + err = mp_mul_2d(&big1, shift, &bigResult); + } else { + err = mp_signed_rsh(&big1, shift, &bigResult); + } + } + if (err != MP_OKAY) { + return OUT_OF_MEMORY; } mp_clear(&big1); BIG_RESULT(&bigResult); } @@ -7845,24 +8328,29 @@ case INST_BITAND: if ((type1 != TCL_NUMBER_INT) || (type2 != TCL_NUMBER_INT)) { Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); - mp_init(&bigResult); - - switch (opcode) { - case INST_BITAND: - mp_and(&big1, &big2, &bigResult); - break; - - case INST_BITOR: - mp_or(&big1, &big2, &bigResult); - break; - - case INST_BITXOR: - mp_xor(&big1, &big2, &bigResult); - break; + err = mp_init(&bigResult); + + if (err == MP_OKAY) { + switch (opcode) { + case INST_BITAND: + err = mp_and(&big1, &big2, &bigResult); + break; + + case INST_BITOR: + err = mp_or(&big1, &big2, &bigResult); + break; + + case INST_BITXOR: + err = mp_xor(&big1, &big2, &bigResult); + break; + } + } + if (err != MP_OKAY) { + return OUT_OF_MEMORY; } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); @@ -7920,13 +8408,13 @@ negativeExponent = (w2 < 0); oddExponent = (int) (w2 & (Tcl_WideInt)1); } else { Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); - negativeExponent = big2.sign != MP_ZPOS; - mp_mod_2d(&big2, 1, &big2); - oddExponent = big2.used != 0; + negativeExponent = mp_isneg(&big2); + err = mp_mod_2d(&big2, 1, &big2); + oddExponent = (err == MP_OKAY) && !mp_iszero(&big2); mp_clear(&big2); } if (type1 == TCL_NUMBER_INT) { w1 = *((const Tcl_WideInt *)ptr1); @@ -7986,11 +8474,11 @@ WIDE_RESULT(-1); } /* * We refuse to accept exponent arguments that exceed one mp_digit - * which means the max exponent value is 2**28-1 = 0x0fffffff = + * which means the max exponent value is 2**28-1 = 0x0FFFFFFF = * 268435455, which fits into a signed 32 bit int which is within the * range of the long int type. This means any numeric Tcl_Obj value * not using TCL_NUMBER_INT type must hold a value larger than we * accept. */ @@ -8079,12 +8567,17 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); - mp_init(&bigResult); - mp_expt_d_ex(&big1, w2, &bigResult, 1); + err = mp_init(&bigResult); + if (err == MP_OKAY) { + err = mp_expt_u32(&big1, (unsigned int)w2, &bigResult); + } + if (err != MP_OKAY) { + return OUT_OF_MEMORY; + } mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_ADD: @@ -8227,42 +8720,48 @@ } overflowBasic: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); - mp_init(&bigResult); + err = mp_init(&bigResult); + if (err == MP_OKAY) { switch (opcode) { case INST_ADD: - mp_add(&big1, &big2, &bigResult); - break; + err = mp_add(&big1, &big2, &bigResult); + break; case INST_SUB: - mp_sub(&big1, &big2, &bigResult); - break; + err = mp_sub(&big1, &big2, &bigResult); + break; case INST_MULT: - mp_mul(&big1, &big2, &bigResult); - break; + err = mp_mul(&big1, &big2, &bigResult); + break; case INST_DIV: - if (big2.used == 0) { - mp_clear(&big1); - mp_clear(&big2); - mp_clear(&bigResult); - return DIVIDED_BY_ZERO; - } - mp_init(&bigRemainder); - mp_div(&big1, &big2, &bigResult, &bigRemainder); - /* TODO: internals intrusion */ - if ((bigRemainder.used != 0) - && (bigRemainder.sign != big2.sign)) { - /* - * Convert to Tcl's integer division rules. - */ - - mp_sub_d(&bigResult, 1, &bigResult); - mp_add(&bigRemainder, &big2, &bigRemainder); - } - mp_clear(&bigRemainder); - break; + if (mp_iszero(&big2)) { + mp_clear(&big1); + mp_clear(&big2); + mp_clear(&bigResult); + return DIVIDED_BY_ZERO; + } + err = mp_init(&bigRemainder); + if (err == MP_OKAY) { + err = mp_div(&big1, &big2, &bigResult, &bigRemainder); + } + /* TODO: internals intrusion */ + if (!mp_iszero(&bigRemainder) + && (bigRemainder.sign != big2.sign)) { + /* + * Convert to Tcl's integer division rules. + */ + + err = mp_sub_d(&bigResult, 1, &bigResult); + if (err == MP_OKAY) { + err = mp_add(&bigRemainder, &big2, &bigRemainder); + } + } + mp_clear(&bigRemainder); + break; + } } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } @@ -8279,10 +8778,11 @@ ClientData ptr; int type; Tcl_WideInt w; mp_int big; Tcl_Obj *objResultPtr; + mp_err err = MP_OKAY; (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type); switch (opcode) { case INST_BITNOT: @@ -8290,12 +8790,17 @@ w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); } Tcl_TakeBignumFromObj(NULL, valuePtr, &big); /* ~a = - a - 1 */ - mp_neg(&big, &big); - mp_sub_d(&big, 1, &big); + err = mp_neg(&big, &big); + if (err == MP_OKAY) { + err = mp_sub_d(&big, 1, &big); + } + if (err != MP_OKAY) { + return OUT_OF_MEMORY; + } BIG_RESULT(&big); case INST_UMINUS: switch (type) { case TCL_NUMBER_DOUBLE: DOUBLE_RESULT(-(*((const double *) ptr))); @@ -8302,16 +8807,22 @@ case TCL_NUMBER_INT: w = *((const Tcl_WideInt *) ptr); if (w != WIDE_MIN) { WIDE_RESULT(-w); } - TclInitBignumFromWideInt(&big, w); + err = mp_init_i64(&big, w); + if (err != MP_OKAY) { + return OUT_OF_MEMORY; + } break; default: Tcl_TakeBignumFromObj(NULL, valuePtr, &big); } - mp_neg(&big, &big); + err = mp_neg(&big, &big); + if (err != MP_OKAY) { + return OUT_OF_MEMORY; + } BIG_RESULT(&big); } Tcl_Panic("unexpected opcode"); return NULL; @@ -8395,18 +8906,19 @@ } w2 = (Tcl_WideInt) d2; goto wideCompare; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); - if (big2.sign != MP_ZPOS) { + if (mp_isneg(&big2)) { compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); return compare; } + break; case TCL_NUMBER_DOUBLE: d1 = *((const double *)ptr1); switch (type2) { case TCL_NUMBER_DOUBLE: @@ -8432,11 +8944,11 @@ if (TclIsInfinite(d1)) { return (d1 > 0.0) ? MP_GT : MP_LT; } Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) { - if (big2.sign != MP_ZPOS) { + if (mp_isneg(&big2)) { compare = MP_GT; } else { compare = MP_LT; } mp_clear(&big2); @@ -8449,10 +8961,11 @@ goto doubleCompare; } Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } + break; case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { case TCL_NUMBER_INT: @@ -8485,14 +8998,15 @@ compare = mp_cmp(&big1, &big2); mp_clear(&big1); mp_clear(&big2); return compare; } + break; default: Tcl_Panic("unexpected number type"); - return TCL_ERROR; } + return TCL_ERROR; } #ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- @@ -8518,13 +9032,14 @@ * 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", - codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", + codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); + fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); fprintf(stdout, "\n Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, @@ -8546,11 +9061,11 @@ (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n", + " Proc 0x%p, refCt %d, args %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } } #endif /* TCL_COMPILE_DEBUG */ @@ -8598,18 +9113,18 @@ if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) { fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n", pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } - if ((unsigned) opCode >= LAST_INST_OPCODE) { + if ((unsigned) opCode > LAST_INST_OPCODE) { fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } if (checkStack && ((stackTop < 0) || (stackTop > stackUpperBound))) { - size_t numChars; + int numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)", stackTop, relativePc, stackUpperBound); if (cmd != NULL) { @@ -8656,20 +9171,29 @@ * with the illegal type. */ { ClientData ptr; int type; const unsigned char opcode = *pc; - const char *description, *operator = "unknown"; + const char *description, *op = "unknown"; if (opcode == INST_EXPON) { - operator = "**"; + op = "**"; } else if (opcode <= INST_LNOT) { - operator = operatorStrings[opcode - INST_BITOR]; + op = operatorStrings[opcode - INST_LOR]; } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - description = "non-numeric string"; + int numBytes; + const char *bytes = TclGetStringFromObj(opndPtr, &numBytes); + + if (numBytes == 0) { + description = "empty string"; + } else if (TclCheckBadOctal(NULL, bytes)) { + description = "invalid octal number"; + } else { + description = "non-numeric string"; + } } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { description = "floating-point value"; } else { @@ -8676,12 +9200,11 @@ /* TODO: No caller needs this. Eliminate? */ description = "(big) integer"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s \"%s\" as operand of \"%s\"", description, - TclGetString(opndPtr), operator)); + "can't use %s as operand of \"%s\"", description, op)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } /* *---------------------------------------------------------------------- @@ -8754,22 +9277,21 @@ * there find the list of word locations for this command. */ ExtCmdLoc *eclPtr; ECL *locPtr = NULL; - size_t srcOffset; - int i; + int srcOffset, i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } srcOffset = cfPtr->cmd - codePtr->source; - eclPtr = Tcl_GetHashValue(hePtr); + eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); for (i=0; i < eclPtr->nuloc; i++) { if (eclPtr->loc[i].srcOffset == srcOffset) { locPtr = eclPtr->loc+i; break; @@ -8801,32 +9323,32 @@ * return the closest command's source info. * This points within a bytecode instruction * in codePtr's code. */ ByteCode *codePtr, /* The bytecode sequence in which to look up * the command source for the pc. */ - size_t *lengthPtr, /* If non-NULL, the location where the length + int *lengthPtr, /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index * of the command containing the pc should * be stored. */ { - size_t pcOffset = (size_t)(pc - codePtr->codeStart); - size_t numCmds = codePtr->numCommands; + int pcOffset = (pc - codePtr->codeStart); + int numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; - size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; + int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ int bestCmdIdx = -1; /* The pc must point within the bytecode */ - assert (pcOffset < (size_t)codePtr->numCodeBytes); + assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes)); /* * Decode the code and source offset and length for each command. The * closest enclosing command is the last one whose code started before * pcOffset. @@ -8965,12 +9487,12 @@ * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; - size_t pcOffset = pc - codePtr->codeStart; - size_t start; + int pcOffset = pc - codePtr->codeStart; + int start; if (numRanges == 0) { return NULL; } @@ -9144,12 +9666,13 @@ double totalLiteralBytes, currentLiteralBytes; double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved; double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; size_t numCurrentByteCodes, numByteCodeLits; - size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length; + size_t refCountSum, literalMgmtBytes, sum; size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i; + int decadeHigh, length; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; #define Percent(a,b) ((a) * 100.0 / (b)) @@ -9187,12 +9710,12 @@ * Summary statistics, total and current source and ByteCode sizes. */ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, - "Compilation and execution statistics for interpreter %p\n", - iPtr); + "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n", + (size_t)iPtr); Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n", statsPtr->numExecutions); Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); @@ -9235,15 +9758,15 @@ currentCodeBytes); Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n", statsPtr->currentByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", currentLiteralBytes); - Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", - sizeof(LiteralTable), - iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), - iPtr->literalTable.numEntries * sizeof(LiteralEntry), - iPtr->literalTable.numEntries * sizeof(Tcl_Obj), + Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", + (unsigned long) sizeof(LiteralTable), + (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), + (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)), + (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)), statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", currentCodeBytes / statsPtr->currentSrcBytes); Tcl_AppendPrintfToObj(objPtr, " Code + source bytes\t\t%.6g (%0.1f mean code/src)\n", (currentCodeBytes + statsPtr->currentSrcBytes), @@ -9310,11 +9833,11 @@ Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n", (tclObjsAlloced - tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numLiteralsCreated); - Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n", + Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n", numByteCodeLits, Percent(numByteCodeLits, globalTablePtr->numEntries)); @@ -9402,18 +9925,18 @@ } sum = 0; for (i = 0; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n", litTableStats); - Tcl_Free(litTableStats); + ckfree(litTableStats); /* * Source and ByteCode size distributions. */ @@ -9434,11 +9957,11 @@ } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n"); @@ -9457,11 +9980,11 @@ } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to ms\t\tPercentage\n"); @@ -9489,11 +10012,11 @@ /* * Instruction counts. */ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); - for (i = 0; i < LAST_INST_OPCODE; i++) { + for (i = 0; i <= LAST_INST_OPCODE; i++) { Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n", Percent(statsPtr->instructionCount[i], numInstructions)); @@ -9502,11 +10025,11 @@ } } #ifdef TCL_MEM_DEBUG Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n"); - TclDumpMemoryInfo(objPtr, 1); + TclDumpMemoryInfo((ClientData) objPtr, 1); #endif Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); if (objc == 1) { Tcl_SetObjResult(interp, objPtr); Index: generic/tclFCmd.c ================================================================== --- generic/tclFCmd.c +++ generic/tclFCmd.c @@ -45,11 +45,11 @@ *--------------------------------------------------------------------------- */ int TclFileRenameCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interp for error reporting or recursive * calls in the case of a tricky rename. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { @@ -74,11 +74,11 @@ *--------------------------------------------------------------------------- */ int TclFileCopyCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Used for error reporting or recursive calls * in the case of a tricky copy. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { @@ -212,11 +212,11 @@ *---------------------------------------------------------------------- */ int TclFileMakeDirsCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Used for error reporting. */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { Tcl_Obj *errfile = NULL; @@ -336,11 +336,11 @@ *---------------------------------------------------------------------- */ int TclFileDeleteCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Used for error reporting */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { int i, force, result; @@ -944,11 +944,11 @@ *---------------------------------------------------------------------- */ int TclFileAttrsCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The interpreter for error reporting. */ int objc, /* Number of command line arguments. */ Tcl_Obj *const objv[]) /* The command line objects. */ { int result; @@ -1160,11 +1160,11 @@ *---------------------------------------------------------------------- */ int TclFileLinkCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *contents; @@ -1311,11 +1311,11 @@ *---------------------------------------------------------------------- */ int TclFileReadLinkCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *contents; @@ -1362,11 +1362,11 @@ *--------------------------------------------------------------------------- */ int TclFileTemporaryCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary @@ -1387,11 +1387,11 @@ if (objc > 1) { nameVarObj = objv[1]; TclNewObj(nameObj); } if (objc > 2) { - size_t length; + int length; Tcl_Obj *templateObj = objv[2]; const char *string = TclGetStringFromObj(templateObj, &length); /* * Treat an empty string as if it wasn't there. @@ -1521,11 +1521,11 @@ *--------------------------------------------------------------------------- */ int TclFileTempDirCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirNameObj; /* Object that will contain the directory Index: generic/tclFileName.c ================================================================== --- generic/tclFileName.c +++ generic/tclFileName.c @@ -384,11 +384,12 @@ int *driveNameLengthPtr, /* Returns length of drive, if non-NULL and * path was absolute */ Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; - const char *path = TclGetString(pathPtr); + int pathLen; + const char *path = TclGetStringFromObj(pathPtr, &pathLen); if (path[0] == '~') { /* * This case is common to all platforms. Paths that begin with ~ are * absolute. @@ -501,15 +502,15 @@ * Perform platform specific splitting. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: - resultPtr = SplitUnixPath(TclGetString(pathPtr)); + resultPtr = SplitUnixPath(Tcl_GetString(pathPtr)); break; case TCL_PLATFORM_WINDOWS: - resultPtr = SplitWinPath(TclGetString(pathPtr)); + resultPtr = SplitWinPath(Tcl_GetString(pathPtr)); break; } /* * Compute the number of elements in the result. @@ -534,11 +535,11 @@ * of path components. *argvPtr will be filled in with the address of an * array whose elements point to the elements of path, in order. * *argcPtr will get filled in with the number of valid elements in the * array. A single block of memory is dynamically allocated to hold both * the argv array and a copy of the path elements. The caller must - * eventually free this memory by calling Tcl_Free() on *argvPtr. Note: + * eventually free this memory by calling ckfree() on *argvPtr. Note: * *argvPtr and *argcPtr are only modified if the procedure returns * normally. * * Side effects: * Allocates memory. @@ -554,12 +555,11 @@ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to path elements. */ { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ Tcl_Obj *tmpPtr, *eltPtr; - int i; - size_t size, len; + int i, size, len; char *p; const char *str; /* * Perform the splitting, using objectified, vfs-aware code. @@ -576,20 +576,20 @@ */ size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); - (void)TclGetStringFromObj(eltPtr, &len); + TclGetStringFromObj(eltPtr, &len); size += len + 1; } /* * Allocate a buffer large enough to hold the contents of all of the list * plus the argv pointers and the terminating NULL pointer. */ - *argvPtr = Tcl_Alloc((((*argcPtr) + 1) * sizeof(char *)) + size); + *argvPtr = (const char **)ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size); /* * Position p after the last argv pointer and copy the contents of the * list in, piece by piece. */ @@ -640,11 +640,11 @@ static Tcl_Obj * SplitUnixPath( const char *path) /* Pointer to string containing a path. */ { - size_t length; + int length; const char *origPath = path, *elementStart; Tcl_Obj *result = Tcl_NewObj(); /* * Deal with the root directory as a special case. @@ -729,11 +729,11 @@ static Tcl_Obj * SplitWinPath( const char *path) /* Pointer to string containing a path. */ { - size_t length; + int length; const char *p, *elementStart; Tcl_PathType type = TCL_PATH_ABSOLUTE; Tcl_DString buf; Tcl_Obj *result = Tcl_NewObj(); Tcl_DStringInit(&buf); @@ -819,16 +819,16 @@ pair[0] = pathPtr; pair[1] = objv[0]; return TclJoinPath(2, pair, 0); } else { int elemc = objc + 1; - Tcl_Obj *ret, **elemv = Tcl_Alloc(elemc*sizeof(Tcl_Obj *)); + Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *)); ret = TclJoinPath(elemc, elemv, 0); - Tcl_Free(elemv); + ckfree(elemv); return ret; } } /* @@ -850,12 +850,11 @@ void TclpNativeJoinPath( Tcl_Obj *prefix, const char *joining) { - int needsSep; - size_t length; + int length, needsSep; char *dest; const char *p; const char *start; start = TclGetStringFromObj(prefix, &length); @@ -884,21 +883,21 @@ * Append a separator if needed. */ if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - (void)TclGetStringFromObj(prefix, &length); + TclGetStringFromObj(prefix, &length); } needsSep = 0; /* * Append the element, eliminating duplicate and trailing slashes. */ Tcl_SetObjLength(prefix, length + (int) strlen(p)); - dest = TclGetString(prefix) + length; + dest = Tcl_GetString(prefix) + length; for (; *p != '\0'; p++) { if (*p == '/') { while (p[1] == '/') { p++; } @@ -908,11 +907,11 @@ } else { *dest++ = *p; needsSep = 1; } } - length = dest - TclGetString(prefix); + length = dest - Tcl_GetString(prefix); Tcl_SetObjLength(prefix, length); break; case TCL_PLATFORM_WINDOWS: /* @@ -920,20 +919,20 @@ */ if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - (void)TclGetStringFromObj(prefix, &length); + TclGetStringFromObj(prefix, &length); } needsSep = 0; /* * Append the element, eliminating duplicate and trailing slashes. */ Tcl_SetObjLength(prefix, length + (int) strlen(p)); - dest = TclGetString(prefix) + length; + dest = Tcl_GetString(prefix) + length; for (; *p != '\0'; p++) { if ((*p == '/') || (*p == '\\')) { while ((p[1] == '/') || (p[1] == '\\')) { p++; } @@ -943,11 +942,11 @@ } else { *dest++ = *p; needsSep = 1; } } - length = dest - TclGetString(prefix); + length = dest - Tcl_GetString(prefix); Tcl_SetObjLength(prefix, length); break; } return; } @@ -975,12 +974,11 @@ Tcl_JoinPath( int argc, const char *const *argv, Tcl_DString *resultPtr) /* Pointer to previously initialized DString */ { - int i; - size_t len; + int i, len; Tcl_Obj *listObj = Tcl_NewObj(); Tcl_Obj *resultObj; const char *resultStr; /* @@ -1072,11 +1070,11 @@ * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - register char *p; + char *p; for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '/') { *p = '\\'; } } @@ -1217,14 +1215,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_GlobObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int index, i, globFlags, length, join, dir, result; @@ -1249,11 +1246,11 @@ dir = PATH_NONE; typePtr = NULL; for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { - string = TclGetString(objv[i]); + string = TclGetStringFromObj(objv[i], &length); if (string[0] == '-') { /* * It looks like the command contains an option so signal an * error. */ @@ -1344,11 +1341,11 @@ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } - separators = NULL; /* lint. */ + separators = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/"; break; case TCL_PLATFORM_WINDOWS: @@ -1355,11 +1352,11 @@ separators = "/\\:"; break; } if (dir == PATH_GENERAL) { - size_t pathlength; + int pathlength; const char *last; const char *first = TclGetStringFromObj(pathOrDir,&pathlength); /* * Find the last path separator in the path @@ -1407,11 +1404,11 @@ * a valid path like '/' or 'C:/' into an incorrect path like * '' or 'C:'. The way we do this is to add a separator if * there are none presently in the prefix. */ - if (strpbrk(TclGetString(pathOrDir), "\\/") == NULL) { + if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) { Tcl_AppendToObj(pathOrDir, last-1, 1); } } /* @@ -1449,18 +1446,18 @@ Tcl_ListObjLength(interp, typePtr, &length); if (length <= 0) { goto skipTypes; } - globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); + globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); globTypes->type = 0; globTypes->perm = 0; globTypes->macType = NULL; globTypes->macCreator = NULL; while (--length >= 0) { - size_t len; + int len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); str = TclGetStringFromObj(look, &len); if (strcmp("readonly", str) == 0) { @@ -1514,26 +1511,25 @@ globTypes->macType = look; Tcl_IncrRefCount(look); } else { Tcl_Obj *item; - int llen; - if ((Tcl_ListObjLength(NULL, look, &llen) == TCL_OK) - && (llen == 3)) { + if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) + && (len == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); - if (!strcmp("macintosh", TclGetString(item))) { + if (!strcmp("macintosh", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 1, &item); - if (!strcmp("type", TclGetString(item))) { + if (!strcmp("type", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macType != NULL) { goto badMacTypesArg; } globTypes->macType = item; Tcl_IncrRefCount(item); continue; - } else if (!strcmp("creator", TclGetString(item))) { + } else if (!strcmp("creator", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macCreator != NULL) { goto badMacTypesArg; } globTypes->macCreator = item; @@ -1549,11 +1545,11 @@ */ badTypesArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument to \"-types\": %s", - TclGetString(look))); + Tcl_GetString(look))); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); result = TCL_ERROR; join = 0; goto endOfGlob; @@ -1613,11 +1609,11 @@ } } Tcl_DStringFree(&str); } else { for (i = 0; i < objc; i++) { - string = TclGetString(objv[i]); + string = Tcl_GetString(objv[i]); if (TclGlob(interp, string, pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; goto endOfGlob; } @@ -1645,11 +1641,11 @@ } else { const char *sep = ""; for (i = 0; i < objc; i++) { Tcl_AppendPrintfToObj(errorMsg, "%s%s", - sep, TclGetString(objv[i])); + sep, Tcl_GetString(objv[i])); sep = " "; } } Tcl_AppendToObj(errorMsg, "\"", -1); Tcl_SetObjResult(interp, errorMsg); @@ -1681,13 +1677,12 @@ /* *---------------------------------------------------------------------- * * TclGlob -- * - * This procedure prepares arguments for the DoGlob call. It sets the - * separator string based on the platform, performs * tilde substitution, - * and calls DoGlob. + * Sets the separator string based on the platform, performs tilde + * substitution, and calls DoGlob. * * The interpreter's result, on entry to this function, must be a valid * Tcl list (e.g. it could be empty), since we will lappend any new * results to that list. If it is not a valid list, this function will * fail to do anything very meaningful. @@ -1706,11 +1701,10 @@ * The 'pattern' is written to. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int TclGlob( Tcl_Interp *interp, /* Interpreter for returning error message or * appending list of matching file names. */ char *pattern, /* Glob pattern to match. Must not refer to a @@ -1725,11 +1719,11 @@ const char *head; char *tail, *start; int result; Tcl_Obj *filenamesObj, *savedResultObj; - separators = NULL; /* lint. */ + separators = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/"; break; case TCL_PLATFORM_WINDOWS: @@ -1848,11 +1842,11 @@ if (cwd == NULL) { Tcl_DecrRefCount(temp); return TCL_ERROR; } - pathPrefix = Tcl_NewStringObj(TclGetString(cwd), 3); + pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3); Tcl_DecrRefCount(cwd); if (tail[0] == '/') { tail++; } else { tail += 2; @@ -1982,11 +1976,11 @@ */ if (globFlags & TCL_GLOBMODE_TAILS) { int objc, i; Tcl_Obj **objv; - size_t prefixLen; + int prefixLen; const char *pre; /* * If this length has never been set, set it here. */ @@ -2010,11 +2004,11 @@ } } Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { - size_t len; + int len; const char *oldStr = TclGetStringFromObj(objv[i], &len); Tcl_Obj *elem; if (len == prefixLen) { if ((pattern[0] == '\0') @@ -2059,11 +2053,11 @@ *---------------------------------------------------------------------- * * SkipToChar -- * * This function traverses a glob pattern looking for the next unquoted - * occurance of the specified character at the same braces nesting level. + * occurrence of the specified character at the same braces nesting level. * * Results: * Updates stringPtr to point to the matching character, or to the end of * the string if nothing matched. The return value is 1 if a match was * found at the top level, otherwise it is 0. @@ -2078,11 +2072,11 @@ SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; - register char *p; + char *p; quoted = 0; level = 0; for (p = *stringPtr; *p != '\0'; p++) { @@ -2342,11 +2336,11 @@ result = Tcl_ListObjGetElements(interp, subdirsPtr, &subdirc, &subdirv); for (i=0; result==TCL_OK && ist_blocks; #else - register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); + unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; #endif } +#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE unsigned Tcl_GetBlockSizeFromStat( const Tcl_StatBuf *statPtr) { -#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE return statPtr->st_blksize; +} #else +unsigned +Tcl_GetBlockSizeFromStat( + TCL_UNUSED(const Tcl_StatBuf *)) +{ /* * Not a great guess, but will do... */ return GUESSED_BLOCK_SIZE; -#endif } +#endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclFileSystem.h ================================================================== --- generic/tclFileSystem.h +++ generic/tclFileSystem.h @@ -28,11 +28,11 @@ MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr); MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, - const Tcl_Filesystem *fsPtr, void *clientData); + const Tcl_Filesystem *fsPtr, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); MODULE_SCOPE size_t TclFSEpoch(void); /* Index: generic/tclGet.c ================================================================== --- generic/tclGet.c +++ generic/tclGet.c @@ -140,11 +140,11 @@ code = TclSetBooleanFromAny(interp, &obj); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - *boolPtr = obj.internalRep.wideValue != 0; + TclGetBooleanFromObj(NULL, &obj, boolPtr); } return code; } /* Index: generic/tclGetDate.y ================================================================== --- generic/tclGetDate.y +++ generic/tclGetDate.y @@ -43,10 +43,18 @@ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ +/* + * Meridian: am, pm, or 24-hour style. + */ + +typedef enum _MERIDIAN { + MERam, MERpm, MER24 +} MERIDIAN; + /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ @@ -61,11 +69,11 @@ int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; - int dateMeridian; + MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; @@ -87,12 +95,12 @@ time_t *dateRelPointer; int dateDigitCount; } DateInfo; -#define YYMALLOC Tcl_Alloc -#define YYFREE(x) (Tcl_Free((void*) (x))) +#define YYMALLOC ckalloc +#define YYFREE(x) (ckfree((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) #define yyDayNumber (info->dateDayNumber) #define yyMonthOrdinal (info->dateMonthOrdinal) @@ -148,18 +156,10 @@ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; -/* - * Meridian: am, pm, or 24-hour style. - */ - -typedef enum _MERIDIAN { - MERam, MERpm, MER24 -} MERIDIAN; - %} %union { time_t Number; enum _MERIDIAN Meridian; @@ -763,13 +763,13 @@ static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { - register char *p; - register char *q; - register const TABLE *tp; + char *p; + char *q; + const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ @@ -888,12 +888,12 @@ TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { - register char c; - register char *p; + char c; + char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { @@ -958,20 +958,21 @@ } } int TclClockOldscanObjCmd( - void *clientData, /* Unused */ + void *dummy, /* Unused */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Count of paraneters */ Tcl_Obj *const *objv) /* Parameters */ { Tcl_Obj *result, *resultElement; int yr, mo, da; DateInfo dateInfo; DateInfo* info = &dateInfo; int status; + (void)dummy; if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "stringToParse baseYear baseMonth baseDay" ); return TCL_ERROR; @@ -1062,60 +1063,60 @@ result = Tcl_NewObj(); resultElement = Tcl_NewObj(); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyYear)); + Tcl_NewIntObj((int) yyYear)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyMonth)); + Tcl_NewIntObj((int) yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyDay)); + Tcl_NewIntObj((int) yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj( - ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian))); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) + ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); } resultElement = Tcl_NewObj(); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(-yyTimezone)); + Tcl_NewIntObj((int) -yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyRelMonth)); + Tcl_NewIntObj((int) yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyRelDay)); + Tcl_NewIntObj((int) yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyRelSeconds)); + Tcl_NewIntObj((int) yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyDayOrdinal)); + Tcl_NewIntObj((int) yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyDayNumber)); + Tcl_NewIntObj((int) yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyMonthOrdinal)); + Tcl_NewIntObj((int) yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj(yyMonth)); + Tcl_NewIntObj((int) yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); Tcl_SetObjResult(interp, result); return TCL_OK; Index: generic/tclHash.c ================================================================== --- generic/tclHash.c +++ generic/tclHash.c @@ -11,10 +11,17 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +/* + * Prevent macros from clashing with function definitions. + */ + +#undef Tcl_FindHashEntry +#undef Tcl_CreateHashEntry + /* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ @@ -26,11 +33,11 @@ * preliminary values that are arbitrarily similar will end up in different * buckets. The hash function was taken from a random-number generator. */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*(size_t)1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. */ @@ -104,11 +111,11 @@ *---------------------------------------------------------------------- */ void Tcl_InitHashTable( - register Tcl_HashTable *tablePtr, + Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType) /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an * integer >= 2. */ @@ -142,11 +149,11 @@ *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( - register Tcl_HashTable *tablePtr, + Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType, /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS, @@ -191,11 +198,11 @@ } /* *---------------------------------------------------------------------- * - * FindHashEntry -- + * Tcl_FindHashEntry -- * * Given a hash table find the entry with a matching key. * * Results: * The return value is a token for the matching entry in the hash table, @@ -204,10 +211,18 @@ * Side effects: * None. * *---------------------------------------------------------------------- */ + +Tcl_HashEntry * +Tcl_FindHashEntry( + Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ + const void *key) /* Key to use to find matching entry. */ +{ + return (*((tablePtr)->findProc))(tablePtr, (const char *)key); +} static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key) /* Key to use to find matching entry. */ @@ -217,11 +232,11 @@ /* *---------------------------------------------------------------------- * - * CreateHashEntry -- + * Tcl_CreateHashEntry -- * * Given a hash table with string keys, and a string key, find the entry * with a matching key. If there is no matching entry, then create a new * entry that does match. * @@ -234,22 +249,34 @@ * Side effects: * A new entry may be added to the hash table. * *---------------------------------------------------------------------- */ + +Tcl_HashEntry * +Tcl_CreateHashEntry( + Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ + const void *key, /* Key to use to find or create matching + * entry. */ + int *newPtr) /* Store info here telling whether a new entry + * was created. */ +{ + return (*((tablePtr)->createProc))(tablePtr, (const char *)key, newPtr); +} static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; - size_t hash, index; + unsigned int hash; + int index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; @@ -266,11 +293,11 @@ index = RANDOM_INDEX(tablePtr, hash); } else { index = hash & tablePtr->mask; } } else { - hash = (size_t) key; + hash = PTR2UINT(key); index = RANDOM_INDEX(tablePtr, hash); } /* * Search all of the entries in the appropriate bucket. @@ -279,11 +306,11 @@ if (typePtr->compareKeysProc) { Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != hPtr->hash) { + if (hash != PTR2UINT(hPtr->hash)) { continue; } /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) || compareKeysProc((void *) key, hPtr) @@ -295,11 +322,11 @@ } } } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != hPtr->hash) { + if (hash != PTR2UINT(hPtr->hash)) { continue; } if (key == hPtr->key.oneWordValue) { if (newPtr) { *newPtr = 0; @@ -319,17 +346,17 @@ *newPtr = 1; if (typePtr->allocEntryProc) { hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); } else { - hPtr = Tcl_Alloc(sizeof(Tcl_HashEntry)); + hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; - Tcl_SetHashValue(hPtr, NULL); + hPtr->clientData = 0; } hPtr->tablePtr = tablePtr; - hPtr->hash = hash; + hPtr->hash = UINT2PTR(hash); hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; tablePtr->numEntries++; /* @@ -363,15 +390,15 @@ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { - register Tcl_HashEntry *prevPtr; + Tcl_HashEntry *prevPtr; const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; - size_t index; + int index; tablePtr = entryPtr->tablePtr; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -384,13 +411,13 @@ typePtr = &tclArrayHashKeyType; } if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, entryPtr->hash); + index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); } else { - index = entryPtr->hash & tablePtr->mask; + index = PTR2UINT(entryPtr->hash) & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; if (*bucketPtr == entryPtr) { @@ -409,11 +436,11 @@ tablePtr->numEntries--; if (typePtr->freeEntryProc) { typePtr->freeEntryProc(entryPtr); } else { - Tcl_Free(entryPtr); + ckfree(entryPtr); } } /* *---------------------------------------------------------------------- @@ -432,15 +459,15 @@ *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( - register Tcl_HashTable *tablePtr) /* Table to delete. */ + Tcl_HashTable *tablePtr) /* Table to delete. */ { - register Tcl_HashEntry *hPtr, *nextPtr; + Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - size_t i; + int i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; @@ -460,11 +487,11 @@ while (hPtr != NULL) { nextPtr = hPtr->nextPtr; if (typePtr->freeEntryProc) { typePtr->freeEntryProc(hPtr); } else { - Tcl_Free(hPtr); + ckfree(hPtr); } hPtr = nextPtr; } } @@ -474,11 +501,11 @@ if (tablePtr->buckets != tablePtr->staticBuckets) { if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) tablePtr->buckets); } else { - Tcl_Free(tablePtr->buckets); + ckfree(tablePtr->buckets); } } /* * Arrange for panics if the table is used again without @@ -540,11 +567,11 @@ *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( - register Tcl_HashSearch *searchPtr) + Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. Must have been * initialized by calling * Tcl_FirstHashEntry. */ { @@ -585,13 +612,13 @@ char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - size_t count[NUM_COUNTERS], overflow, i, j; + int count[NUM_COUNTERS], overflow, i, j; double average, tmp; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; char *result, *p; /* * Compute a histogram of bucket usage. */ @@ -619,20 +646,20 @@ /* * Print out the histogram and a few other pieces of information. */ - result = Tcl_Alloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", + result = (char *)ckalloc((NUM_COUNTERS * 60) + 300); + sprintf(result, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", + sprintf(p, "number of buckets with %d entries: %d\n", i, count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n", + sprintf(p, "number of buckets with %d or more entries: %d\n", NUM_COUNTERS, overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); return result; } @@ -654,31 +681,31 @@ */ static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; - register int *iPtr1, *iPtr2; + int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; - size_t size; + unsigned int size; count = tablePtr->keyType; size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key); if (size < sizeof(Tcl_HashEntry)) { size = sizeof(Tcl_HashEntry); } - hPtr = Tcl_Alloc(size); + hPtr = (Tcl_HashEntry *)ckalloc(size); for (iPtr1 = array, iPtr2 = hPtr->key.words; count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } - Tcl_SetHashValue(hPtr, NULL); + hPtr->clientData = 0; return hPtr; } /* @@ -698,15 +725,15 @@ *---------------------------------------------------------------------- */ static int CompareArrayKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - const int *iPtr1 = keyPtr; - const int *iPtr2 = hPtr->key.words; + const int *iPtr1 = (const int *) keyPtr; + const int *iPtr2 = (const int *) hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { if (count == 0) { @@ -738,14 +765,14 @@ */ static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { - register const int *array = (const int *) keyPtr; - register TCL_HASH_TYPE result; + const int *array = (const int *) keyPtr; + TCL_HASH_TYPE result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; @@ -769,24 +796,25 @@ *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocStringEntry( - Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + TCL_UNUSED(Tcl_HashTable *), + void *keyPtr) /* Key to store in the hash table entry. */ { const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; size_t size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } - hPtr = Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize); + hPtr = (Tcl_HashEntry *)ckalloc(offsetof(Tcl_HashEntry, key) + allocsize); + memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key)); memcpy(hPtr->key.string, string, size); - Tcl_SetHashValue(hPtr, NULL); + hPtr->clientData = 0; return hPtr; } /* *---------------------------------------------------------------------- @@ -805,14 +833,17 @@ *---------------------------------------------------------------------- */ static int CompareStringKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - return !strcmp(keyPtr, hPtr->key.string); + const char *p1 = (const char *) keyPtr; + const char *p2 = (const char *) hPtr->key.string; + + return !strcmp(p1, p2); } /* *---------------------------------------------------------------------- * @@ -830,16 +861,16 @@ *---------------------------------------------------------------------- */ static TCL_HASH_TYPE HashStringKey( - Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + TCL_UNUSED(Tcl_HashTable *), + void *keyPtr) /* Key from which to compute hash value. */ { - register const char *string = keyPtr; - register TCL_HASH_TYPE result; - register char c; + const char *string = (const char *)keyPtr; + TCL_HASH_TYPE result; + char c; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose @@ -894,15 +925,14 @@ * Generates a panic. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static Tcl_HashEntry * BogusFind( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key) /* Key to use to find matching entry. */ + TCL_UNUSED(Tcl_HashTable *), + TCL_UNUSED(const char *)) { Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry"); return NULL; } @@ -921,18 +951,15 @@ * Generates a panic. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static Tcl_HashEntry * BogusCreate( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key, /* Key to use to find or create matching - * entry. */ - int *newPtr) /* Store info here telling whether a new entry - * was created. */ + TCL_UNUSED(Tcl_HashTable *), + TCL_UNUSED(const char *), + TCL_UNUSED(int *)) { Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry"); return NULL; } @@ -954,20 +981,20 @@ *---------------------------------------------------------------------- */ static void RebuildTable( - register Tcl_HashTable *tablePtr) /* Table to enlarge. */ + Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - size_t count, index, oldSize = tablePtr->numBuckets; + int count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; - register Tcl_HashEntry **oldChainPtr, **newChainPtr; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry **oldChainPtr, **newChainPtr; + Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ - if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) { + if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) { tablePtr->rebuildSize = INT_MAX; return; } if (tablePtr->keyType == TCL_STRING_KEYS) { @@ -986,24 +1013,22 @@ * constants for new array size. */ tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - tablePtr->buckets = TclpSysAlloc( - tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); + tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc( + tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0); } else { tablePtr->buckets = - Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); + (Tcl_HashEntry **)ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; } tablePtr->rebuildSize *= 4; - if (tablePtr->downShift > 1) { - tablePtr->downShift -= 2; - } + tablePtr->downShift -= 2; tablePtr->mask = (tablePtr->mask << 2) + 3; /* * Rehash all of the existing entries into the new bucket array. */ @@ -1011,13 +1036,13 @@ for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) { for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) { *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, hPtr->hash); + index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); } else { - index = hPtr->hash & tablePtr->mask; + index = PTR2UINT(hPtr->hash) & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; } } @@ -1028,11 +1053,11 @@ if (oldBuckets != tablePtr->staticBuckets) { if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) oldBuckets); } else { - Tcl_Free(oldBuckets); + ckfree(oldBuckets); } } } /* Index: generic/tclHistory.c ================================================================== --- generic/tclHistory.c +++ generic/tclHistory.c @@ -59,11 +59,11 @@ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { - register Tcl_Obj *cmdPtr; + Tcl_Obj *cmdPtr; int result; if (cmd[0]) { /* * Call Tcl_RecordAndEvalObj to do the actual work. @@ -71,10 +71,17 @@ cmdPtr = Tcl_NewStringObj(cmd, -1); Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); + /* + * Move the interpreter's object result to the string result, then + * reset the object result. + */ + + (void) Tcl_GetStringResult(interp); + /* * Discard the Tcl object created to hold the command. */ Tcl_DecrRefCount(cmdPtr); @@ -121,18 +128,18 @@ * current procedure. */ { int result, call = 1; Tcl_CmdInfo info; HistoryObjs *histObjsPtr = - Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL); + (HistoryObjs *)Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL); /* * Create the references to the [::history add] command if necessary. */ if (histObjsPtr == NULL) { - histObjsPtr = Tcl_Alloc(sizeof(HistoryObjs)); + histObjsPtr = (HistoryObjs *)ckalloc(sizeof(HistoryObjs)); TclNewLiteralStringObj(histObjsPtr->historyObj, "::history"); TclNewLiteralStringObj(histObjsPtr->addObj, "add"); Tcl_IncrRefCount(histObjsPtr->historyObj); Tcl_IncrRefCount(histObjsPtr->addObj); Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs, @@ -202,21 +209,21 @@ */ static void DeleteHistoryObjs( ClientData clientData, - Tcl_Interp *interp) + TCL_UNUSED(Tcl_Interp *)) { - register HistoryObjs *histObjsPtr = clientData; + HistoryObjs *histObjsPtr = (HistoryObjs *)clientData; TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); - Tcl_Free(histObjsPtr); + ckfree(histObjsPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclIO.c ================================================================== --- generic/tclIO.c +++ generic/tclIO.c @@ -189,25 +189,23 @@ Channel *chanPtr, int mask); static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan); static void DiscardInputQueued(ChannelState *statePtr, int discardSavedBuffers); static void DiscardOutputQueued(ChannelState *chanPtr); -static int DoRead(Channel *chanPtr, char *dst, size_t bytesToRead, +static int DoRead(Channel *chanPtr, char *dst, int bytesToRead, int allowShortReads); -static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t toRead, +static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead, int appendFlag); static int FilterInputBytes(Channel *chanPtr, GetsState *statePtr); static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush); static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); -static Tcl_Encoding GetBinaryEncoding(); -static void FreeBinaryEncoding(ClientData clientData); +static Tcl_Encoding GetBinaryEncoding(void); +static Tcl_ExitProc FreeBinaryEncoding; static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp); static int GetInput(Channel *chanPtr); -static int HaveVersion(const Tcl_ChannelType *typePtr, - Tcl_ChannelTypeVersion minimumVersion); static void PeekAhead(Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr); static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft); static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr, @@ -237,11 +235,11 @@ * Simplifying helper macros. All may use their argument(s) multiple times. * The ANSI C "prototypes" for the macros are listed below, together with a * short description of what the macro does. * * -------------------------------------------------------------------------- - * size_t BytesLeft(ChannelBuffer *bufPtr) + * int BytesLeft(ChannelBuffer *bufPtr) * * Returns the number of bytes of data remaining in the buffer. * * int SpaceLeft(ChannelBuffer *bufPtr) * @@ -275,13 +273,13 @@ * Returns a pointer to where characters should be removed from the * buffer. * -------------------------------------------------------------------------- */ -#define BytesLeft(bufPtr) ((size_t)((bufPtr)->nextAdded - (bufPtr)->nextRemoved)) +#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved) -#define SpaceLeft(bufPtr) ((size_t)((bufPtr)->bufLength - (bufPtr)->nextAdded)) +#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded) #define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved) #define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved) @@ -348,11 +346,11 @@ #define ChanGetIntRep(objPtr, resPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &chanObjType); \ - (resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) #define BUSY_STATE(st, fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) @@ -374,24 +372,16 @@ static inline int ChanClose( Channel *chanPtr, Tcl_Interp *interp) { - if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { +#ifndef TCL_NO_DEPRECATED + if ((chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) && (chanPtr->typePtr->closeProc != NULL)) { return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp); - } else { - return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); - } -} - -static inline int -ChanCloseHalf( - Channel *chanPtr, - Tcl_Interp *interp, - int flags) -{ - return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags); + } +#endif + return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); } /* *--------------------------------------------------------------------------- * @@ -438,11 +428,11 @@ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (WillRead(chanPtr) == -1) { + if (WillRead(chanPtr) < 0) { return -1; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, &result); @@ -454,20 +444,11 @@ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (bytesRead == -1) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - SetFlag(chanPtr->state, CHANNEL_BLOCKED); - result = EAGAIN; - } - Tcl_SetErrno(result); - } else if (bytesRead == 0) { - SetFlag(chanPtr->state, CHANNEL_EOF); - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; - } else { + if (bytesRead > 0) { /* * If we get a short read, signal up that we may be BLOCKED. We should * avoid calling the driver because on some platforms we will block in * the low level reading code even though the channel is set into * nonblocking mode. @@ -474,10 +455,19 @@ */ if (bytesRead < dstSize) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); } + } else if (bytesRead == 0) { + SetFlag(chanPtr->state, CHANNEL_EOF); + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; + } else if (bytesRead < 0) { + if ((result == EWOULDBLOCK) || (result == EAGAIN)) { + SetFlag(chanPtr->state, CHANNEL_BLOCKED); + result = EAGAIN; + } + Tcl_SetErrno(result); } return bytesRead; } static inline Tcl_WideInt @@ -490,23 +480,27 @@ /* * Note that we prefer the wideSeekProc if that field is available in the * type and non-NULL. */ - if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && - chanPtr->typePtr->wideSeekProc != NULL) { - return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData, - offset, mode, errnoPtr); - } - - if (offsetLONG_MAX) { - *errnoPtr = EOVERFLOW; - return -1; - } - - return chanPtr->typePtr->seekProc(chanPtr->instanceData, - offset, mode, errnoPtr); + if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) { +#ifndef TCL_NO_DEPRECATED + if (offsetLONG_MAX) { + *errnoPtr = EOVERFLOW; + return -1; + } + + return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, + offset, mode, errnoPtr); +#else + *errnoPtr = EINVAL; + return -1; +#endif + } + + return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, + offset, mode, errnoPtr); } static inline void ChanThreadAction( Channel *chanPtr, @@ -583,11 +577,10 @@ * Depends on encoding and memory subsystems. * *------------------------------------------------------------------------- */ - /* ARGSUSED */ void TclFinalizeIOSubsystem(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel *chanPtr = NULL; /* Iterates over open channels. */ @@ -671,11 +664,11 @@ */ statePtr->refCount--; } - if (statePtr->refCount + 1 <= 1) { + if (statePtr->refCount <= 0) { /* * Close it only if the refcount indicates that the channel is * not referenced from any interpreter. If it is, that * interpreter will close the channel when it gets destroyed. */ @@ -858,11 +851,11 @@ * callback. */ { ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr; - cbPtr = Tcl_Alloc(sizeof(CloseCallback)); + cbPtr = (CloseCallback *)ckalloc(sizeof(CloseCallback)); cbPtr->proc = proc; cbPtr->clientData = clientData; cbPtr->nextPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr; @@ -904,11 +897,11 @@ if (cbPrevPtr == NULL) { statePtr->closeCbPtr = cbPtr->nextPtr; } else { cbPrevPtr->nextPtr = cbPtr->nextPtr; } - Tcl_Free(cbPtr); + ckfree(cbPtr); break; } cbPrevPtr = cbPtr; } } @@ -937,13 +930,13 @@ Tcl_Interp *interp) { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_Channel stdinChan, stdoutChan, stderrChan; - hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL); + hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { - hTblPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclIO", (Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr); /* @@ -1007,14 +1000,14 @@ /* * Delete all the registered channels - this will close channels whose * refcount reaches zero. */ - hTblPtr = clientData; + hTblPtr = (Tcl_HashTable *)clientData; for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) { - chanPtr = Tcl_GetHashValue(hPtr); + chanPtr = (Channel *)Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; /* * Remove any fileevents registered in this interpreter. */ @@ -1031,11 +1024,11 @@ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - Tcl_Free(sPtr); + ckfree(sPtr); } else { prevPtr = sPtr; } } @@ -1054,11 +1047,11 @@ } } } Tcl_DeleteHashTable(hTblPtr); - Tcl_Free(hTblPtr); + ckfree(hTblPtr); } /* *---------------------------------------------------------------------- * @@ -1089,27 +1082,27 @@ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->stdinInitialized == 1 && tsdPtr->stdinChannel != NULL && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) { - if (statePtr->refCount + 1 < 3) { + if (statePtr->refCount < 2) { statePtr->refCount = 0; tsdPtr->stdinChannel = NULL; return; } } else if (tsdPtr->stdoutInitialized == 1 && tsdPtr->stdoutChannel != NULL && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) { - if (statePtr->refCount + 1 < 3) { + if (statePtr->refCount < 2) { statePtr->refCount = 0; tsdPtr->stdoutChannel = NULL; return; } } else if (tsdPtr->stderrInitialized == 1 && tsdPtr->stderrChannel != NULL && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) { - if (statePtr->refCount + 1 < 3) { + if (statePtr->refCount < 2) { statePtr->refCount = 0; tsdPtr->stderrChannel = NULL; return; } } @@ -1267,11 +1260,11 @@ /* * If the refCount reached zero, close the actual channel. */ - if (statePtr->refCount + 1 <= 1) { + if (statePtr->refCount <= 0) { Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* * We don't want to re-enter Tcl_Close(). */ @@ -1377,11 +1370,11 @@ chanPtr = ((Channel *) chan)->state->bottomChanPtr; statePtr = chanPtr->state; if (interp != NULL) { - hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL); + hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); if (hPtr == NULL) { @@ -1480,11 +1473,11 @@ * Always return bottom-most channel in the stack. This one lives the * longest - other channels may go away unnoticed. The other APIs * compensate where necessary to retrieve the topmost channel again. */ - chanPtr = Tcl_GetHashValue(hPtr); + chanPtr = (Channel *)Tcl_GetHashValue(hPtr); chanPtr = chanPtr->state->bottomChanPtr; if (modePtr != NULL) { *modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE); } @@ -1519,11 +1512,11 @@ Tcl_Channel *channelPtr, int *modePtr, /* Where to store the mode in which the * channel was opened? Will contain an ORed * combination of TCL_READABLE and * TCL_WRITABLE, if non-NULL. */ - int flags) + TCL_UNUSED(int) /*flags*/) { ChannelState *statePtr; ResolvedChanName *resPtr = NULL; Tcl_Channel chan; @@ -1540,12 +1533,12 @@ statePtr = resPtr->statePtr; if ((resPtr->interp == interp) /* Same interp context */ /* No epoch change in channel since lookup */ && (resPtr->epoch == statePtr->epoch)) { /* - * Have a valid saved lookup. Jump to end to return it. - */ + * Have a valid saved lookup. Jump to end to return it. + */ goto valid; } } @@ -1561,19 +1554,19 @@ if (resPtr && resPtr->refCount == 1) { /* * Re-use the ResolvedCmdName struct. */ - Tcl_Release(resPtr->statePtr); + Tcl_Release((ClientData) resPtr->statePtr); } else { - resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName)); + resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); resPtr->refCount = 0; ChanSetIntRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; - Tcl_Preserve(statePtr); + Tcl_Preserve((ClientData) statePtr); resPtr->interp = interp; resPtr->epoch = statePtr->epoch; valid: *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr; @@ -1626,33 +1619,44 @@ * as well. */ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); assert(typePtr->typeName != NULL); - if (NULL == typePtr->closeProc) { - Tcl_Panic("channel type %s must define closeProc", typePtr->typeName); +#ifndef TCL_NO_DEPRECATED + if (((NULL == typePtr->closeProc) || (TCL_CLOSE2PROC == typePtr->closeProc)) && (typePtr->close2Proc == NULL)) { + Tcl_Panic("channel type %s must define closeProc or close2Proc", typePtr->typeName); } +#else + if (Tcl_ChannelVersion(typePtr) < TCL_CHANNEL_VERSION_5) { + Tcl_Panic("channel type %s must be version TCL_CHANNEL_VERSION_5", typePtr->typeName); + } + if (typePtr->close2Proc == NULL) { + Tcl_Panic("channel type %s must define close2Proc", typePtr->typeName); + } +#endif if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) { Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName); } if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) { Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName); } if (NULL == typePtr->watchProc) { Tcl_Panic("channel type %s must define watchProc", typePtr->typeName); } - if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { +#ifndef TCL_NO_DEPRECATED + if ((NULL != typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName); } +#endif /* * JH: We could subsequently memset these to 0 to avoid the numerous * assignments to 0/NULL below. */ - chanPtr = Tcl_Alloc(sizeof(Channel)); - statePtr = Tcl_Alloc(sizeof(ChannelState)); + chanPtr = (Channel *)ckalloc(sizeof(Channel)); + statePtr = (ChannelState *)ckalloc(sizeof(ChannelState)); chanPtr->state = statePtr; chanPtr->instanceData = instanceData; chanPtr->typePtr = typePtr; @@ -1667,14 +1671,14 @@ /* * Make sure we allocate at least 7 bytes, so it fits for "stdout" * later. */ - tmp = Tcl_Alloc((len < 7) ? 7 : len); + tmp = (char *)ckalloc((len < 7) ? 7 : len); strcpy(tmp, chanName); } else { - tmp = Tcl_Alloc(7); + tmp = (char *)ckalloc(7); tmp[0] = '\0'; } statePtr->channelName = tmp; statePtr->flags = mask; @@ -1943,11 +1947,11 @@ statePtr->inQueueHead = NULL; statePtr->inQueueTail = NULL; } - chanPtr = Tcl_Alloc(sizeof(Channel)); + chanPtr = (Channel *)ckalloc(sizeof(Channel)); /* * Save some of the current state into the new structure, reinitialize the * parts which will stay with the transformation. * @@ -2005,20 +2009,20 @@ } if (--chanPtr->refCount) { return; } if (chanPtr->typePtr == NULL) { - Tcl_Free(chanPtr); + ckfree(chanPtr); } } static void ChannelFree( Channel *chanPtr) { - if (!chanPtr->refCount) { - Tcl_Free(chanPtr); + if (chanPtr->refCount == 0) { + ckfree(chanPtr); return; } chanPtr->typePtr = NULL; } @@ -2185,11 +2189,11 @@ /* * This channel does not cover another one. Simply do a close, if * necessary. */ - if (statePtr->refCount + 1 <= 1) { + if (statePtr->refCount <= 0) { if (Tcl_Close(interp, chan) != TCL_OK) { /* * TIP #219, Tcl Channel Reflection API. * "TclChanCaughtErrorBypass" is not required here, it was * done already by "Tcl_Close". @@ -2472,11 +2476,11 @@ { ChannelBuffer *bufPtr; int n; n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; - bufPtr = Tcl_Alloc(n); + bufPtr = (ChannelBuffer *)ckalloc(n); bufPtr->nextAdded = BUFFER_PADDING; bufPtr->nextRemoved = BUFFER_PADDING; bufPtr->bufLength = length + BUFFER_PADDING; bufPtr->nextPtr = NULL; bufPtr->refCount = 1; @@ -2485,11 +2489,11 @@ static void PreserveChannelBuffer( ChannelBuffer *bufPtr) { - if (!bufPtr->refCount) { + if (bufPtr->refCount == 0) { Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); } bufPtr->refCount++; } @@ -2498,18 +2502,18 @@ ChannelBuffer *bufPtr) { if (--bufPtr->refCount) { return; } - Tcl_Free(bufPtr); + ckfree(bufPtr); } static int IsShared( ChannelBuffer *bufPtr) { - return bufPtr->refCount + 1 > 2; + return bufPtr->refCount > 1; } /* *---------------------------------------------------------------------- * @@ -2878,13 +2882,13 @@ DiscardOutputQueued(statePtr); ReleaseChannelBuffer(bufPtr); break; } else { /* - * TODO: Consider detecting and reacting to short writes on + * TODO: Consider detecting and reacting to short writes on * blocking channels. Ought not happen. See iocmd-24.2. - */ + */ wroteSome = 1; } bufPtr->nextRemoved += written; @@ -2925,11 +2929,11 @@ * write in this call, and we've completed the BG flush. * These are the two cases above. If we get here, that means * there is some kind failure in the writable event machinery. * * The tls extension indeed suffers from flaws in its channel - * event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca. + * event mgmt. See https://core.tcl-lang.org/tcl/info/c31ca233ca. * Until that patch is broadly distributed, disable the * assertion checking here, so that programs using Tcl and * tls can be debugged. assert(!calledFromAsyncFlush); @@ -2941,11 +2945,11 @@ * If the channel is flagged as closed, delete it when the refCount drops * to zero, the output queue is empty and there is no output in the * current output buffer. */ - if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount + 1 <= 1) && + if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannel(interp, chanPtr, errorCode); goto done; @@ -3077,11 +3081,11 @@ * closed. All the other channels in the stack are not allowed to remove. */ if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { - Tcl_Free(statePtr->channelName); + ckfree(statePtr->channelName); statePtr->channelName = NULL; } Tcl_FreeEncoding(statePtr->encoding); } @@ -3213,10 +3217,13 @@ /* * TIP #218, Channel Thread Actions */ ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE); + + /* Channel is not managed by any thread */ + statePtr->managingThread = NULL; } void Tcl_CutChannel( Tcl_Channel chan) /* The channel being added. Must not be @@ -3257,10 +3264,13 @@ */ for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) { ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE); } + + /* Channel is not managed by any thread */ + statePtr->managingThread = NULL; } /* *---------------------------------------------------------------------- * @@ -3371,11 +3381,10 @@ * the channel record removed, in CloseChannel, above. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_Close( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan) /* The channel being closed. Must not be * referenced in any interpreter. */ @@ -3382,11 +3391,11 @@ { CloseCallback *cbPtr; /* Iterate over close callbacks for this * channel. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ - int result; /* Of calling FlushChannel. */ + int result = 0; /* Of calling FlushChannel. */ int flushcode; int stickyError; if (chan == NULL) { return TCL_OK; @@ -3408,11 +3417,11 @@ chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; - if (statePtr->refCount + 1 > 1) { + if (statePtr->refCount > 0) { Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { @@ -3473,26 +3482,34 @@ while (statePtr->closeCbPtr != NULL) { cbPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr->nextPtr; cbPtr->proc(cbPtr->clientData); - Tcl_Free(cbPtr); + ckfree(cbPtr); } ResetFlag(statePtr, CHANNEL_INCLOSE); /* * If this channel supports it, close the read side, since we don't need * it anymore and this will help avoid deadlocks on some channel types. */ - if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) { - result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, - TCL_CLOSE_READ); - } else { +#ifndef TCL_NO_DEPRECATED + if ((chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) || (chanPtr->typePtr->closeProc == NULL)) { + /* If this half-close gives a EINVAL or ENOTCONN, just continue the full close */ + result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); + if ((result == EINVAL) || result == ENOTCONN) { + result = 0; + } + } +#else + result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); + if ((result == EINVAL) || result == ENOTCONN) { result = 0; } +#endif /* * The call to FlushChannel will flush any queued output and invoke the * close function of the channel driver, or it will set up the channel to * be flushed and closed asynchronously. @@ -3531,17 +3548,21 @@ /* * Bug 97069ea11a: set error message if a flush code is set and no error * message set up to now. */ - if (flushcode != 0 && interp != NULL + if (flushcode != 0) { + /* flushcode has precedence, if available */ + result = flushcode; + } + if ((result != 0) && (result != TCL_ERROR) && (interp != NULL) && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { - Tcl_SetErrno(flushcode); + Tcl_SetErrno(result); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } - if ((flushcode != 0) || (result != 0)) { + if (result != 0) { return TCL_ERROR; } return TCL_OK; } @@ -3548,28 +3569,25 @@ /* *---------------------------------------------------------------------- * * Tcl_CloseEx -- * - * Closes one side of a channel, read or write. + * Closes one side of a channel, read or write, close all. * * Results: * A standard Tcl result. * * Side effects: - * Closes one direction of the channel. + * Closes one direction of the channel, or do a full close. * * NOTE: * Tcl_CloseEx closes the specified direction of the channel as far as - * the user is concerned. The channel keeps existing however. You cannot - * calls this function to close the last possible direction of the - * channel. Use Tcl_Close for that. + * the user is concerned. If flags = 0, this is equivalent to Tcl_Close. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_CloseEx( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan, /* The channel being closed. May still be used * by some interpreter. */ @@ -3580,22 +3598,30 @@ if (chan == NULL) { return TCL_OK; } - /* TODO: assert flags validity ? */ - chanPtr = (Channel *) chan; statePtr = chanPtr->state; + + if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) { + return Tcl_Close(interp, chan); + } + if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "double-close of channels not supported by %ss", + chanPtr->typePtr->typeName)); + return TCL_ERROR; + } /* * Does the channel support half-close anyway? Error if not. */ if (!chanPtr->typePtr->close2Proc) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "half-close of channels not supported by %ss", + "half-close of channels not supported by %ss", chanPtr->typePtr->typeName)); return TCL_ERROR; } /* @@ -3827,11 +3853,11 @@ * Finally do what is asked of us. Close and free the channel driver state * for the chosen side of the channel. This may leave a TIP #219 error * message in the interp. */ - result = ChanCloseHalf(chanPtr, interp, flags); + result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, NULL, flags); /* * If we are being called synchronously, report either any latent error on * the channel or the current error. */ @@ -3943,11 +3969,11 @@ * Remove all the channel handler records attached to the channel itself. */ for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) { chNext = chPtr->nextPtr; - Tcl_Free(chPtr); + ckfree(chPtr); } statePtr->chPtr = NULL; /* * Cancel any pending copy operation. @@ -3970,11 +3996,11 @@ */ for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) { eNextPtr = ePtr->nextPtr; TclDecrRefCount(ePtr->scriptPtr); - Tcl_Free(ePtr); + ckfree(ePtr); } statePtr->scriptRecordPtr = NULL; } /* @@ -3989,25 +4015,25 @@ * the specified channel to the topmost channel in a stack. * * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or TCL_IO_FAILURE in case of error. If - * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. + * The number of bytes written or -1 in case of error. If -1, + * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ -size_t +int Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - size_t srcLen) /* Length of data in bytes, or -1 for + int srcLen) /* Length of data in bytes, or < 0 for * strlen(). */ { /* * Always use the topmost channel of the stack */ @@ -4017,18 +4043,18 @@ statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return TCL_IO_FAILURE; + return -1; } - if (srcLen == TCL_AUTO_LENGTH) { + if (srcLen < 0) { srcLen = strlen(src); } - if (WriteBytes(chanPtr, src, srcLen) == -1) { - return TCL_IO_FAILURE; + if (WriteBytes(chanPtr, src, srcLen) < 0) { + return -1; } return srcLen; } /* @@ -4043,48 +4069,47 @@ * compensate for stacking. * * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or TCL_IO_FAILURE in case of error. If - * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. + * The number of bytes written or -1 in case of error. If -1, + * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ -size_t +int Tcl_WriteRaw( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - size_t srcLen) /* Length of data in bytes, or -1 for + int srcLen) /* Length of data in bytes, or < 0 for * strlen(). */ { Channel *chanPtr = ((Channel *) chan); ChannelState *statePtr = chanPtr->state; /* State info for channel */ - int errorCode; - size_t written; + int errorCode, written; if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { - return TCL_IO_FAILURE; + return -1; } - if (srcLen == TCL_AUTO_LENGTH) { + if (srcLen < 0) { srcLen = strlen(src); } /* * Go immediately to the driver, do all the error handling by ourselves. * The code was stolen from 'FlushChannel'. */ written = ChanWrite(chanPtr, src, srcLen, &errorCode); - if (written == TCL_IO_FAILURE) { + if (written < 0) { Tcl_SetErrno(errorCode); } return written; } @@ -4100,40 +4125,40 @@ * ready e.g. if it contains a newline and we are in line buffering * mode. Compensates stacking, i.e. will redirect the data from the * specified channel to the topmost channel in a stack. * * Results: - * The number of bytes written or TCL_IO_FAILURE in case of error. If - * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. + * The number of bytes written or -1 in case of error. If -1, + * Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the * channel. * *---------------------------------------------------------------------- */ -size_t +int Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - size_t len) /* Length of string in bytes, or -1 for + int len) /* Length of string in bytes, or < 0 for * strlen(). */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ int result; Tcl_Obj *objPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return TCL_IO_FAILURE; + return -1; } chanPtr = statePtr->topChanPtr; - if (len == TCL_AUTO_LENGTH) { + if (len < 0) { len = strlen(src); } if (statePtr->encoding) { return WriteChars(chanPtr, src, len); } @@ -4148,11 +4173,11 @@ if ((len == 1) && (UCHAR(*src) < 0xC0)) { return WriteBytes(chanPtr, src, len); } objPtr = Tcl_NewStringObj(src, len); - src = (char *) TclGetByteArrayFromObj(objPtr, &len); + src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); result = WriteBytes(chanPtr, src, len); TclDecrRefCount(objPtr); return result; } @@ -4179,11 +4204,11 @@ * channel. * *---------------------------------------------------------------------- */ -size_t +int Tcl_WriteObj( Tcl_Channel chan, /* The channel to buffer output for. */ Tcl_Obj *objPtr) /* The object to write. */ { /* @@ -4191,20 +4216,20 @@ */ Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ const char *src; - size_t srcLen = 0; + int srcLen; statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return TCL_IO_FAILURE; + return -1; } if (statePtr->encoding == NULL) { - src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen); + src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); return WriteBytes(chanPtr, src, srcLen); } else { src = TclGetStringFromObj(objPtr, &srcLen); return WriteChars(chanPtr, src, srcLen); } @@ -4214,34 +4239,40 @@ WillWrite( Channel *chanPtr) { int inputBuffered; - if ((chanPtr->typePtr->seekProc != NULL) && - ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ - int ignore; + if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) +#ifndef TCL_NO_DEPRECATED + || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) +#endif + ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ + int ignore; - DiscardInputQueued(chanPtr->state, 0); - ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore); + DiscardInputQueued(chanPtr->state, 0); + ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore); } } static int WillRead( Channel *chanPtr) { if (chanPtr->typePtr == NULL) { /* - * Prevent read attempts on a closed channel. - */ + * Prevent read attempts on a closed channel. + */ - DiscardInputQueued(chanPtr->state, 0); + DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } - if ((chanPtr->typePtr->seekProc != NULL) - && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { + if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) +#ifndef TCL_NO_DEPRECATED + || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) +#endif + ) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a * seekable channel, we assume it is not one that can block and force * bg flushing. Channels we know that can do that - sockets, pipes - @@ -4248,13 +4279,13 @@ * are not seekable. If the assumption is wrong, more drastic measures * may be required here like temporarily setting the channel into * blocking mode. */ - if (FlushChannel(NULL, chanPtr, 0) != 0) { - return -1; - } + if (FlushChannel(NULL, chanPtr, 0) != 0) { + return -1; + } } return 0; } /* @@ -4300,11 +4331,11 @@ endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); if (GotFlag(statePtr, CHANNEL_LINEBUFFERED) || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) { - nextNewLine = memchr(src, '\n', srcLen); + nextNewLine = (char *)memchr(src, '\n', srcLen); } while (srcLen + saved + endEncoding > 0) { ChannelBuffer *bufPtr; char *dst, safe[BUFFER_PADDING]; @@ -4338,19 +4369,19 @@ statePtr->outputEncodingFlags, &statePtr->outputEncodingState, dst, dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); /* - * See chan-io-1.[89]. Tcl Bug 506297. - */ + * See chan-io-1.[89]. Tcl Bug 506297. + */ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { /* - * We're reading from invalid/incomplete UTF-8. - */ + * We're reading from invalid/incomplete UTF-8. + */ ReleaseChannelBuffer(bufPtr); if (total == 0) { Tcl_SetErrno(EINVAL); return -1; @@ -4398,11 +4429,11 @@ src++; srcLen--; total += dstWrote; dst += dstWrote; dstLen -= dstWrote; - nextNewLine = memchr(src, '\n', srcLen); + nextNewLine = (char *)memchr(src, '\n', srcLen); needNlFlush = 1; } if (IsBufferOverflowing(bufPtr)) { /* @@ -4411,11 +4442,11 @@ * the output buffer, so that we would get a completely full * buffer before flushing it. The extra bytes will be moved to the * beginning of the next buffer. */ - saved = 1 + ~SpaceLeft(bufPtr); + saved = -SpaceLeft(bufPtr); memcpy(safe, dst + dstLen, saved); bufPtr->nextAdded = bufPtr->bufLength; } if ((srcLen + saved == 0) && (result == TCL_OK)) { @@ -4475,24 +4506,24 @@ * the channel. * *--------------------------------------------------------------------------- */ -size_t +int Tcl_Gets( Tcl_Channel chan, /* Channel from which to read. */ Tcl_DString *lineRead) /* The line read will be appended to this * DString as UTF-8 characters. The caller * must have initialized it and is responsible * for managing the storage. */ { Tcl_Obj *objPtr; - size_t charsStored; + int charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); - if (charsStored + 1 > 1) { + if (charsStored > 0) { TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); return charsStored; } @@ -4518,11 +4549,11 @@ * leave channel pointing after EOL, but don't return EOL in dst buffer. * *--------------------------------------------------------------------------- */ -size_t +int Tcl_GetsObj( Tcl_Channel chan, /* Channel from which to read. */ Tcl_Obj *objPtr) /* The line read will be appended to this * object as UTF-8 characters. */ { @@ -4529,18 +4560,17 @@ GetsState gs; Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; - size_t oldLength; + int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return TCL_IO_FAILURE; + return -1; } /* * If we're sitting ready to read the eofchar, there's no need to * do it. @@ -4551,11 +4581,11 @@ assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: Do we need this? */ UpdateInterest(chanPtr); - return TCL_IO_FAILURE; + return -1; } /* * A binary version of Tcl_GetsObj. This could also handle encodings that * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion @@ -4581,11 +4611,11 @@ /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ - (void)TclGetStringFromObj(objPtr, &oldLength); + TclGetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; if (bufPtr != NULL) { oldRemoved = bufPtr->nextRemoved; @@ -4678,11 +4708,11 @@ * LF at the begining of the next buffer, unless EOF char * was found already. */ if (eol >= dstEnd) { - size_t offset; + int offset; if (eol != eof) { offset = eol - objPtr->bytes; dst = dstEnd; if (FilterInputBytes(chanPtr, &gs) != 0) { @@ -4712,23 +4742,23 @@ if ((eol < dstEnd) && (*eol == '\n')) { /* * Skip the raw bytes that make up the '\n'. */ - char tmp[TCL_UTF_MAX]; int rawRead; + char tmp[TCL_UTF_MAX]; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, - TCL_UTF_MAX, &rawRead, NULL, NULL); + sizeof(tmp), &rawRead, NULL, NULL); bufPtr->nextRemoved += rawRead; gs.rawRead -= rawRead; gs.bytesWrote--; gs.charsWrote--; - memmove(dst, dst + 1, dstEnd - dst); + memmove(dst, dst + 1, (size_t) (dstEnd - dst)); dstEnd--; } } for (eol = dst; eol < dstEnd; eol++) { if (*eol == '\r') { @@ -4945,13 +4975,12 @@ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; - size_t rawLen, byteLen = 0, oldLength; - int eolChar; + int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; + int rawLen, byteLen, eolChar; unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* * This operation should occur at the top of a channel stack. */ @@ -4964,11 +4993,11 @@ /* * Preserved so we can restore the channel's state in case we don't find a * newline in the available input. */ - byteArray = TclGetByteArrayFromObj(objPtr, &byteLen); + byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); oldFlags = statePtr->inputEncodingFlags; oldRemoved = BUFFER_PADDING; oldLength = byteLen; if (bufPtr != NULL) { oldRemoved = bufPtr->nextRemoved; @@ -5199,11 +5228,11 @@ *--------------------------------------------------------------------------- */ static void FreeBinaryEncoding( - ClientData dummy) /* Not used */ + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->binaryEncoding != NULL) { Tcl_FreeEncoding(tsdPtr->binaryEncoding); @@ -5210,11 +5239,11 @@ tsdPtr->binaryEncoding = NULL; } } static Tcl_Encoding -GetBinaryEncoding() +GetBinaryEncoding(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->binaryEncoding == NULL) { tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); @@ -5407,11 +5436,11 @@ bufPtr->nextPtr = nextPtr; statePtr->inQueueTail = nextPtr; } extra = rawLen - gsPtr->rawRead; memcpy(nextPtr->buf + (BUFFER_PADDING - extra), - raw + gsPtr->rawRead, extra); + raw + gsPtr->rawRead, (size_t) extra); nextPtr->nextRemoved -= extra; bufPtr->nextAdded -= extra; } } @@ -5587,15 +5616,15 @@ * May cause input to be buffered. * *---------------------------------------------------------------------- */ -size_t +int Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - size_t bytesToRead) /* Maximum number of bytes to read. */ + int bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -5604,11 +5633,11 @@ */ chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return TCL_IO_FAILURE; + return -1; } return DoRead(chanPtr, dst, bytesToRead, 0); } @@ -5632,39 +5661,39 @@ * May cause input to be buffered. * *---------------------------------------------------------------------- */ -size_t +int Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ - size_t bytesToRead) /* Maximum number of bytes to read. */ + int bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ int copied = 0; assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { - return TCL_IO_FAILURE; + return -1; } /* * First read bytes from the push-back buffers. */ while (chanPtr->inQueueHead && bytesToRead > 0) { ChannelBuffer *bufPtr = chanPtr->inQueueHead; int bytesInBuffer = BytesLeft(bufPtr); - int toCopy = (bytesInBuffer < (int)bytesToRead) ? bytesInBuffer - : (int)bytesToRead; + int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer + : bytesToRead; /* - * Copy the current chunk into the read buffer. - */ + * Copy the current chunk into the read buffer. + */ memcpy(readBuf, RemovePoint(bufPtr), toCopy); bufPtr->nextRemoved += toCopy; copied += toCopy; readBuf += toCopy; @@ -5699,11 +5728,17 @@ */ if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); - if (nread == -1) { + if (nread > 0) { + /* + * Successful read (short is OK) - add to bytes copied. + */ + + copied += nread; + } else if (nread < 0) { /* * An error signaled. If CHANNEL_BLOCKED, then the error is not * real, but an indication of blocked state. In that case, retain * the flag and let caller receive the short read of copied bytes * from the pushback. HOWEVER, if copied==0 bytes from pushback @@ -5713,16 +5748,10 @@ */ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } - } else if (nread > 0) { - /* - * Successful read (short is OK) - add to bytes copied. - */ - - copied += nread; } else { /* * nread == 0. Driver is at EOF. Let that state filter up. */ } @@ -5750,15 +5779,15 @@ * May cause input to be buffered. * *--------------------------------------------------------------------------- */ -size_t +int Tcl_ReadChars( Tcl_Channel chan, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ - size_t toRead, /* Maximum number of characters to store, or + int toRead, /* Maximum number of characters to store, or * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, * the data will replace the existing contents @@ -5810,11 +5839,11 @@ static int DoReadChars( Channel *chanPtr, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ - size_t toRead, /* Maximum number of characters to store, or + int toRead, /* Maximum number of characters to store, or * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, * the data will replace the existing contents @@ -5831,11 +5860,15 @@ binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); - if (appendFlag == 0) { + if (appendFlag) { + if (binaryMode && (NULL == TclGetBytesFromObj(NULL, objPtr, NULL))) { + binaryMode = 0; + } + } else { if (binaryMode) { Tcl_SetByteArrayLength(objPtr, 0); } else { Tcl_SetObjLength(objPtr, 0); @@ -5896,11 +5929,11 @@ if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - for (copied = 0; toRead > 0; ) { + for (copied = 0; (unsigned) toRead > 0; ) { copiedNow = -1; if (statePtr->inQueueHead != NULL) { if (binaryMode) { copiedNow = ReadBytes(statePtr, objPtr, toRead); } else { @@ -6014,11 +6047,11 @@ Tcl_Obj *objPtr, /* Input data is appended to this ByteArray * object. Its length is how much space has * been allocated to hold data, not how many * bytes of data have been stored in the * object. */ - int bytesToRead) /* Maximum number of bytes to store, or -1 to + int bytesToRead) /* Maximum number of bytes to store, or < 0 to * get all available bytes. Bytes are obtained * from the first buffer in the queue - even * if this number is larger than the number of * bytes available in the first buffer, only * the bytes from the first buffer are @@ -6091,12 +6124,11 @@ Tcl_EncodingState savedState = statePtr->inputEncodingState; ChannelBuffer *bufPtr = statePtr->inQueueHead; int savedIEFlags = statePtr->inputEncodingFlags; int savedFlags = statePtr->flags; char *dst, *src = RemovePoint(bufPtr); - size_t numBytes; - int srcLen = BytesLeft(bufPtr); + int numBytes, srcLen = BytesLeft(bufPtr); /* * One src byte can yield at most one character. So when the number of * src bytes we plan to read is less than the limit on character count to * be read, clearly we will remain within that limit, and we can use the @@ -6115,11 +6147,11 @@ int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; (void) TclGetStringFromObj(objPtr, &numBytes); Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { - size_t size; + unsigned int size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; } else { dst = TclGetString(objPtr) + numBytes; @@ -6267,12 +6299,12 @@ * char from that alone. We have to know what's next. So why do * we only have the one decoded char? */ if (code != TCL_OK) { - char buffer[TCL_UTF_MAX + 1]; int read, decoded, count; + char buffer[TCL_UTF_MAX + 1]; /* * Didn't get everything the buffer could offer */ @@ -6284,11 +6316,11 @@ || BytesLeft(bufPtr->nextPtr) == 0 || 0 == (statePtr->inputEncodingFlags & TCL_ENCODING_END)); Tcl_ExternalToUtf(NULL, encoding, src, srcLen, (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE), - &statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1, + &statePtr->inputEncodingState, buffer, sizeof(buffer), &read, &decoded, &count); if (count == 2) { if (buffer[1] == '\n') { /* \r\n translate to \n */ @@ -6354,12 +6386,12 @@ if (dstWrote == 0) { ChannelBuffer *nextPtr; /* - * We were not able to read any chars. - */ + * We were not able to read any chars. + */ assert(numChars == 0); /* * There is one situation where this is the correct final result. @@ -6375,11 +6407,11 @@ goto consume; } /* - * Otherwise, reading zero characters indicates there's something + * Otherwise, reading zero characters indicates there's something * incomplete at the end of the src buffer. Maybe there were not * enough src bytes to decode into a char. Maybe a lone \r could * not be translated (crlf mode). Need to combine any unused src * bytes we have in the first buffer with subsequent bytes to try * again. @@ -6484,21 +6516,21 @@ switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: case TCL_TRANSLATE_CR: if (srcLen > dstLen) { - /* - * In these modes, each src byte become a dst byte. - */ + /* + * In these modes, each src byte become a dst byte. + */ srcLen = dstLen; } break; default: /* - * In other modes, at most 2 src bytes become a dst byte. - */ + * In other modes, at most 2 src bytes become a dst byte. + */ if (srcLen/2 > dstLen) { srcLen = 2 * dstLen; } break; @@ -6508,11 +6540,11 @@ /* * Make sure we do not read past any logical end of channel input * created by the presence of the input eof char. */ - if ((eof = memchr(srcStart, inEofChar, srcLen))) { + if ((eof = (const char *)memchr(srcStart, inEofChar, srcLen))) { srcLen = eof - srcStart; } } switch (statePtr->inputTranslation) { @@ -6523,11 +6555,11 @@ } if (statePtr->inputTranslation == TCL_TRANSLATE_CR) { char *dst = dstStart; char *dstEnd = dstStart + srcLen; - while ((dst = memchr(dst, '\r', dstEnd - dst))) { + while ((dst = (char *)memchr(dst, '\r', dstEnd - dst))) { *dst++ = '\n'; } } dstLen = srcLen; break; @@ -6534,11 +6566,11 @@ case TCL_TRANSLATE_CRLF: { const char *crFound, *src = srcStart; char *dst = dstStart; int lesser = (dstLen < srcLen) ? dstLen : srcLen; - while ((crFound = memchr(src, '\r', lesser))) { + while ((crFound = (const char *)memchr(src, '\r', lesser))) { int numBytes = crFound - src; memmove(dst, src, numBytes); dst += numBytes; dstLen -= numBytes; src += numBytes; srcLen -= numBytes; @@ -6574,11 +6606,11 @@ if ((statePtr->flags & INPUT_SAW_CR) && srcLen) { if (*src == '\n') { src++; srcLen--; } ResetFlag(statePtr, INPUT_SAW_CR); } lesser = (dstLen < srcLen) ? dstLen : srcLen; - while ((crFound = memchr(src, '\r', lesser))) { + while ((crFound = (const char *)memchr(src, '\r', lesser))) { int numBytes = crFound - src; memmove(dst, src, numBytes); dst[numBytes] = '\n'; dst += numBytes + 1; dstLen -= numBytes + 1; @@ -6621,23 +6653,23 @@ * * Causes the supplied string to be added to the input queue of the * channel, at either the head or tail of the queue. * * Results: - * The number of bytes stored in the channel, or TCL_IO_FAILURE on error. + * The number of bytes stored in the channel, or -1 on error. * * Side effects: * Adds input to the input queue of a channel. * *---------------------------------------------------------------------- */ -size_t +int Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ - size_t len, /* The length of the input. */ + int len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of actual channel. */ @@ -6657,11 +6689,11 @@ * CheckChannelErrors clears too many flag bits in this one case. */ flags = statePtr->flags; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - len = TCL_IO_FAILURE; + len = -1; goto done; } statePtr->flags = flags; /* @@ -6999,11 +7031,15 @@ /* * Disallow seek on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ - if (chanPtr->typePtr->seekProc == NULL) { + if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) +#ifndef TCL_NO_DEPRECATED + && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) +#endif + ) { Tcl_SetErrno(EINVAL); return -1; } /* @@ -7163,11 +7199,15 @@ /* * Disallow tell on channels whose type does not have a seek procedure * defined. This means that the channel does not support seeking. */ - if (chanPtr->typePtr->seekProc == NULL) { + if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) +#ifndef TCL_NO_DEPRECATED + && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) +#endif + ) { Tcl_SetErrno(EINVAL); return -1; } /* @@ -7249,11 +7289,11 @@ * pre-read input data. */ WillWrite(chanPtr); - if (WillRead(chanPtr) == -1) { + if (WillRead(chanPtr) < 0) { return TCL_ERROR; } /* * We're all flushed to disk now and we also don't have any unfortunate @@ -7482,11 +7522,11 @@ for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { - register ChannelBuffer *curOutPtr = statePtr->curOutPtr; + ChannelBuffer *curOutPtr = statePtr->curOutPtr; if (IsBufferReady(curOutPtr)) { bytesBuffered += BytesLeft(curOutPtr); } } @@ -7677,11 +7717,11 @@ Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); } Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); - Tcl_Free((void *)argv); + ckfree(argv); } Tcl_SetErrno(EINVAL); return TCL_ERROR; } @@ -8068,11 +8108,11 @@ if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: must be non-NUL ASCII" " character", -1)); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } if (GotFlag(statePtr, TCL_READABLE)) { statePtr->inEofChar = inValue; } @@ -8083,15 +8123,15 @@ if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: should be a list of zero," " one, or two elements", -1)); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } if (argv != NULL) { - Tcl_Free((void *)argv); + ckfree(argv); } /* * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character * which signals eof can transform a current eof condition into a 'go @@ -8121,11 +8161,11 @@ if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be a one or two" " element list", -1)); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } if (readMode) { TclEolTranslation translation; @@ -8151,11 +8191,11 @@ if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } /* * Reset the EOL flags since we need to look at any buffered data @@ -8201,15 +8241,15 @@ if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_OK; } else if (chanPtr->typePtr->setOptionProc != NULL) { return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp, optionName, newValue); } else { @@ -8264,11 +8304,11 @@ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - Tcl_Free(sPtr); + ckfree(sPtr); } else { prevPtr = sPtr; } } } @@ -8356,10 +8396,17 @@ * Preserve the channel struct in case the script closes it. */ TclChannelPreserve((Tcl_Channel)channel); Tcl_Preserve(statePtr); + + /* + * Avoid processing if the channel owner has been changed. + */ + if (statePtr->managingThread != Tcl_GetCurrentThread()) { + goto done; + } /* * If we are flushing in the background, be sure to call FlushChannel for * writable events. Note that we have to discard the writable event so we * don't call any write handlers before the flush is complete. @@ -8391,10 +8438,17 @@ chPtr->proc(chPtr->clientData, chPtr->mask & mask); chPtr = nh.nextHandlerPtr; } else { chPtr = chPtr->nextPtr; } + + /* + * Stop if the channel owner has been changed in-between. + */ + if (chanPtr->state->managingThread != Tcl_GetCurrentThread()) { + goto done; + } } /* * Update the notifier interest, since it may have changed after invoking * event handlers. Skip that if the channel was deleted in the call to the @@ -8408,10 +8462,11 @@ * UpdateInterest() call, one would think. */ UpdateInterest(chanPtr); } +done: Tcl_Release(statePtr); TclChannelRelease(channel); tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; } @@ -8546,11 +8601,11 @@ static void ChannelTimerProc( ClientData clientData) { - Channel *chanPtr = clientData; + Channel *chanPtr = (Channel *)clientData; ChannelState *statePtr = chanPtr->state; /* State info for channel */ Tcl_Preserve(statePtr); statePtr->timer = NULL; @@ -8634,11 +8689,11 @@ (chPtr->clientData == clientData)) { break; } } if (chPtr == NULL) { - chPtr = Tcl_Alloc(sizeof(ChannelHandler)); + chPtr = (ChannelHandler *)ckalloc(sizeof(ChannelHandler)); chPtr->mask = 0; chPtr->proc = proc; chPtr->clientData = clientData; chPtr->chanPtr = chanPtr; chPtr->nextPtr = statePtr->chPtr; @@ -8738,11 +8793,11 @@ if (prevChPtr == NULL) { statePtr->chPtr = chPtr->nextPtr; } else { prevChPtr->nextPtr = chPtr->nextPtr; } - Tcl_Free(chPtr); + ckfree(chPtr); /* * Recompute the interest list for the channel, so that infinite loops * will not result if Tcl_DeleteChannelHandler is called inside an event. */ @@ -8797,11 +8852,11 @@ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); TclDecrRefCount(esPtr->scriptPtr); - Tcl_Free(esPtr); + ckfree(esPtr); break; } } } @@ -8846,11 +8901,11 @@ } makeCH = (esPtr == NULL); if (makeCH) { - esPtr = Tcl_Alloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); } /* * Initialize the structure before calling Tcl_CreateChannelHandler, * because a reflected channel calling 'chan postevent' aka @@ -8893,23 +8948,27 @@ */ void TclChannelEventScriptInvoker( ClientData clientData, /* The script+interp record. */ - int mask) /* Not used. */ + TCL_UNUSED(int) /*mask*/) { - Tcl_Interp *interp; /* Interpreter in which to eval the script. */ - Channel *chanPtr; /* The channel for which this handler is + EventScriptRecord *esPtr = (EventScriptRecord *)clientData; + /* The event script + interpreter to eval it + * in. */ + Channel *chanPtr = esPtr->chanPtr; + /* The channel for which this handler is * registered. */ - EventScriptRecord *esPtr; /* The event script + interpreter to eval it - * in. */ + Tcl_Interp *interp = esPtr->interp; + /* Interpreter in which to eval the script. */ + int mask = esPtr->mask; int result; /* Result of call to eval script. */ - esPtr = clientData; - chanPtr = esPtr->chanPtr; - mask = esPtr->mask; - interp = esPtr->interp; + /* + * Be sure event executed in managed channel (covering bugs similar [f583715154]). + */ + assert(chanPtr->state->managingThread == Tcl_GetCurrentThread()); /* * We must preserve the interpreter so we can report errors on it later. * Note that we do not need to preserve the channel because that is done * by Tcl_NotifyChannel before calling channel handlers. @@ -8954,14 +9013,13 @@ * May create a channel handler for the specified channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_FileEventObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which the channel for which * to create the handler is found. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { @@ -9056,11 +9114,11 @@ ClientData clientData) { /* calling CopyData with mask==0 still implies immediate invocation of the * -command callback, and completion of the fcopy. */ - CopyData(clientData, 0); + CopyData((CopyState *)clientData, 0); } /* *---------------------------------------------------------------------- * @@ -9079,10 +9137,24 @@ * May schedule a background copy operation that causes both channels to * be marked busy. * *---------------------------------------------------------------------- */ + +#if !defined(TCL_NO_DEPRECATED) +int +TclCopyChannelOld( + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Channel inChan, /* Channel to read from. */ + Tcl_Channel outChan, /* Channel to write to. */ + int toRead, /* Amount of data to copy, or -1 for all. */ + Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ +{ + return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, + cmdPtr); +} +#endif int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ @@ -9162,11 +9234,11 @@ * Allocate a new CopyState to maintain info about the current copy in * progress. This structure will be deallocated when the copy is * completed. */ - csPtr = Tcl_Alloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); + csPtr = (CopyState *)ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; @@ -9456,12 +9528,11 @@ { Tcl_Interp *interp; Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL; Tcl_Channel inChan, outChan; ChannelState *inStatePtr, *outStatePtr; - int result = TCL_OK, size; - size_t sizeb; + int result = TCL_OK, size, sizeb; Tcl_WideInt total; const char *buffer; int inBinary, outBinary, sameEncoding; /* Encoding control */ int underflow; /* Input underflow */ @@ -9523,21 +9594,21 @@ if ((csPtr->toRead == (Tcl_WideInt) -1) || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { - sizeb = csPtr->toRead; + sizeb = (int) csPtr->toRead; } if (inBinary || sameEncoding) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); } - underflow = (size >= 0) && ((size_t)size < sizeb); /* Input underflow */ + underflow = (size >= 0) && (size < sizeb); /* Input underflow */ } if (size < 0) { readError: if (interp) { @@ -9575,12 +9646,12 @@ csPtr); } if (size == 0) { if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) { /* - * We allowed a short read. Keep trying. - */ + * We allowed a short read. Keep trying. + */ continue; } if (bufObj != NULL) { TclDecrRefCount(bufObj); @@ -9617,11 +9688,11 @@ * to 'size' (It can be smaller or larger, in the latter case able to * drive toRead below -1, causing infinite looping). Completely * unsuitable for updating totals and toRead. */ - if (sizeb == TCL_AUTO_LENGTH) { + if (sizeb < 0) { writeError: if (interp) { TclNewObj(errObj); Tcl_AppendStringsToObj(errObj, "error writing \"", Tcl_GetChannelName(outChan), "\": ", NULL); @@ -9785,15 +9856,17 @@ static int DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - size_t bytesToRead, /* Maximum number of bytes to read. */ + int bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; + + assert(bytesToRead >= 0); /* * Early out when we know a read will get the eofchar. * * NOTE: This seems to be a bug. The special handling for @@ -9844,11 +9917,11 @@ * Don't read more data if we have what we need. */ while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ - ((size_t)BytesLeft(bufPtr) < bytesToRead))) { + (BytesLeft(bufPtr) < bytesToRead))) { /* Not enough bytes in it yet * to fill the dst */ int code; moreData: @@ -9857,20 +9930,20 @@ assert(bufPtr != NULL); if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) { /* - * Further reads cannot do any more. - */ + * Further reads cannot do any more. + */ break; } if (code) { /* - * Read error - */ + * Read error + */ UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return -1; } @@ -9918,41 +9991,41 @@ assert(RemovePoint(bufPtr)[0] == '\r'); assert(BytesLeft(bufPtr) == 1); if (bufPtr->nextPtr == NULL) { /* - * There's no more buffered data... - */ + * There's no more buffered data... + */ if (statePtr->flags & CHANNEL_EOF) { /* - * ...and there never will be. - */ + * ...and there never will be. + */ *p++ = '\r'; bytesToRead--; bufPtr->nextRemoved++; } else if (statePtr->flags & CHANNEL_BLOCKED) { /* - * ...and we cannot get more now. - */ + * ...and we cannot get more now. + */ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); break; } else { /* - * ...so we need to get some. - */ + * ...so we need to get some. + */ goto moreData; } } if (bufPtr->nextPtr) { /* - * There's a next buffer. Shift orphan \r to it. - */ + * There's a next buffer. Shift orphan \r to it. + */ ChannelBuffer *nextPtr = bufPtr->nextPtr; nextPtr->nextRemoved -= 1; RemovePoint(nextPtr)[0] = '\r'; @@ -10019,11 +10092,11 @@ static void CopyEventProc( ClientData clientData, int mask) { - (void) CopyData(clientData, mask); + (void) CopyData((CopyState *)clientData, mask); } /* *---------------------------------------------------------------------- * @@ -10088,11 +10161,11 @@ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); TclDecrRefCount(csPtr->cmdPtr); } inStatePtr->csPtrR = NULL; outStatePtr->csPtrW = NULL; - Tcl_Free(csPtr); + ckfree(csPtr); } /* *---------------------------------------------------------------------- * @@ -10352,11 +10425,11 @@ */ chanPtr = ((Channel *) chan)->state->bottomChanPtr; statePtr = chanPtr->state; - hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL); + hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { return 0; } hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); if (hPtr == NULL) { @@ -10390,11 +10463,11 @@ Tcl_Channel chan) /* The channel to query */ { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ - return ((statePtr->refCount + 1 > 2) ? 1 : 0); + return ((statePtr->refCount > 1) ? 1 : 0); } /* *---------------------------------------------------------------------- * @@ -10434,11 +10507,11 @@ } else { name = statePtr->channelName; } if ((*chanName == *name) && - (memcmp(name, chanName, chanNameLen + 1) == 0)) { + (memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) { return 1; } } return 0; @@ -10486,53 +10559,21 @@ Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) { - return TCL_CHANNEL_VERSION_2; - } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) { - return TCL_CHANNEL_VERSION_3; - } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) { - return TCL_CHANNEL_VERSION_4; - } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_5) { - return TCL_CHANNEL_VERSION_5; - } else { +#ifndef TCL_NO_DEPRECATED + if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2) + || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) { /* * In = (PTR2INT(minimumVersion)); +#endif + return chanTypePtr->version; } /* *---------------------------------------------------------------------- * @@ -10551,19 +10592,19 @@ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { - return chanTypePtr->blockModeProc; - } - - /* - * The v1 structure had the blockModeProc in a different place. - */ - - return (Tcl_DriverBlockModeProc *) chanTypePtr->version; +#ifndef TCL_NO_DEPRECATED + if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { + /* + * The v1 structure had the blockModeProc in a different place. + */ + return (Tcl_DriverBlockModeProc *) chanTypePtr->version; + } +#endif + return chanTypePtr->blockModeProc; } /* *---------------------------------------------------------------------- * @@ -10578,17 +10619,19 @@ * None. * *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->closeProc; } +#endif /* *---------------------------------------------------------------------- * * Tcl_ChannelClose2Proc -- @@ -10674,17 +10717,19 @@ * None. * *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { return chanTypePtr->seekProc; } +#endif /* *---------------------------------------------------------------------- * * Tcl_ChannelSetOptionProc -- @@ -10799,14 +10844,16 @@ Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { - return chanTypePtr->flushProc; +#ifndef TCL_NO_DEPRECATED + if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { + return NULL; } - return NULL; +#endif + return chanTypePtr->flushProc; } /* *---------------------------------------------------------------------- * @@ -10826,14 +10873,16 @@ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) { - return chanTypePtr->handlerProc; +#ifndef TCL_NO_DEPRECATED + if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { + return NULL; } - return NULL; +#endif + return chanTypePtr->handlerProc; } /* *---------------------------------------------------------------------- * @@ -10853,14 +10902,16 @@ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) { - return chanTypePtr->wideSeekProc; +#ifndef TCL_NO_DEPRECATED + if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) { + return NULL; } - return NULL; +#endif + return chanTypePtr->wideSeekProc; } /* *---------------------------------------------------------------------- * @@ -10881,14 +10932,16 @@ Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) { - return chanTypePtr->threadActionProc; +#ifndef TCL_NO_DEPRECATED + if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) { + return NULL; } - return NULL; +#endif + return chanTypePtr->threadActionProc; } /* *---------------------------------------------------------------------- * @@ -11061,11 +11114,11 @@ } if (newcode >= 0) { lcn += 2; } - lvn = Tcl_Alloc(lcn * sizeof(Tcl_Obj *)); + lvn = (Tcl_Obj **)ckalloc(lcn * sizeof(Tcl_Obj *)); /* * New level/code information is spliced into the first occurence of * -level, -code, further occurences are ignored. The options cannot be * not present, we would not come here. Options which are ok are simply @@ -11114,11 +11167,11 @@ lvn[j++] = lv[i]; } msg = Tcl_NewListObj(j, lvn); - Tcl_Free(lvn); + ckfree(lvn); return msg; } /* *---------------------------------------------------------------------- @@ -11196,14 +11249,14 @@ Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) { - return chanTypePtr->truncateProc; + if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) { + return NULL; } - return NULL; + return chanTypePtr->truncateProc; } /* *---------------------------------------------------------------------- * @@ -11222,13 +11275,13 @@ *---------------------------------------------------------------------- */ static void DupChannelIntRep( - register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "Channel". */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not + Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; ChanGetIntRep(srcPtr, resPtr); @@ -11262,11 +11315,11 @@ assert(resPtr); if (resPtr->refCount-- > 1) { return; } Tcl_Release(resPtr->statePtr); - Tcl_Free(resPtr); + ckfree(resPtr); } #if 0 /* * For future debugging work, a simple function to print the flags of a Index: generic/tclIO.h ================================================================== --- generic/tclIO.h +++ generic/tclIO.h @@ -34,11 +34,11 @@ * * Buffers data being sent to or from a channel. */ typedef struct ChannelBuffer { - size_t refCount; /* Current uses count */ + int refCount; /* Current uses count */ int nextAdded; /* The next position into which a character * will be put in the buffer. */ int nextRemoved; /* Position of next byte to be removed from * the buffer. */ int bufLength; /* How big is the buffer? */ @@ -111,11 +111,11 @@ */ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ - size_t refCount; + int refCount; } Channel; /* * struct ChannelState: * @@ -161,11 +161,11 @@ int outEofChar; /* If nonzero, append this to the channel when * it is closed if it is open for writing. */ int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ - size_t refCount; /* How many interpreters hold references to + int refCount; /* How many interpreters hold references to * this IO channel? */ struct CloseCallback *closeCbPtr; /* Callbacks registered to be called when the * channel is closed. */ char *outputStage; /* Temporary staging buffer used when Index: generic/tclIOCmd.c ================================================================== --- generic/tclIOCmd.c +++ generic/tclIOCmd.c @@ -13,11 +13,11 @@ /* * Callback structure for accept callback in a TCP server. */ -typedef struct { +typedef struct AcceptCallback { Tcl_Obj *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; /* @@ -34,22 +34,18 @@ /* * Static functions for this file: */ -static void FinalizeIOCmdTSD(ClientData clientData); -static Tcl_TcpAcceptProc AcceptCallbackProc; -static int ChanPendingObjCmd(ClientData unused, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int ChanTruncateObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static void RegisterTcpServerInterpCleanup(Tcl_Interp *interp, - AcceptCallback *acceptCallbackPtr); -static void TcpAcceptCallbacksDeleteProc(ClientData clientData, - Tcl_Interp *interp); +static Tcl_ExitProc FinalizeIOCmdTSD; +static Tcl_TcpAcceptProc AcceptCallbackProc; +static Tcl_ObjCmdProc ChanPendingObjCmd; +static Tcl_ObjCmdProc ChanTruncateObjCmd; +static void RegisterTcpServerInterpCleanup( + Tcl_Interp *interp, + AcceptCallback *acceptCallbackPtr); +static Tcl_InterpDeleteProc TcpAcceptCallbacksDeleteProc; static void TcpServerCloseProc(ClientData callbackData); static void UnregisterTcpServerInterpCleanupProc( Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr); @@ -69,11 +65,11 @@ *---------------------------------------------------------------------- */ static void FinalizeIOCmdTSD( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->stdoutObjPtr != NULL) { Tcl_DecrRefCount(tsdPtr->stdoutObjPtr); @@ -97,14 +93,13 @@ * Produces output on a channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_PutsObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to puts on. */ @@ -135,10 +130,23 @@ newline = 0; if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) { chanObjPtr = objv[2]; string = objv[3]; break; +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { + /* + * The code below provides backwards compatibility with an old + * form of the command that is no longer recommended or + * documented. See also [Bug #3151675]. Will be removed in Tcl 9, + * maybe even earlier. + */ + + chanObjPtr = objv[1]; + string = objv[2]; + break; +#endif } /* Fall through */ default: /* [puts] or * [puts some bad number of arguments...] */ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string"); @@ -166,16 +174,16 @@ return TCL_ERROR; } TclChannelPreserve(chan); result = Tcl_WriteObj(chan, string); - if (result == -1) { + if (result < 0) { goto error; } if (newline != 0) { result = Tcl_WriteChars(chan, "\n", 1); - if (result == -1) { + if (result < 0) { goto error; } } TclChannelRelease(chan); return TCL_OK; @@ -211,14 +219,13 @@ * May cause output to appear on the specified channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_FlushObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *chanObjPtr; @@ -276,14 +283,13 @@ * May consume input from channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_GetsObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ @@ -361,14 +367,13 @@ * May consume input from channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ReadObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ @@ -424,15 +429,29 @@ toRead = -1; if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + /* + * The code below provides backwards compatibility with an old + * form of the command that is no longer recommended or + * documented. See also [Bug #3151675]. Will be removed in Tcl 9, + * maybe even earlier. + */ + + if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { +#endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + } + newline = 1; +#endif } } resultPtr = Tcl_NewObj(); Tcl_IncrRefCount(resultPtr); @@ -460,11 +479,11 @@ * If requested, remove the last newline in the channel if at EOF. */ if ((charactersRead > 0) && (newline != 0)) { const char *result; - size_t length; + int length; result = TclGetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { Tcl_SetObjLength(resultPtr, length - 1); } @@ -491,14 +510,13 @@ * flush queued output. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_SeekObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ @@ -567,14 +585,13 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_TellObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ @@ -630,14 +647,13 @@ * May discard queued input; may flush queued output. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_CloseObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to close. */ @@ -682,11 +698,11 @@ } /* * Special handling is needed if and only if the channel mode supports * more than the direction to close. Because if the close the last - * direction suppported we can and will go through the regular + * direction supported we can and will go through the regular * process. */ if ((Tcl_GetChannelMode(chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) { @@ -706,11 +722,11 @@ * a terminating newline. */ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); const char *string; - size_t len; + int len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); } @@ -739,14 +755,13 @@ * May modify the behavior of an IO channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_FconfigureObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *optionName, *valueName; @@ -815,14 +830,13 @@ * specified channel has an EOF condition. * *--------------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_EofObjCmd( - ClientData unused, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; @@ -855,25 +869,24 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ExecObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr; const char **argv; /* An array for the string arguments. Stored * on the _Tcl_ stack. */ const char *string; Tcl_Channel chan; - int argc, background, i, index, keepNewline, result, skip, ignoreStderr; - size_t length; + int argc, background, i, index, keepNewline, result, skip, length; + int ignoreStderr; static const char *const options[] = { "-ignorestderr", "-keepnewline", "--", NULL }; enum options { EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST @@ -923,11 +936,11 @@ * Create the string argument array "argv". Make sure argv is large enough * to hold the argc arguments plus 1 extra for the zero end-of-argv word. */ argc = objc - skip; - argv = TclStackAlloc(interp, (argc + 1) * sizeof(char *)); + argv = (const char **)TclStackAlloc(interp, (argc + 1) * sizeof(char *)); /* * Copy the string conversions of each (post option) object into the * argument vector. */ @@ -1023,14 +1036,13 @@ * preceeding input operation on the channel would have blocked. * *--------------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_FblockedObjCmd( - ClientData unused, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; @@ -1070,14 +1082,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_OpenObjCmd( - ClientData notUsed, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int pipeline, prot; @@ -1163,11 +1174,11 @@ chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags); if (binary && chan) { Tcl_SetChannelOption(interp, chan, "-translation", "binary"); } } - Tcl_Free((void *)cmdArgv); + ckfree(cmdArgv); } if (chan == NULL) { return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); @@ -1194,29 +1205,28 @@ * subsequently to eval accept scripts. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void TcpAcceptCallbacksDeleteProc( ClientData clientData, /* Data which was passed when the assocdata * was registered. */ - Tcl_Interp *interp) /* Interpreter being deleted - not used. */ + TCL_UNUSED(Tcl_Interp *)) { - Tcl_HashTable *hTblPtr = clientData; + Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr); + AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr); acceptCallbackPtr->interp = NULL; } Tcl_DeleteHashTable(hTblPtr); - Tcl_Free(hTblPtr); + ckfree(hTblPtr); } /* *---------------------------------------------------------------------- * @@ -1249,14 +1259,14 @@ * smash when the interpreter will be * deleted. */ Tcl_HashEntry *hPtr; /* Entry for this record. */ int isNew; /* Is the entry new? */ - hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); + hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); if (hTblPtr == NULL) { - hTblPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS); Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks", TcpAcceptCallbacksDeleteProc, hTblPtr); } @@ -1295,11 +1305,11 @@ * registration. */ { Tcl_HashTable *hTblPtr; Tcl_HashEntry *hPtr; - hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); + hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); if (hTblPtr == NULL) { return; } hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr); @@ -1333,11 +1343,11 @@ Tcl_Channel chan, /* Channel for the newly accepted * connection. */ char *address, /* Address of client that was accepted. */ int port) /* Port of client that was accepted. */ { - AcceptCallback *acceptCallbackPtr = callbackData; + AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; /* * Check if the callback is still valid; the interpreter may have gone * away, this is signalled by setting the interp field of the callback * data to NULL. @@ -1419,19 +1429,19 @@ static void TcpServerCloseProc( ClientData callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { - AcceptCallback *acceptCallbackPtr = callbackData; + AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; /* The actual data. */ if (acceptCallbackPtr->interp != NULL) { UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp, acceptCallbackPtr); } Tcl_DecrRefCount(acceptCallbackPtr->script); - Tcl_Free(acceptCallbackPtr); + ckfree(acceptCallbackPtr); } /* *---------------------------------------------------------------------- * @@ -1449,11 +1459,11 @@ *---------------------------------------------------------------------- */ int Tcl_SocketObjCmd( - ClientData notUsed, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const socketOptions[] = { @@ -1474,11 +1484,11 @@ if (TclpHasSockets(interp) != TCL_OK) { return TCL_ERROR; } for (a = 1; a < objc; a++) { - const char *arg = TclGetString(objv[a]); + const char *arg = Tcl_GetString(objv[a]); if (arg[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option", @@ -1623,21 +1633,21 @@ } port = TclGetString(objv[a]); if (server) { - AcceptCallback *acceptCallbackPtr = Tcl_Alloc(sizeof(AcceptCallback)); + AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback)); Tcl_IncrRefCount(script); acceptCallbackPtr->script = script; acceptCallbackPtr->interp = interp; chan = Tcl_OpenTcpServerEx(interp, port, host, flags, AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { Tcl_DecrRefCount(script); - Tcl_Free(acceptCallbackPtr); + ckfree(acceptCallbackPtr); return TCL_ERROR; } /* * Register with the interpreter to let us know when the interpreter @@ -1691,11 +1701,11 @@ *---------------------------------------------------------------------- */ int Tcl_FcopyObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel inChan, outChan; @@ -1784,14 +1794,13 @@ * "output"), or -1 if the channel wasn't opened for that mode. * *--------------------------------------------------------------------------- */ - /* ARGSUSED */ static int ChanPendingObjCmd( - ClientData unused, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; @@ -1849,11 +1858,11 @@ *---------------------------------------------------------------------- */ static int ChanTruncateObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; @@ -1922,11 +1931,11 @@ *---------------------------------------------------------------------- */ static int ChanPipeObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel rchan, wchan; @@ -1973,11 +1982,11 @@ *---------------------------------------------------------------------- */ int TclChannelNamesCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc < 1 || objc > 2) { Index: generic/tclIOGT.c ================================================================== --- generic/tclIOGT.c +++ generic/tclIOGT.c @@ -20,17 +20,19 @@ */ static int TransformBlockModeProc(ClientData instanceData, int mode); static int TransformCloseProc(ClientData instanceData, - Tcl_Interp *interp); + Tcl_Interp *interp, int flags); static int TransformInputProc(ClientData instanceData, char *buf, int toRead, int *errorCodePtr); static int TransformOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr); +#ifndef TCL_NO_DEPRECATED static int TransformSeekProc(ClientData instanceData, long offset, int mode, int *errorCodePtr); +#endif static int TransformSetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); static int TransformGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, @@ -117,19 +119,23 @@ */ static const Tcl_ChannelType transformChannelType = { "transform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TransformCloseProc, /* Close proc. */ + TCL_CLOSE2PROC, /* Close proc. */ TransformInputProc, /* Input proc. */ TransformOutputProc, /* Output proc. */ +#ifndef TCL_NO_DEPRECATED TransformSeekProc, /* Seek proc. */ +#else + NULL, /* Seek proc. */ +#endif TransformSetOptionProc, /* Set option proc. */ TransformGetOptionProc, /* Get option proc. */ TransformWatchProc, /* Initialize notifier. */ TransformGetFileHandleProc, /* Get OS handles out of channel. */ - NULL, /* close2proc */ + TransformCloseProc, /* close2proc */ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/ NULL, /* Flush proc. */ TransformNotifyProc, /* Handling of events bubbling up. */ TransformWideSeekProc, /* Wide seek proc. */ NULL, /* Thread action. */ @@ -228,11 +234,11 @@ if (dataPtr->refCount-- > 1) { return; } ResultClear(&dataPtr->result); Tcl_DecrRefCount(dataPtr->command); - Tcl_Free(dataPtr); + ckfree(dataPtr); } /* *---------------------------------------------------------------------- * @@ -249,11 +255,10 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int TclChannelTransform( Tcl_Interp *interp, /* Interpreter for result. */ Tcl_Channel chan, /* Channel to transform. */ Tcl_Obj *cmdObjPtr) /* Script to use for transform. */ @@ -285,11 +290,11 @@ * Now initialize the transformation state and stack it upon the specified * channel. One of the necessary things to do is to retrieve the blocking * regime of the underlying channel and to use the same for us too. */ - dataPtr = Tcl_Alloc(sizeof(TransformChannelData)); + dataPtr = (TransformChannelData *)ckalloc(sizeof(TransformChannelData)); dataPtr->refCount = 1; Tcl_DStringInit(&ds); Tcl_GetChannelOption(interp, chan, "-blocking", &ds); dataPtr->readIsFlushed = 0; @@ -376,11 +381,11 @@ int preserve) /* Flag. If true the procedure will preserve * the result state of all accessed * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ - size_t resLen = 0; + int resLen; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command); Tcl_Interp *eval = dataPtr->interp; @@ -441,27 +446,27 @@ case TRANSMIT_DOWN: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); - resBuf = TclGetByteArrayFromObj(resObj, &resLen); + resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; case TRANSMIT_SELF: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); - resBuf = TclGetByteArrayFromObj(resObj, &resLen); + resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); - resBuf = TclGetByteArrayFromObj(resObj, &resLen); + resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; case TRANSMIT_NUM: /* @@ -501,11 +506,11 @@ static int TransformBlockModeProc( ClientData instanceData, /* State of transformation. */ int mode) /* New blocking mode. */ { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { dataPtr->flags |= CHANNEL_ASYNC; } else { dataPtr->flags &= ~CHANNEL_ASYNC; @@ -531,13 +536,18 @@ */ static int TransformCloseProc( ClientData instanceData, - Tcl_Interp *interp) + Tcl_Interp *interp, + int flags) { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } /* * Important: In this procedure 'dataPtr->self' already points to the * underlying channel. * @@ -614,11 +624,11 @@ ClientData instanceData, char *buf, int toRead, int *errorCodePtr) { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; int gotBytes, read, copied; Tcl_Channel downChan; /* * Should assert(dataPtr->mode & TCL_READABLE); @@ -781,11 +791,11 @@ ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; /* * Should assert(dataPtr->mode & TCL_WRITABLE); */ @@ -826,18 +836,19 @@ * contains the POSIX error code if an error occurred, or zero. * *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED static int TransformSeekProc( ClientData instanceData, /* The channel to manipulate. */ long offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); if ((offset == 0) && (mode == SEEK_CUR)) { @@ -872,10 +883,11 @@ ReleaseData(dataPtr); return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode, errorCodePtr); } +#endif /* *---------------------------------------------------------------------- * * TransformWideSeekProc -- @@ -900,14 +912,16 @@ ClientData instanceData, /* The channel to manipulate. */ Tcl_WideInt offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); +#ifndef TCL_NO_DEPRECATED Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); +#endif Tcl_DriverWideSeekProc *parentWideSeekProc = Tcl_ChannelWideSeekProc(parentType); ClientData parentData = Tcl_GetChannelInstanceData(parent); if ((offset == 0) && (mode == SEEK_CUR)) { @@ -916,13 +930,18 @@ * location. Simply pass the request down. */ if (parentWideSeekProc != NULL) { return parentWideSeekProc(parentData, offset, mode, errorCodePtr); +#ifndef TCL_NO_DEPRECATED + } else if (parentSeekProc) { + return parentSeekProc(parentData, 0, mode, errorCodePtr); +#endif + } else { + *errorCodePtr = EINVAL; + return -1; } - - return parentSeekProc(parentData, 0, mode, errorCodePtr); } /* * It is a real request to change the position. Flush all data waiting for * output and discard everything in the input buffers. Then pass the @@ -946,29 +965,33 @@ /* * If we have a wide seek capability, we should stick with that. */ - if (parentWideSeekProc != NULL) { - return parentWideSeekProc(parentData, offset, mode, errorCodePtr); - } - - /* - * We're transferring to narrow seeks at this point; this is a bit complex - * because we have to check whether the seek is possible first (i.e. - * whether we are losing information in truncating the bits of the - * offset). Luckily, there's a defined error for what happens when trying - * to go out of the representable range. - */ - - if (offsetLONG_MAX) { - *errorCodePtr = EOVERFLOW; + if (parentWideSeekProc == NULL) { + /* + * We're transferring to narrow seeks at this point; this is a bit complex + * because we have to check whether the seek is possible first (i.e. + * whether we are losing information in truncating the bits of the + * offset). Luckily, there's a defined error for what happens when trying + * to go out of the representable range. + */ + +#ifndef TCL_NO_DEPRECATED + if (offsetLONG_MAX) { + *errorCodePtr = EOVERFLOW; + return -1; + } + + return parentSeekProc(parentData, offset, + mode, errorCodePtr); +#else + *errorCodePtr = EINVAL; return -1; +#endif } - - return parentSeekProc(parentData, offset, - mode, errorCodePtr); + return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } /* *---------------------------------------------------------------------- * @@ -992,11 +1015,11 @@ ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value) { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self); Tcl_DriverSetOptionProc *setOptionProc; setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan)); if (setOptionProc == NULL) { @@ -1030,11 +1053,11 @@ ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr) { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self); Tcl_DriverGetOptionProc *getOptionProc; getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); if (getOptionProc != NULL) { @@ -1070,17 +1093,16 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void TransformWatchProc( ClientData instanceData, /* Channel to watch. */ int mask) /* Events of interest. */ { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel downChan; /* * The caller expressed interest in events occuring for this channel. We * are forwarding the call to the underlying channel now. @@ -1155,11 +1177,11 @@ TransformGetFileHandleProc( ClientData instanceData, /* Channel to query. */ int direction, /* Direction of interest. */ ClientData *handlePtr) /* Place to store the handle into. */ { - TransformChannelData *dataPtr = instanceData; + TransformChannelData *dataPtr = (TransformChannelData *)instanceData; /* * Return the handle belonging to parent channel. IOW, pass the request * down and the result up. */ @@ -1189,11 +1211,11 @@ TransformNotifyProc( ClientData clientData, /* The state of the notified * transformation. */ int mask) /* The mask of occuring events. */ { - TransformChannelData *dataPtr = clientData; + TransformChannelData *dataPtr = (TransformChannelData *)clientData; /* * An event occured in the underlying channel. This transformation doesn't * process such events thus returns the incoming mask unchanged. */ @@ -1232,11 +1254,11 @@ static void TransformChannelHandlerTimer( ClientData clientData) /* Transformation to query. */ { - TransformChannelData *dataPtr = clientData; + TransformChannelData *dataPtr = (TransformChannelData *)clientData; dataPtr->timer = NULL; if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) { /* * The timer fired, but either is there no (more) interest in the @@ -1270,11 +1292,11 @@ ResultBuffer *r) /* Reference to the buffer to clear out. */ { r->used = 0; if (r->allocated) { - Tcl_Free(r->buf); + ckfree(r->buf); r->buf = NULL; r->allocated = 0; } } @@ -1414,14 +1436,14 @@ * Extension of the internal buffer is required. */ if (r->allocated == 0) { r->allocated = toWrite + INCREMENT; - r->buf = Tcl_Alloc(r->allocated); + r->buf = (unsigned char *)ckalloc(r->allocated); } else { r->allocated += toWrite + INCREMENT; - r->buf = Tcl_Realloc(r->buf, r->allocated); + r->buf = (unsigned char *)ckrealloc(r->buf, r->allocated); } } /* * Now we may copy the data. Index: generic/tclIORChan.c ================================================================== --- generic/tclIORChan.c +++ generic/tclIORChan.c @@ -30,11 +30,11 @@ /* * Signatures of all functions used in the C layer of the reflection. */ static int ReflectClose(ClientData clientData, - Tcl_Interp *interp); + Tcl_Interp *interp, int flags); static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); @@ -44,12 +44,14 @@ static int ReflectEventRun(Tcl_Event *ev, int flags); static int ReflectEventDelete(Tcl_Event *ev, ClientData cd); #endif static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); +#ifndef TCL_NO_DEPRECATED static int ReflectSeek(ClientData clientData, long offset, int mode, int *errorCodePtr); +#endif static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, @@ -63,27 +65,31 @@ */ static const Tcl_ChannelType tclRChannelType = { "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - ReflectClose, /* Close channel, clean instance data */ + TCL_CLOSE2PROC, /* Close channel, clean instance data */ ReflectInput, /* Handle read request */ ReflectOutput, /* Handle write request */ +#ifndef TCL_NO_DEPRECATED ReflectSeek, /* Move location of access point. NULL'able */ +#else + NULL, +#endif ReflectSetOption, /* Set options. NULL'able */ ReflectGetOption, /* Get options. NULL'able */ ReflectWatch, /* Initialize notifier */ NULL, /* Get OS handle from the channel. NULL'able */ - NULL, /* No close2 support. 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 */ #if TCL_THREADS ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif NULL /* truncate */ }; /* @@ -261,11 +267,11 @@ */ struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - size_t toRead; /* I: #bytes to read, + int toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *buf; /* I: Where the bytes to write come from */ @@ -394,11 +400,11 @@ static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ - Tcl_Free((p)->base.msgStr); \ + ckfree((p)->base.msgStr); \ } #define PassReceivedErrorInterp(i,p) \ if ((i) != NULL) { \ Tcl_SetChannelErrorInterp((i), \ Tcl_NewStringObj((p)->base.msgStr, -1)); \ @@ -417,11 +423,11 @@ (p)->base.msgStr = (char *) (emsg) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedChannelMap * GetThreadReflectedChannelMap(void); -static void DeleteThreadReflectedChannelMap(ClientData clientData); +static Tcl_ExitProc DeleteThreadReflectedChannelMap; #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) @@ -444,12 +450,11 @@ static int InvokeTclMethod(ReflectedChannel *rcPtr, MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); -static void DeleteReflectedChannelMap(ClientData clientData, - Tcl_Interp *interp); +static Tcl_InterpDeleteProc DeleteReflectedChannelMap; static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); static void MarkDead(ReflectedChannel *rcPtr); /* * Global constant strings (messages). ================== @@ -490,11 +495,11 @@ *---------------------------------------------------------------------- */ int TclChanCreateObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { ReflectedChannel *rcPtr; /* Instance data of the new channel */ @@ -679,11 +684,11 @@ * Some of the nullable methods are not supported. We clone the * channel type, null the associated C functions, and use the result * as the actual channel type. */ - Tcl_ChannelType *clonePtr = Tcl_Alloc(sizeof(Tcl_ChannelType)); + Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); if (!(methods & FLAG(METH_CONFIGURE))) { clonePtr->setOptionProc = NULL; @@ -694,11 +699,13 @@ } if (!(methods & FLAG(METH_BLOCKING))) { clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { +#ifndef TCL_NO_DEPRECATED clonePtr->seekProc = NULL; +#endif clonePtr->wideSeekProc = NULL; } chanPtr->typePtr = clonePtr; } @@ -734,11 +741,11 @@ error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); - Tcl_Free(rcPtr); + ckfree(rcPtr); return TCL_ERROR; #undef MODE #undef CMD } @@ -769,11 +776,11 @@ } ReflectEvent; static int ReflectEventRun( Tcl_Event *ev, - int flags) + TCL_UNUSED(int) /*flags*/) { /* OWNER thread * * Note: When the channel is closed any pending events of this type are * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls @@ -807,11 +814,11 @@ } #endif int TclChanPostEventObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { /* @@ -880,11 +887,11 @@ * We keep the old checks for both, for paranioa, but abort now instead of * throwing errors, as failure now means that our internal datastructures * have gone seriously haywire. */ - chan = Tcl_GetHashValue(hPtr); + chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); chanTypePtr = Tcl_GetChannelType(chan); /* * We use a function referenced by the channel type as our cookie to * detect calls to non-reflecting channels. The channel type itself is not @@ -896,11 +903,11 @@ if (chanTypePtr->watchProc != &ReflectWatch) { Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel"); } - rcPtr = Tcl_GetChannelInstanceData(chan); + rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); if (rcPtr->interp != interp) { Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter"); } @@ -943,11 +950,11 @@ TimerRunWrite, rcPtr); } } #if TCL_THREADS } else { - ReflectEvent *ev = Tcl_Alloc(sizeof(ReflectEvent)); + ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); ev->header.proc = ReflectEventRun; ev->events = events; ev->rcPtr = rcPtr; @@ -992,20 +999,20 @@ static void TimerRunRead( ClientData clientData) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; rcPtr->readTimer = NULL; Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE); } static void TimerRunWrite( ClientData clientData) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; rcPtr->writeTimer = NULL; Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE); } /* @@ -1148,19 +1155,24 @@ */ static int ReflectClose( ClientData clientData, - Tcl_Interp *interp) + Tcl_Interp *interp, + int flags) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; int result; /* Result code for 'close' */ Tcl_Obj *resObj; /* Result data for 'close' */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp */ Tcl_HashEntry *hPtr; /* Entry in the above map */ const Tcl_ChannelType *tctPtr; + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command @@ -1196,11 +1208,11 @@ } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - Tcl_Free((void *)tctPtr); + ckfree(tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } if (rcPtr->readTimer != NULL) { Tcl_DeleteTimerHandler(rcPtr->readTimer); } @@ -1271,11 +1283,11 @@ } } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - Tcl_Free((void *)tctPtr); + ckfree(tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } if (rcPtr->readTimer != NULL) { Tcl_DeleteTimerHandler(rcPtr->readTimer); } @@ -1307,13 +1319,13 @@ ClientData clientData, char *buf, int toRead, int *errorCodePtr) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *toReadObj; - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ /* * Are we in the correct thread? @@ -1329,19 +1341,19 @@ ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { /* - * No error message, this is an errno signal. - */ + * No error message, this is an errno signal. + */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } - p.input.toRead = TCL_AUTO_LENGTH; + p.input.toRead = -1; } else { *errorCodePtr = EOK; } return p.input.toRead; @@ -1366,20 +1378,20 @@ Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); - if ((size_t)toRead < bytec) { + if (toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; - if (bytec + 1 > 1) { + if (bytec > 0) { memcpy(buf, bytev, bytec); } stop: Tcl_DecrRefCount(toReadObj); @@ -1414,11 +1426,11 @@ ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; /* @@ -1435,12 +1447,12 @@ ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { /* - * No error message, this is an errno signal. - */ + * No error message, this is an errno signal. + */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; @@ -1543,11 +1555,11 @@ ClientData clientData, Tcl_WideInt offset, int seekMode, int *errorCodePtr) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; /* @@ -1612,10 +1624,11 @@ *errorCodePtr = EINVAL; newLoc = -1; goto stop; } +#ifndef TCL_NO_DEPRECATED static int ReflectSeek( ClientData clientData, long offset, int seekMode, @@ -1629,10 +1642,11 @@ */ return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr); } +#endif /* *---------------------------------------------------------------------- * * ReflectWatch -- @@ -1652,11 +1666,11 @@ static void ReflectWatch( ClientData clientData, int mask) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *maskObj; /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. @@ -1724,11 +1738,11 @@ static int ReflectBlock( ClientData clientData, int nonblocking) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *blockObj; int errorNum; /* EINVAL or EOK (success). */ Tcl_Obj *resObj; /* Result data for 'blocking' */ /* @@ -1791,11 +1805,11 @@ static void ReflectThread( ClientData clientData, int action) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; switch (action) { case TCL_CHANNEL_THREAD_INSERT: rcPtr->owner = Tcl_GetCurrentThread(); break; @@ -1830,11 +1844,11 @@ ClientData 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 */ { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *optionObj, *valueObj; int result; /* Result code for 'configure' */ Tcl_Obj *resObj; /* Result data for 'configure' */ /* @@ -1907,11 +1921,11 @@ /* * This code is special. It has regular passing of Tcl result, and errors. * The bypass functions are not required. */ - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ int listc, result = TCL_OK; Tcl_Obj **listv; MethodName method; @@ -1920,11 +1934,11 @@ * Are we in the correct thread? */ #if TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { - int opcode; + ForwardedOperation opcode; ForwardParam p; p.getOpt.name = optionName; p.getOpt.value = dsPtr; @@ -2007,11 +2021,11 @@ "Expected list with even number of " "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { - size_t len; + int len; const char *str = TclGetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); @@ -2123,11 +2137,11 @@ static Tcl_Obj * DecodeEventMask( int mask) { - register const char *eventStr; + const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; @@ -2172,13 +2186,13 @@ Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - MethodName mn = METH_BLOCKING; + int mn = 0; - rcPtr = Tcl_Alloc(sizeof(ReflectedChannel)); + rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; rcPtr->interp = interp; @@ -2193,11 +2207,11 @@ /* ASSERT: cmdpfxObj is a Tcl List */ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); - while (mn <= METH_WRITE) { + while (mn <= (int)METH_WRITE) { Tcl_ListObjAppendElement(NULL, rcPtr->methods, Tcl_NewStringObj(methodNames[mn++], -1)); } Tcl_IncrRefCount(rcPtr->methods); rcPtr->name = handleObj; @@ -2261,11 +2275,11 @@ Tcl_DecrRefCount(rcPtr->methods); } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); } - Tcl_Free(rcPtr); + ckfree(rcPtr); } /* *---------------------------------------------------------------------- * @@ -2382,11 +2396,11 @@ * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { - size_t cmdLen; + int cmdLen; const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( @@ -2494,17 +2508,16 @@ static ReflectedChannelMap * GetReflectedChannelMap( Tcl_Interp *interp) { - ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL); + ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { - rcmPtr = Tcl_Alloc(sizeof(ReflectedChannelMap)); + rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); - Tcl_SetAssocData(interp, RCMKEY, - (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr); + Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr); } return rcmPtr; } /* @@ -2552,11 +2565,11 @@ static void DeleteReflectedChannelMap( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { - ReflectedChannelMap *rcmPtr = clientData; + ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedChannel *rcPtr; Tcl_Channel chan; @@ -2579,18 +2592,18 @@ */ for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { - chan = Tcl_GetHashValue(hPtr); - rcPtr = Tcl_GetChannelInstanceData(chan); + chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); + rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); - Tcl_Free(&rcmPtr->map); + ckfree(&rcmPtr->map); #if TCL_THREADS /* * The origin interpreter for one or more reflected channels is gone. */ @@ -2625,12 +2638,12 @@ */ evPtr = resultPtr->evPtr; /* - * Basic crash safety until this routine can get revised [3411310] - */ + * Basic crash safety until this routine can get revised [3411310] + */ if (evPtr == NULL) { continue; } paramPtr = evPtr->param; @@ -2657,12 +2670,12 @@ rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - chan = Tcl_GetHashValue(hPtr); - rcPtr = Tcl_GetChannelInstanceData(chan); + chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); + rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); if (rcPtr->interp != interp) { /* * Ignore entries for other interpreters. */ @@ -2698,11 +2711,11 @@ GetThreadReflectedChannelMap(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rcmPtr) { - tsdPtr->rcmPtr = Tcl_Alloc(sizeof(ReflectedChannelMap)); + tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); } return tsdPtr->rcmPtr; @@ -2726,11 +2739,11 @@ *---------------------------------------------------------------------- */ static void DeleteThreadReflectedChannelMap( - ClientData clientData) /* The per-thread data structure. */ + TCL_UNUSED(ClientData)) { Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Tcl_ThreadId self = Tcl_GetCurrentThread(); ReflectedChannelMap *rcmPtr; /* The map */ @@ -2775,12 +2788,12 @@ */ evPtr = resultPtr->evPtr; /* - * Basic crash safety until this routine can get revised [3411310] - */ + * Basic crash safety until this routine can get revised [3411310] + */ if (evPtr == NULL ) { continue; } paramPtr = evPtr->param; @@ -2815,17 +2828,17 @@ rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { - Tcl_Channel chan = Tcl_GetHashValue(hPtr); - ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan); + Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); + ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan); MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } - Tcl_Free(rcmPtr); + ckfree(rcmPtr); } static void ForwardOpToHandlerThread( ReflectedChannel *rcPtr, /* Channel instance */ @@ -2861,12 +2874,12 @@ /* * Create and initialize the event and data structures. */ - evPtr = Tcl_Alloc(sizeof(ForwardingEvent)); - resultPtr = Tcl_Alloc(sizeof(ForwardingResult)); + evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); + resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; evPtr->op = op; evPtr->rcPtr = rcPtr; @@ -2944,17 +2957,17 @@ * Note: The event structure has already been deleted. */ Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - Tcl_Free(resultPtr); + ckfree(resultPtr); } static int ForwardProc( Tcl_Event *evGPtr, - int mask) + TCL_UNUSED(int) /* mask */) { /* * HANDLER thread. * The receiver part for the operations coming from the OWNER thread. @@ -3044,26 +3057,26 @@ if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); } - paramPtr->input.toRead = TCL_IO_FAILURE; + paramPtr->input.toRead = -1; } else { /* * Process a regular result. */ - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (paramPtr->input.toRead < bytec) { ForwardSetStaticError(paramPtr, msg_read_toomuch); - paramPtr->input.toRead = TCL_IO_FAILURE; + paramPtr->input.toRead = -1; } else { - if (bytec + 1 > 1) { + if (bytec > 0) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; } } @@ -3239,18 +3252,18 @@ } else if ((listc % 2) == 1) { /* * Odd number of elements is wrong. [x]. */ - char *buf = Tcl_Alloc(200); + char *buf = (char *)ckalloc(200); sprintf(buf, "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { - size_t len; + int len; const char *str = TclGetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); @@ -3296,11 +3309,11 @@ static void SrcExitProc( ClientData clientData) { - ForwardingEvent *evPtr = clientData; + ForwardingEvent *evPtr = (ForwardingEvent *)clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; /* * NOTE (2): Can this handler be called with the originator blocked? @@ -3345,15 +3358,15 @@ static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - size_t len; + int len; const char *msgStr = TclGetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); + ForwardSetDynamicError(paramPtr, ckalloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* Index: generic/tclIORTrans.c ================================================================== --- generic/tclIORTrans.c +++ generic/tclIORTrans.c @@ -25,30 +25,28 @@ #endif #ifndef EOK #define EOK 0 #endif -/* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */ -static int HaveVersion(const Tcl_ChannelType *typePtr, - Tcl_ChannelTypeVersion minimumVersion); - /* * Signatures of all functions used in the C layer of the reflection. */ static int ReflectClose(ClientData clientData, - Tcl_Interp *interp); + Tcl_Interp *interp, int flags); static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); +#ifndef TCL_NO_DEPRECATED static int ReflectSeek(ClientData clientData, long offset, int mode, int *errorCodePtr); +#endif static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, @@ -62,19 +60,23 @@ */ static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - ReflectClose, /* Close channel, clean instance data. */ + TCL_CLOSE2PROC, /* Close channel, clean instance data. */ ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ +#ifndef TCL_NO_DEPRECATED ReflectSeek, /* Move location of access point. */ +#else + NULL, /* Move location of access point. */ +#endif ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ - NULL, /* No close2 support. NULL'able. */ + ReflectClose, /* No close2 support. NULL'able. */ ReflectBlock, /* Set blocking/nonblocking. */ NULL, /* Flush channel. Not used by core. * NULL'able. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ @@ -87,12 +89,12 @@ * layers upon reading from the channel, plus the functions to manage such. */ typedef struct { unsigned char *buf; /* Reference to the buffer area. */ - size_t allocated; /* Allocated size of the buffer area. */ - size_t used; /* Number of bytes in the buffer, + int allocated; /* Allocated size of the buffer area. */ + int used; /* Number of bytes in the buffer, * <= allocated. */ } ResultBuffer; #define ResultLength(r) ((r)->used) /* static int ResultLength(ResultBuffer *r); */ @@ -268,11 +270,11 @@ struct ForwardParamTransform { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* I: Bytes to transform, * O: Bytes in transform result */ - size_t size; /* I: #bytes to transform, + int size; /* I: #bytes to transform, * O: #bytes in the transform result */ }; struct ForwardParamLimit { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ int max; /* O: Character read limit */ @@ -364,11 +366,11 @@ static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ do { \ if ((p)->base.mustFree) { \ - Tcl_Free((p)->base.msgStr); \ + ckfree((p)->base.msgStr); \ } \ } while (0) #define PassReceivedErrorInterp(i,p) \ do { \ if ((i) != NULL) { \ @@ -499,11 +501,11 @@ *---------------------------------------------------------------------- */ int TclChanPushObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { ReflectedTransform *rtPtr; /* Instance data of the new (transform) @@ -618,11 +620,11 @@ if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned %s", TclGetString(cmdObj), - Tcl_GetStringResult(interp))); + Tcl_GetString(Tcl_GetObjResult(interp)))); Tcl_DecrRefCount(resObj); goto error; } methods |= FLAG(methIndex); @@ -744,11 +746,11 @@ *---------------------------------------------------------------------- */ int TclChanPopObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { /* @@ -881,20 +883,25 @@ */ static int ReflectClose( ClientData clientData, - Tcl_Interp *interp) + Tcl_Interp *interp, + int flags) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; int errorCode, errorCodeSet = 0; int result = TCL_OK; /* Result code for 'close' */ Tcl_Obj *resObj; /* Result data for 'close' */ ReflectedTransformMap *rtmPtr; /* Map of reflected transforms with handlers * in this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command @@ -1012,11 +1019,11 @@ * the per-interp DeleteReflectedTransformMap exit-handler. */ if (!rtPtr->dead) { rtmPtr = GetReflectedTransformMap(rtPtr->interp); - hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle)); + hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } /* @@ -1059,11 +1066,11 @@ ClientData clientData, char *buf, int toRead, int *errorCodePtr) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; int gotBytes, copied, readBytes; Tcl_Obj *bufObj; /* * The following check can be done before thread redirection, because we @@ -1252,11 +1259,11 @@ ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * The following check can be done before thread redirection, because we * are reading from an item which is readonly, i.e. will never change * during the lifetime of the channel. @@ -1325,26 +1332,14 @@ ClientData clientData, Tcl_WideInt offset, int seekMode, int *errorCodePtr) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; Channel *parent = (Channel *) rtPtr->parent; Tcl_WideInt curPos; /* Position on the device. */ - Tcl_DriverSeekProc *seekProc = - Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent)); - - /* - * Fail if the parent channel is not seekable. - */ - - if (seekProc == NULL) { - Tcl_SetErrno(EINVAL); - return -1; - } - /* * Check if we can leave out involving the Tcl level, i.e. transformation * handler. This is true for tell requests, and transformations which * support neither flush, nor drain. For these cases we can pass the * request down and the result back up unchanged. @@ -1384,21 +1379,27 @@ * Now seek to the new position in the channel as requested by the * caller. Note that we prefer the wideSeekProc if that is available and * non-NULL... */ - if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) && - parent->typePtr->wideSeekProc != NULL) { - curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset, - seekMode, errorCodePtr); - } else if (offset < LONG_MIN || offset > LONG_MAX) { - *errorCodePtr = EOVERFLOW; + if (Tcl_ChannelWideSeekProc(parent->typePtr) == NULL) { +#ifndef TCL_NO_DEPRECATED + if (offset < LONG_MIN || offset > LONG_MAX) { + *errorCodePtr = EOVERFLOW; + curPos = -1; + } else { + curPos = Tcl_ChannelSeekProc(parent->typePtr)( + parent->instanceData, offset, seekMode, + errorCodePtr); + } +#else + *errorCodePtr = EINVAL; curPos = -1; +#endif } else { - curPos = parent->typePtr->seekProc( - parent->instanceData, offset, seekMode, - errorCodePtr); + curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset, + seekMode, errorCodePtr); } if (curPos == -1) { Tcl_SetErrno(*errorCodePtr); } @@ -1405,10 +1406,11 @@ *errorCodePtr = EOK; Tcl_Release(rtPtr); return curPos; } +#ifndef TCL_NO_DEPRECATED static int ReflectSeek( ClientData clientData, long offset, int seekMode, @@ -1422,10 +1424,11 @@ */ return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr); } +#endif /* *---------------------------------------------------------------------- * * ReflectWatch -- @@ -1445,11 +1448,11 @@ static void ReflectWatch( ClientData clientData, int mask) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; Tcl_DriverWatchProc *watchProc; watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent)); watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask); @@ -1496,11 +1499,11 @@ static int ReflectBlock( ClientData clientData, int nonblocking) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations simply record the blocking mode in their C level * structure for use by --> ReflectInput. The Tcl level doesn't see this * information or change. As such thread forwarding is not required. @@ -1531,11 +1534,11 @@ ClientData 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 */ { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations have no options. Thus the call is passed down unchanged * to the parent channel for processing. Its results are passed back * unchanged as well. This all happens in the thread we are in. As the Tcl @@ -1573,11 +1576,11 @@ ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations have no options. Thus the call is passed down unchanged * to the parent channel for processing. Its results are passed back * unchanged as well. This all happens in the thread we are in. As the Tcl @@ -1621,11 +1624,11 @@ ReflectHandle( ClientData clientData, int direction, ClientData *handlePtr) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * Transformations have no handle of their own. As such we simply query * the parent channel for it. This way the qery will ripple down through * all transformations until reaches the base channel. Which then returns @@ -1656,11 +1659,11 @@ static int ReflectNotify( ClientData clientData, int mask) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* * An event occured in the underlying channel. * * We delete our timer. It was not fired, yet we are here, so the channel @@ -1704,11 +1707,11 @@ static Tcl_Obj * DecodeEventMask( int mask) { - register const char *eventStr; + const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; @@ -1748,20 +1751,20 @@ static ReflectedTransform * NewReflectedTransform( Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, - int mode, + TCL_UNUSED(int) /*mode*/, Tcl_Obj *handleObj, Tcl_Channel parentChan) { ReflectedTransform *rtPtr; int listc; Tcl_Obj **listv; int i; - rtPtr = Tcl_Alloc(sizeof(ReflectedTransform)); + rtPtr = (ReflectedTransform *)ckalloc(sizeof(ReflectedTransform)); /* rtPtr->chan: Assigned by caller. Dummy data here. */ /* rtPtr->methods: Assigned by caller. Dummy data here. */ rtPtr->chan = NULL; @@ -1804,11 +1807,11 @@ * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] * cmd ... pfx | method chan | detail1 detail2 */ rtPtr->argc = listc + 2; - rtPtr->argv = Tcl_Alloc(sizeof(Tcl_Obj *) * (listc+4)); + rtPtr->argv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (listc+4)); /* * Duplicate object references. */ @@ -1912,12 +1915,12 @@ TimerKill(rtPtr); ResultClear(&rtPtr->result); FreeReflectedTransformArgs(rtPtr); - Tcl_Free(rtPtr->argv); - Tcl_Free(rtPtr); + ckfree(rtPtr->argv); + ckfree(rtPtr); } /* *---------------------------------------------------------------------- * @@ -2039,11 +2042,11 @@ * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); - size_t cmdLen; + int cmdLen; const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rtPtr->interp); Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf( @@ -2109,14 +2112,14 @@ static ReflectedTransformMap * GetReflectedTransformMap( Tcl_Interp *interp) { - ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL); + ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { - rtmPtr = Tcl_Alloc(sizeof(ReflectedTransformMap)); + rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RTMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr); } return rtmPtr; @@ -2167,21 +2170,21 @@ * in a different thread we actually do the same as * DeleteThreadReflectedTransformMap(), just restricted to the channels of * this interp. */ - rtmPtr = clientData; + rtmPtr = (ReflectedTransformMap *)clientData; for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { - rtPtr = Tcl_GetHashValue(hPtr); + rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr); rtPtr->dead = 1; Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rtmPtr->map); - Tcl_Free(&rtmPtr->map); + ckfree(&rtmPtr->map); #if TCL_THREADS /* * The origin interpreter for one or more reflected channels is gone. */ @@ -2195,11 +2198,11 @@ rtmPtr = GetThreadReflectedTransformMap(); for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - rtPtr = Tcl_GetHashValue(hPtr); + rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr); if (rtPtr->interp != interp) { /* * Ignore entries for other interpreters. */ @@ -2275,11 +2278,11 @@ GetThreadReflectedTransformMap(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = Tcl_Alloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } return tsdPtr->rtmPtr; @@ -2303,11 +2306,11 @@ *---------------------------------------------------------------------- */ static void DeleteThreadReflectedTransformMap( - ClientData clientData) /* The per-thread data structure. */ + TCL_UNUSED(ClientData)) { Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Tcl_ThreadId self = Tcl_GetCurrentThread(); ReflectedTransformMap *rtmPtr; /* The map */ @@ -2327,17 +2330,17 @@ rtmPtr = GetThreadReflectedTransformMap(); for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) { - ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr); + ReflectedTransform *rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr); rtPtr->dead = 1; FreeReflectedTransformArgs(rtPtr); Tcl_DeleteHashEntry(hPtr); } - Tcl_Free(rtmPtr); + ckfree(rtmPtr); /* * Go through the list of pending results and cancel all whose events were * destined for this thread. While this is in progress we block any * other access to the list of pending results. @@ -2410,12 +2413,12 @@ /* * Create and initialize the event and data structures. */ - evPtr = Tcl_Alloc(sizeof(ForwardingEvent)); - resultPtr = Tcl_Alloc(sizeof(ForwardingResult)); + evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); + resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; evPtr->op = op; evPtr->rtPtr = rtPtr; @@ -2491,17 +2494,17 @@ * notifier, after it serviced the event. */ Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - Tcl_Free(resultPtr); + ckfree(resultPtr); } static int ForwardProc( Tcl_Event *evGPtr, - int mask) + TCL_UNUSED(int) /*mask*/) { /* * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see @@ -2588,27 +2591,27 @@ paramPtr->transform.buf, paramPtr->transform.size); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = TCL_AUTO_LENGTH; + paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = Tcl_Alloc(bytec); + paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } @@ -2622,27 +2625,27 @@ paramPtr->transform.buf, paramPtr->transform.size); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = TCL_AUTO_LENGTH; + paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = Tcl_Alloc(bytec); + paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } @@ -2652,26 +2655,26 @@ } case ForwardedDrain: if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = TCL_AUTO_LENGTH; + paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = Tcl_Alloc(bytec); + paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } @@ -2678,27 +2681,27 @@ break; case ForwardedFlush: if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = TCL_AUTO_LENGTH; + paramPtr->transform.size = -1; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = Tcl_Alloc(bytec); + paramPtr->transform.buf = (char *)ckalloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; } } @@ -2754,11 +2757,11 @@ static void SrcExitProc( ClientData clientData) { - ForwardingEvent *evPtr = clientData; + ForwardingEvent *evPtr = (ForwardingEvent *)clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; /* * NOTE (2): Can this handler be called with the originator blocked? @@ -2803,15 +2806,15 @@ static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - size_t len; + int len; const char *msgStr = TclGetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); + ForwardSetDynamicError(paramPtr, ckalloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* TCL_THREADS */ /* @@ -2894,11 +2897,11 @@ static void TimerRun( ClientData clientData) { - ReflectedTransform *rtPtr = clientData; + ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; rtPtr->timer = NULL; Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE); } @@ -2952,11 +2955,11 @@ if (!rPtr->allocated) { return; } - Tcl_Free(rPtr->buf); + ckfree(rPtr->buf); rPtr->buf = NULL; rPtr->allocated = 0; } /* @@ -2987,14 +2990,14 @@ * NOTE: Currently linear. Should be doubling to amortize. */ if (rPtr->allocated == 0) { rPtr->allocated = toWrite + RB_INCREMENT; - rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated)); + rPtr->buf = UCHARP(ckalloc(rPtr->allocated)); } else { rPtr->allocated += toWrite + RB_INCREMENT; - rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf, + rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf, rPtr->allocated)); } } /* @@ -3035,19 +3038,19 @@ /* * Nothing to copy in the case of an empty buffer. */ copied = 0; - } else if (rPtr->used == (size_t)toRead) { + } else if (rPtr->used == toRead) { /* * We have just enough. Copy everything to the caller. */ memcpy(buf, rPtr->buf, toRead); rPtr->used = 0; copied = toRead; - } else if (rPtr->used > (size_t)toRead) { + } else if (rPtr->used > toRead) { /* * The internal buffer contains more than requested. Copy the * requested subset to the caller, and shift the remaining bytes down. */ @@ -3078,11 +3081,11 @@ ReflectedTransform *rtPtr, int *errorCodePtr, Tcl_Obj *bufObj) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* * Are we in the correct thread? */ @@ -3089,11 +3092,11 @@ #if TCL_THREADS if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - p.transform.buf = (char *) TclGetByteArrayFromObj(bufObj, + p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { @@ -3102,11 +3105,11 @@ return 0; } *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); - Tcl_Free(p.transform.buf); + ckfree(p.transform.buf); return 1; } #endif /* TCL_THREADS */ /* ASSERT: rtPtr->method & FLAG(METH_READ) */ @@ -3117,11 +3120,11 @@ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } @@ -3133,11 +3136,11 @@ unsigned char *buf, int toWrite) { Tcl_Obj *bufObj; Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; /* * Are we in the correct thread? @@ -3159,11 +3162,11 @@ } *errorCodePtr = EOK; res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf, p.transform.size); - Tcl_Free(p.transform.buf); + ckfree(p.transform.buf); } else #endif /* TCL_THREADS */ { /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */ /* ASSERT: rtPtr->mode & TCL_WRITABLE */ @@ -3179,11 +3182,11 @@ return 0; } *errorCodePtr = EOK; - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } @@ -3200,11 +3203,11 @@ TransformDrain( ReflectedTransform *rtPtr, int *errorCodePtr) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* * Are we in the correct thread? */ @@ -3221,11 +3224,11 @@ return 0; } *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); - Tcl_Free(p.transform.buf); + ckfree(p.transform.buf); } else #endif /* TCL_THREADS */ { if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); @@ -3232,11 +3235,11 @@ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; } - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } @@ -3249,11 +3252,11 @@ ReflectedTransform *rtPtr, int *errorCodePtr, int op) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; /* * Are we in the correct thread? @@ -3276,11 +3279,11 @@ res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf, p.transform.size); } else { res = 0; } - Tcl_Free(p.transform.buf); + ckfree(p.transform.buf); } else #endif /* TCL_THREADS */ { if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); @@ -3288,11 +3291,11 @@ *errorCodePtr = EINVAL; return 0; } if (op == FLUSH_WRITE) { - bytev = TclGetByteArrayFromObj(resObj, &bytec); + bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); } else { res = 0; } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -3387,40 +3390,13 @@ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_RestoreInterpState(rtPtr->interp, sr); return 1; } - -/* DUPLICATE of HaveVersion() in tclIO.c - *---------------------------------------------------------------------- - * - * HaveVersion -- - * - * Return whether a channel type is (at least) of a given version. - * - * Results: - * True if the minimum version is exceeded by the version actually - * present. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -HaveVersion( - const Tcl_ChannelType *chanTypePtr, - Tcl_ChannelTypeVersion minimumVersion) -{ - Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr); - - return PTR2INT(actualVersion) >= PTR2INT(minimumVersion); -} /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclIOSock.c ================================================================== --- generic/tclIOSock.c +++ generic/tclIOSock.c @@ -28,15 +28,16 @@ int code) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->initialized) { - Tcl_DStringFree(&tsdPtr->errorMsg); + Tcl_DStringSetLength(&tsdPtr->errorMsg, 0); } else { + Tcl_DStringInit(&tsdPtr->errorMsg); tsdPtr->initialized = 1; } - Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg); + Tcl_WCharToUtfDString(gai_strerrorW(code), -1, &tsdPtr->errorMsg); return Tcl_DStringValue(&tsdPtr->errorMsg); } #endif /* @@ -221,11 +222,11 @@ * have no networking besides the loopback interface and want to resolve * localhost. See [Bugs 3385024, 3382419, 3382431]. As the advantage of * using AI_ADDRCONFIG is probably low even in situations where it works, * we'll leave it out for now. After all, it is just an optimisation. * - * Missing on NetBSD. + * Missing on: OpenBSD, NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ #if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux) hints.ai_flags |= AI_ADDRCONFIG; Index: generic/tclIOUtil.c ================================================================== --- generic/tclIOUtil.c +++ generic/tclIOUtil.c @@ -1,16 +1,13 @@ /* * tclIOUtil.c -- * - * This file contains the implementation of Tcl's generic filesystem - * code, which supports a pluggable filesystem architecture allowing both - * platform specific filesystems and 'virtual filesystems'. All - * filesystem access should go through the functions defined in this - * file. Most of this code was contributed by Vince Darley. - * - * Parts of this file are based on code contributed by Karl Lehenbauer, - * Mark Diekhans and Peter da Silva. + * Provides an interface for managing filesystems in Tcl, and also for + * creating a filesystem interface in Tcl arbitrary facilities. All + * filesystem operations are performed via this interface. Vince Darley + * is the primary author. Other signifiant contributors are Karl + * Lehenbauer, Mark Diekhans and Peter da Silva. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 2001-2004 Vincent Darley. * @@ -31,46 +28,45 @@ #endif /* * struct FilesystemRecord -- * - * A filesystem record is used to keep track of each filesystem currently - * registered with the core, in a linked list. + * An item in a linked list of registered filesystems */ typedef struct FilesystemRecord { - ClientData clientData; /* Client specific data for the new filesystem + ClientData clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; - /* The next filesystem registered to Tcl, or - * NULL if no more. */ + /* The next registered filesystem, or NULL to + * indicate the end of the list. */ struct FilesystemRecord *prevPtr; - /* The previous filesystem registered to Tcl, - * or NULL if no more. */ + /* The previous filesystem, or NULL to indicate + * the ned of the list */ } FilesystemRecord; /* - * This structure holds per-thread private copy of the current directory - * maintained by the global cwdPathPtr. This structure holds per-thread - * private copies of some global data. This way we avoid most of the - * synchronization calls which boosts performance, at cost of having to update - * this information each time the corresponding epoch counter changes. */ typedef struct { int initialized; - size_t cwdPathEpoch; + size_t cwdPathEpoch; /* Compared with the global cwdPathEpoch to + * determine whether cwdPathPtr is stale. + */ size_t filesystemEpoch; - Tcl_Obj *cwdPathPtr; + Tcl_Obj *cwdPathPtr; /* A private copy of cwdPathPtr. Updated when + * the value is accessed and cwdPathEpoch has + * changed. + */ ClientData cwdClientData; FilesystemRecord *filesystemList; size_t claims; } ThreadSpecificData; /* - * Prototypes for functions defined later in this file. + * Forward declarations. */ static Tcl_NRPostProc EvalFileCallback; static FilesystemRecord*FsGetFirstFilesystem(void); static void FsThrExitProc(ClientData cd); @@ -84,48 +80,40 @@ static void Disclaim(void); static void * DivertFindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void DivertUnloadFile(Tcl_LoadHandle loadHandle); - -/* - * These form part of the native filesystem support. They are needed here - * because we have a few native filesystem functions (which are the same for - * win/unix) in this file. There is no need to place them in tclInt.h, because - * they are not (and should not be) used anywhere else. - */ - -MODULE_SCOPE const char *const tclpFileAttrStrings[]; -MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; - -/* - * Declare the native filesystem support. These functions should be considered - * private to Tcl, and should really not be called directly by any code other - * than this file (i.e. neither by Tcl's core nor by extensions). Similarly, - * the old string-based Tclp... native filesystem functions should not be - * called. - * - * The correct API to use now is the Tcl_FS... set of functions, which ensure - * correct and complete virtual filesystem support. - * - * We cannot make all of these static, since some of them are implemented in - * the platform-specific directories. + +/* + * Functions that provide native filesystem support. They are private and + * should be used only here. They should be called instead of calling Tclp... + * native filesystem functions. Others should use the Tcl_FS... functions + * which ensure correct and complete virtual filesystem support. */ static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator; static Tcl_FSFreeInternalRepProc NativeFreeInternalRep; static Tcl_FSFileAttrStringsProc NativeFileAttrStrings; static Tcl_FSFileAttrsGetProc NativeFileAttrsGet; static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; /* - * The only reason these functions are not static is that they are either - * called by code in the native (win/unix) directories or they are actually - * implemented in those directories. They should simply not be called by code - * outside Tcl's native filesystem core i.e. they should be considered - * 'static' to Tcl's filesystem code (if we ever built the native filesystem - * support into a separate code library, this could actually be enforced). + * Functions that support the native filesystem functions listed above. They + * are the same for win/unix, and not in tclInt.h because they are and should + * be used only here. + */ + +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 + * directories. They should be called from outside Tcl's native filesystem + * routines. If we ever built the native filesystem support into a separate + * code library, this could actually be enforced. */ Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType; Tcl_FSInternalToNormalizedProc TclpNativeToNormalized; Tcl_FSStatProc TclpObjStat; @@ -141,15 +129,13 @@ Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory; Tcl_FSLinkProc TclpObjLink; Tcl_FSListVolumesProc TclpObjListVolumes; /* - * Define the native filesystem dispatch table. If necessary, it is ok to make - * this non-static, but it should only be accessed by the functions actually - * listed within it (or perhaps other helper functions of them). Anything - * which is not part of this 'native filesystem implementation' should not be - * delving inside here! + * The native filesystem dispatch table. This could me made public but it + * should only be accessed by the functions it points to, or perhaps + * subordinate helper functions. */ const Tcl_Filesystem tclNativeFilesystem = { "native", sizeof(Tcl_Filesystem), @@ -182,23 +168,20 @@ TclpObjCopyFile, TclpObjRenameFile, TclpObjCopyDirectory, TclpObjLstat, /* Needs casts since we're using version_2. */ - (Tcl_FSLoadFileProc *) TclpDlopen, + (Tcl_FSLoadFileProc *)(void *) TclpDlopen, (Tcl_FSGetCwdProc *) TclpGetNativeCwd, TclpObjChdir }; /* - * Define the tail of the linked list. Note that for unconventional uses of - * Tcl without a native filesystem, we may in the future wish to modify the - * current approach of hard-coding the native filesystem in the lookup list - * 'filesystemList' below. - * - * We initialize the record so that it thinks one file uses it. This means it - * will never be freed. + * An initial record in the linked list for the native filesystem. Remains at + * the tail of the list and is never freed. Currently the native filesystem is + * hard-coded. It may make sense to modify this to accomodate unconventional + * uses of Tcl that provide no native filesystem. */ static FilesystemRecord nativeFilesystemRecord = { NULL, &tclNativeFilesystem, @@ -205,45 +188,43 @@ NULL, NULL }; /* - * This is incremented each time we modify the linked list of filesystems. Any - * time it changes, all cached filesystem representations are suspect and must - * be freed. For multithreading builds, change of the filesystem epoch will - * trigger cache cleanup in all threads. + * Incremented each time the linked list of filesystems is modified. For + * multithreaded builds, invalidates all cached filesystem internal + * representations. */ static size_t theFilesystemEpoch = 1; /* - * Stores the linked list of filesystems. A 1:1 copy of this list is also - * maintained in the TSD for each thread. This is to avoid synchronization - * issues. + * The linked list of filesystems. To minimize locking each thread maintains a + * local copy of this list. + * */ static FilesystemRecord *filesystemList = &nativeFilesystemRecord; TCL_DECLARE_MUTEX(filesystemMutex) /* - * Used to implement Tcl_FSGetCwd in a file-system independent way. + * A files-system indepent sense of the current directory. */ static Tcl_Obj *cwdPathPtr = NULL; -static size_t cwdPathEpoch = 0; +static size_t cwdPathEpoch = 0; /* The pathname of the current directory */ static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) static Tcl_ThreadDataKey fsDataKey; /* - * One of these structures is used each time we successfully load a file from - * a file system by way of making a temporary copy of the file on the native - * filesystem. We need to store both the actual unloadProc/clientData - * combination which was used, and the original and modified filenames, so - * that we can correctly undo the entire operation when we want to unload the - * code. + * When a temporary copy of a file is created on the native filesystem in order + * to load the file, an FsDivertLoad structure is created to track both the + * actual unloadProc/clientData combination which was used, and the original and + * modified filenames. This makes it possible to correctly undo the entire + * operation in order to unload the library. */ typedef struct { Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unloadProcPtr; @@ -251,18 +232,18 @@ const Tcl_Filesystem *divertedFilesystem; ClientData divertedFileNativeRep; } FsDivertLoad; /* - * The following functions are obsolete string based APIs, and should be - * removed in a future release (Tcl 9 would be a good time). + * Obsolete string-based APIs that should be removed in a future release, + * perhaps in Tcl 9. */ /* Obsolete */ int Tcl_Stat( - const char *path, /* Path of file to stat (in current CP). */ + const char *path, /* Pathname of file to stat (in current CP). */ struct stat *oldStyleBuf) /* Filled with results of stat call. */ { int ret; Tcl_StatBuf buf; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); @@ -325,13 +306,13 @@ oldStyleBuf->st_rdev = buf.st_rdev; oldStyleBuf->st_nlink = buf.st_nlink; oldStyleBuf->st_uid = buf.st_uid; oldStyleBuf->st_gid = buf.st_gid; oldStyleBuf->st_size = (off_t) buf.st_size; - oldStyleBuf->st_atime = buf.st_atime; - oldStyleBuf->st_mtime = buf.st_mtime; - oldStyleBuf->st_ctime = buf.st_ctime; + oldStyleBuf->st_atime = Tcl_GetAccessTimeFromStat(&buf); + oldStyleBuf->st_mtime = Tcl_GetModificationTimeFromStat(&buf); + oldStyleBuf->st_ctime = Tcl_GetChangeTimeFromStat(&buf); #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE oldStyleBuf->st_blksize = buf.st_blksize; #endif #ifdef HAVE_STRUCT_STAT_ST_BLOCKS #ifdef HAVE_BLKCNT_T @@ -345,11 +326,12 @@ } /* Obsolete */ int Tcl_Access( - const char *path, /* Path of file to access (in current CP). */ + const char *path, /* Pathname of file to access (in current CP). + */ int mode) /* Permission setting. */ { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); @@ -361,17 +343,16 @@ } /* Obsolete */ Tcl_Channel Tcl_OpenFileChannel( - Tcl_Interp *interp, /* Interpreter for error reporting; can be + Tcl_Interp *interp, /* Interpreter for error reporting. May be * NULL. */ - const char *path, /* Name of file to open. */ + const char *path, /* Pathname of file to open. */ const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ - int permissions) /* If the open involves creating a file, with - * what modes to create it? */ + int permissions) /* The modes to use if creating a new file. */ { Tcl_Channel ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); @@ -411,13 +392,14 @@ return Tcl_DStringValue(cwdPtr); } int Tcl_EvalFile( - Tcl_Interp *interp, /* Interpreter in which to process file. */ - const char *fileName) /* Name of file to process. Tilde-substitution - * will be performed on this name. */ + Tcl_Interp *interp, /* Interpreter in which to evaluate the script. */ + const char *fileName) /* Pathname of the file containing the script. + * Performs Tilde-substitution on this + * pathaname. */ { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); Tcl_IncrRefCount(pathPtr); @@ -425,22 +407,22 @@ Tcl_DecrRefCount(pathPtr); return ret; } /* - * Now move on to the basic filesystem implementation. + * The basic filesystem implementation. */ static void FsThrExitProc( ClientData cd) { - ThreadSpecificData *tsdPtr = cd; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)cd; FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL; /* - * Trash the cwd copy. + * Discard the cwd copy. */ if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); tsdPtr->cwdPathPtr = NULL; @@ -448,18 +430,18 @@ if (tsdPtr->cwdClientData != NULL) { NativeFreeInternalRep(tsdPtr->cwdClientData); } /* - * Trash the filesystems cache. + * Discard the filesystems cache. */ fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; fsRecPtr->fsPtr = NULL; - Tcl_Free(fsRecPtr); + ckfree(fsRecPtr); fsRecPtr = tmpFsRecPtr; } tsdPtr->filesystemList = NULL; tsdPtr->initialized = 0; } @@ -478,24 +460,24 @@ /* *---------------------------------------------------------------------- * * TclFSCwdPointerEquals -- - * - * Check whether the current working directory is equal to the path - * given. + * Determine whether the given pathname is equal to the current working + * directory. * * Results: - * 1 (equal) or 0 (un-equal) as appropriate. + * 1 if equal, 0 otherwise. * * Side effects: - * If the paths are equal, but are not the same object, this method will - * modify the given pathPtrPtr to refer to the same object. In this case - * the object pointed to by pathPtrPtr will have its refCount - * decremented, and it will be adjusted to point to the cwd (with a new - * refCount). + * Updates TSD if needed. * + * Stores a pointer to the current directory in *pathPtrPtr if it is not + * already there and the current directory is not NULL. + * + * If *pathPtrPtr is not null its reference count is decremented + * before it is replaced. *---------------------------------------------------------------------- */ int TclFSCwdPointerEquals( @@ -537,19 +519,19 @@ } if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { - size_t len1, len2; + int len1, len2; const char *str1, *str2; str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = TclGetStringFromObj(*pathPtrPtr, &len2); if ((len1 == len2) && !memcmp(str1, str2, len1)) { /* - * They are equal, but different objects. Update so they will be - * the same object in the future. + * The values are equal but the objects are different. Cache the + * current structure in place of the old one. */ Tcl_DecrRefCount(*pathPtrPtr); *pathPtrPtr = tsdPtr->cwdPathPtr; Tcl_IncrRefCount(*pathPtrPtr); @@ -588,17 +570,17 @@ tmpFsRecPtr = fsRecPtr; fsRecPtr = fsRecPtr->nextPtr; } /* - * Refill the cache honouring the order. + * Refill the cache, honouring the order. */ list = NULL; fsRecPtr = tmpFsRecPtr; while (fsRecPtr != NULL) { - tmpFsRecPtr = Tcl_Alloc(sizeof(FilesystemRecord)); + tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord)); *tmpFsRecPtr = *fsRecPtr; tmpFsRecPtr->nextPtr = list; tmpFsRecPtr->prevPtr = NULL; list = tmpFsRecPtr; fsRecPtr = fsRecPtr->prevPtr; @@ -609,11 +591,11 @@ while (toFree) { FilesystemRecord *next = toFree->nextPtr; toFree->fsPtr = NULL; - Tcl_Free(toFree); + ckfree(toFree); toFree = next; } /* * Make sure the above gets released on thread exit. @@ -635,12 +617,12 @@ } return tsdPtr->filesystemList; } /* - * The epoch can be changed by filesystems being added or removed, by changing - * the "system encoding" and by env(HOME) changing. + * The epoch can is changed when a filesystems is added or removed, when + * "system encoding" changes, and when env(HOME) changes. */ int TclFSEpochOk( size_t filesystemEpoch) @@ -671,19 +653,19 @@ return tsdPtr->filesystemEpoch; } /* - * If non-NULL, clientData is owned by us and must be freed later. + * If non-NULL, take posession of clientData and free it later. */ static void FsUpdateCwd( Tcl_Obj *cwdObj, ClientData clientData) { - size_t len = 0; + int len; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { str = TclGetStringFromObj(cwdObj, &len); @@ -700,11 +682,11 @@ if (cwdObj == NULL) { cwdPathPtr = NULL; cwdClientData = NULL; } else { /* - * This must be stored as string obj! + * This must be stored as a string obj! */ cwdPathPtr = Tcl_NewStringObj(str, len); Tcl_IncrRefCount(cwdPathPtr); cwdClientData = TclNativeDupInternalRep(clientData); @@ -736,21 +718,21 @@ /* *---------------------------------------------------------------------- * * TclFinalizeFilesystem -- * - * Clean up the filesystem. After this, calls to all Tcl_FS... functions - * will fail. + * Clean up the filesystem. After this, any call to a Tcl_FS... function + * fails. * - * We will later call TclResetFilesystem to restore the FS to a pristine - * state. + * If TclResetFilesystem is called later, it restores the filesystem to a + * pristine state. * * Results: * None. * * Side effects: - * Frees any memory allocated by the filesystem. + * Frees memory allocated for the filesystem. * *---------------------------------------------------------------------- */ void @@ -757,12 +739,13 @@ TclFinalizeFilesystem(void) { FilesystemRecord *fsRecPtr; /* - * Assumption that only one thread is active now. Otherwise we would need - * to put various mutexes around this code. + * Assume that only one thread is active. Otherwise mutexes would be needed + * around this code. + * TO DO: This assumption is false, isn't it? */ if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); cwdPathPtr = NULL; @@ -781,26 +764,26 @@ fsRecPtr = filesystemList; while (fsRecPtr != NULL) { FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr; /* - * The native filesystem is static, so we don't free it. + * The native filesystem is static, so don't free it. */ if (fsRecPtr != &nativeFilesystemRecord) { - Tcl_Free(fsRecPtr); + ckfree(fsRecPtr); } fsRecPtr = tmpFsRecPtr; } if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } filesystemList = NULL; /* - * Now filesystemList is NULL. This means that any attempt to use the - * filesystem is likely to fail. + * filesystemList is now NULL. Any attempt to use the filesystem is likely + * to fail. */ #ifdef _WIN32 TclWinEncodingsCleanup(); #endif @@ -834,64 +817,48 @@ /* *---------------------------------------------------------------------- * * Tcl_FSRegister -- * - * Insert the filesystem function table at the head of the list of - * functions which are used during calls to all file-system operations. - * The filesystem will be added even if it is already in the list. (You - * can use Tcl_FSData to check if it is in the list, provided the - * ClientData used was not NULL). - * - * Note that the filesystem handling is head-to-tail of the list. Each - * filesystem is asked in turn whether it can handle a particular - * request, until one of them says 'yes'. At that point no further - * filesystems are asked. - * - * In particular this means if you want to add a diagnostic filesystem - * (which simply reports all fs activity), it must be at the head of the - * list: i.e. it must be the last registered. + * Prepends to the list of registered fileystems a new FilesystemRecord + * for the given Tcl_Filesystem, which is added even if it is already in + * the list. To determine whether the filesystem is already in the list, + * use Tcl_FSData(). + * + * Functions that use the list generally process it from head to tail and + * use the first filesystem that is suitable. Therefore, when adding a + * diagnostic filsystem (one which simply reports all fs activity), it + * must be at the head of the list. I.e. it must be the last one + * registered. * * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could + * TCL_OK, or TCL_ERROR if memory for a new node in the list could * not be allocated. * * Side effects: - * Memory allocated and modifies the link list for filesystems. + * Allocates memory for a filesystem record and modifies the list of + * registered filesystems. * *---------------------------------------------------------------------- */ int Tcl_FSRegister( - ClientData clientData, /* Client specific data for this fs. */ + ClientData clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; if (fsPtr == NULL) { return TCL_ERROR; } - newFilesystemPtr = Tcl_Alloc(sizeof(FilesystemRecord)); + newFilesystemPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord)); newFilesystemPtr->clientData = clientData; newFilesystemPtr->fsPtr = fsPtr; - /* - * Is this lock and wait strictly speaking necessary? Since any iterators - * out there will have grabbed a copy of the head of the list and be - * iterating away from that, if we add a new element to the head of the - * list, it can't possibly have any effect on any of their loops. In fact - * it could be better not to wait, since we are adjusting the filesystem - * epoch, any cached representations calculated by existing iterators are - * going to have to be thrown away anyway. - * - * However, since registering and unregistering filesystems is a very rare - * action, this is not a very important point. - */ - Tcl_MutexLock(&filesystemMutex); newFilesystemPtr->nextPtr = filesystemList; newFilesystemPtr->prevPtr = NULL; if (filesystemList) { @@ -898,11 +865,11 @@ filesystemList->prevPtr = newFilesystemPtr; } filesystemList = newFilesystemPtr; /* - * Increment the filesystem epoch counter, since existing paths might + * Increment the filesystem epoch counter since existing pathnames might * conceivably now belong to different filesystems. */ if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; @@ -915,25 +882,23 @@ /* *---------------------------------------------------------------------- * * Tcl_FSUnregister -- * - * Remove the passed filesystem from the list of filesystem function - * tables. It also ensures that the built-in (native) filesystem is not - * removable, although we may wish to change that decision in the future - * to allow a smaller Tcl core, in which the native filesystem is not - * used at all (we could, say, initialise Tcl completely over a network - * connection). + * Removes the record for given filesystem from the list of registered + * filesystems. Refuses to remove the built-in (native) filesystem. This + * might be changed in the future to allow a smaller Tcl core in which the + * native filesystem is not used at all, e.g. initializing Tcl over a + * network connection. * * Results: - * TCL_OK if the function pointer was successfully removed, TCL_ERROR + * TCL_OK if the function pointer was successfully removed, or TCL_ERROR * otherwise. * * Side effects: - * Memory may be deallocated (or will be later, once no "path" objects - * refer to this filesystem), but the list of registered filesystems is - * updated immediately. + * The list of registered filesystems is updated. Memory for the + * corresponding FilesystemRecord is eventually freed. * *---------------------------------------------------------------------- */ int @@ -944,13 +909,13 @@ FilesystemRecord *fsRecPtr; Tcl_MutexLock(&filesystemMutex); /* - * Traverse the 'filesystemList' looking for the particular node whose - * 'fsPtr' member matches 'fsPtr' and remove that one from the list. - * Ensure that the "default" node cannot be removed. + * Traverse filesystemList in search of the record whose + * 'fsPtr' member matches 'fsPtr' and remove that record from the list. + * Do not revmoe the record for the native filesystem. */ fsRecPtr = filesystemList; while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) { if (fsRecPtr->fsPtr == fsPtr) { @@ -962,22 +927,20 @@ if (fsRecPtr->nextPtr) { fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr; } /* - * Increment the filesystem epoch counter, since existing paths - * might conceivably now belong to different filesystems. This - * should also ensure that paths which have cached the filesystem - * which is about to be deleted do not reference that filesystem - * (which would of course lead to memory exceptions). + * Each cached pathname could now belong to a different filesystem, + * so increment the filesystem epoch counter to ensure that cached + * information about the removed filesystem is not used. */ if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } - Tcl_Free(fsRecPtr); + ckfree(fsRecPtr); retVal = TCL_OK; } else { fsRecPtr = fsRecPtr->nextPtr; } @@ -990,67 +953,52 @@ /* *---------------------------------------------------------------------- * * Tcl_FSMatchInDirectory -- * - * This routine is used by the globbing code to search a directory for - * all files which match a given pattern. The appropriate function for - * the filesystem to which pathPtr belongs will be called. If pathPtr - * does not belong to any filesystem and if it is NULL or the empty - * string, then we assume the pattern is to be matched in the current - * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for - * each filesystem from having to deal with this issue, we create a - * pathPtr on the fly (equal to the cwd), and then remove it from the - * results returned. This makes filesystems easy to write, since they can - * assume the pathPtr passed to them is an ordinary path. In fact this - * means we could remove such special case handling from Tcl's native - * filesystems. - * - * If 'pattern' is NULL, then pathPtr is assumed to be a fully specified - * path of a single file/directory which must be checked for existence - * and correct type. - * - * Results: - * - * The return value is a standard Tcl result indicating whether an error - * occurred in globbing. Error messages are placed in interp, but good - * results are placed in the resultPtr given. - * - * Recursive searches, e.g. + * Search in the given pathname for files matching the given pattern. + * Used by [glob]. Processes just one pattern for one directory. Callers + * such as TclGlob and DoGlob implement manage the searching of multiple + * directories in cases such as * glob -dir $dir -join * pkgIndex.tcl - * which must recurse through each directory matching '*' are handled - * internally by Tcl, by passing specific flags in a modified 'types' - * parameter. This means the actual filesystem only ever sees patterns - * which match in a single directory. + * + * Results: + * + * TCL_OK, or TCL_ERROR * * Side effects: - * The interpreter may have an error message inserted into it. + * resultPtr is populated, or in the case of an TCL_ERROR, an error message is + * set in the interpreter. * *---------------------------------------------------------------------- */ int Tcl_FSMatchInDirectory( - Tcl_Interp *interp, /* Interpreter to receive error messages, but - * may be NULL. */ - Tcl_Obj *resultPtr, /* List object to receive results. */ - Tcl_Obj *pathPtr, /* Contains path to directory to search. */ - const char *pattern, /* Pattern to match against. */ - Tcl_GlobTypeData *types) /* Object containing list of acceptable types. - * May be NULL. In particular the directory - * flag is very important. */ + Tcl_Interp *interp, /* Interpreter to receive error messages, or + * NULL */ + Tcl_Obj *resultPtr, /* List that results are added to. */ + Tcl_Obj *pathPtr, /* Pathname of directory to search. If NULL, + * the current working directory is used. */ + const char *pattern, /* Pattern to match. If NULL, pathPtr must be + * a fully-specified pathname of a single + * file/directory which already exists and is + * of the correct type. */ + Tcl_GlobTypeData *types) /* Specifies acceptable types. + * May be NULL. The directory flag is + * particularly significant. */ { const Tcl_Filesystem *fsPtr; Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr; int resLength, i, ret = -1; if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) { /* - * We don't currently allow querying of mounts by external code (a - * valuable future step), so since we're the only function that - * actually knows about mounts, this means we're being called - * recursively by ourself. Return no matches. + * Currently external callers may not query mounts, which would be a + * valuable future step. This is the only routine that knows about + * mounts, so we're being called recursively by ourself. Return no + * matches. */ return TCL_OK; } @@ -1058,16 +1006,15 @@ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); } else { fsPtr = NULL; } - /* - * Check if we've successfully mapped the path to a filesystem within - * which to search. - */ - if (fsPtr != NULL) { + /* + * A corresponding filesystem was found. Search within it. + */ + if (fsPtr->matchInDirectoryProc == NULL) { Tcl_SetErrno(ENOENT); return -1; } ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern, @@ -1076,28 +1023,25 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types); } return ret; } - /* - * If the path isn't empty, we have no idea how to match files in a - * directory which belongs to no known filesystem. - */ - if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') { + /* + * There is a pathname but it belongs to no known filesystem. Mayday! + */ + Tcl_SetErrno(ENOENT); return -1; } /* - * We have an empty or NULL path. This is defined to mean we must search - * for files within the current 'cwd'. We therefore use that, but then - * since the proc we call will return results which include the cwd we - * must then trim it off the front of each path in the result. We choose - * to deal with this here (in the generic code), since if we don't, every - * single filesystem's implementation of Tcl_FSMatchInDirectory will have - * to deal with it for us. + * The pathname is empty or NULL so search in the current working + * directory. matchInDirectoryProc prefixes each result with this + * directory, so trim it from each result. Deal with this here in the + * generic code because otherwise every filesystem implementation of + * Tcl_FSMatchInDirectory has to do it. */ cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { @@ -1116,11 +1060,11 @@ types); if (ret == TCL_OK) { FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types); /* - * Note that we know resultPtr and tmpResultPtr are distinct. + * resultPtr and tmpResultPtr are guaranteed to be distinct. */ ret = Tcl_ListObjGetElements(interp, tmpResultPtr, &resLength, &elemsPtr); for (i=0 ; ret==TCL_OK && itype & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); @@ -1201,16 +1143,16 @@ break; /* Break out of for loop. */ } } if (!found && dir) { Tcl_Obj *norm; - size_t len, mlen; + int len, mlen; /* - * We know mElt is absolute normalized and lies inside pathPtr, so - * now we must add to the result the right representation of mElt, - * i.e. the representation which is relative to pathPtr. + * mElt is normalized and lies inside pathPtr so + * add to the result the right representation of mElt, + * i.e. the representation relative to pathPtr. */ norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (norm != NULL) { const char *path, *mount; @@ -1223,16 +1165,17 @@ */ len--; } len++; /* account for '/' in the mElt [Bug 1602539] */ + + mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } /* - * No need to increment gLength, since we don't want to compare - * mounts against mounts. + * Not comparing mounts to mounts, so no need to increment gLength */ } } endOfMounts: @@ -1242,67 +1185,60 @@ /* *---------------------------------------------------------------------- * * Tcl_FSMountsChanged -- * - * Notify the filesystem that the available mounted filesystems (or - * within any one filesystem type, the number or location of mount - * points) have changed. + * Announecs that mount points have changed or that the system encoding + * has changed. * * Results: * None. * * Side effects: - * The global filesystem variable 'theFilesystemEpoch' is incremented. - * The effect of this is to make all cached path representations invalid. - * Clearly it should only therefore be called when it is really required! - * There are a few circumstances when it should be called: - * - * (1) when a new filesystem is registered or unregistered. Strictly - * speaking this is only necessary if the new filesystem accepts file - * paths as is (normally the filesystem itself is really a shell which - * hasn't yet had any mount points established and so its - * 'pathInFilesystem' proc will always fail). However, for safety, Tcl - * always calls this for you in these circumstances. - * - * (2) when additional mount points are established inside any existing - * filesystem (except the native fs) - * - * (3) when any filesystem (except the native fs) changes the list of - * available volumes. - * - * (4) when the mapping from a string representation of a file to a full, - * normalized path changes. For example, if 'env(HOME)' is modified, then - * any path containing '~' will map to a different filesystem location. - * Therefore all such paths need to have their internal representation - * invalidated. - * - * Tcl has no control over (2) and (3), so any registered filesystem must - * make sure it calls this function when those situations occur. - * - * (Note: the reason for the exception in 2,3 for the native filesystem - * is that the native filesystem by default claims all unknown files even - * if it really doesn't understand them or if they don't exist). + * The shared 'theFilesystemEpoch' is incremented, invalidating every + * exising cached internal representation of a pathname. Avoid calling + * Tcl_FSMountsChanged whenever possible. It must be called when: + * + * (1) A filesystem is registered or unregistered. This is only necessary + * if the new filesystem accepts file pathnames as-is. Normally the + * filesystem is really a shell which doesn't yet have any mount points + * established and so its 'pathInFilesystem' routine always fails. + * However, for safety, Tcl calls 'Tcl_FSMountsChanged' each time a + * filesystem is registered or unregistered. + * + * (2) An additional mount point is established inside an existing + * filesystem (except for the native file system; see note below). + * + * (3) A filesystem changes the list of available volumes (except for the + * native file system; see note below). + * + * (4) The mapping from a string representation of a file to a full, + * normalized pathname changes. For example, if 'env(HOME)' is modified, + * then any pathname containing '~' maps to a different item, possibly in + * a different filesystem. + * + * Tcl has no control over (2) and (3), so each registered filesystem must + * call Tcl_FSMountsChnaged in each of those circumstances. + * + * The reason for the exception in 2,3 for the native filesystem is that + * the native filesystem claims every file without determining whether + * whether the file exists, or even whether the pathname makes sense. * *---------------------------------------------------------------------- */ void Tcl_FSMountsChanged( - const Tcl_Filesystem *fsPtr) + TCL_UNUSED(const Tcl_Filesystem *) /*fsPtr*/) + /* + * fsPtr is currently unused. In the future it might invalidate files for + * a particular filesystem, or take some other more advanced action. + */ { /* - * We currently don't do anything with this parameter. We could in the - * future only invalidate files for this filesystem or otherwise take more - * advanced action. - */ - - (void)fsPtr; - - /* - * Increment the filesystem epoch counter, since existing paths might now - * belong to different filesystems. + * Increment the filesystem epoch to invalidate every existing cached + * internal representation. */ Tcl_MutexLock(&filesystemMutex); if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; @@ -1313,35 +1249,32 @@ /* *---------------------------------------------------------------------- * * Tcl_FSData -- * - * Retrieve the clientData field for the filesystem given, or NULL if - * that filesystem is not registered. + * Retrieves the clientData member of the given filesystem. * * Results: - * A clientData value, or NULL. Note that if the filesystem was - * registered with a NULL clientData field, this function will return - * that NULL value. + * A clientData value, or NULL if the given filesystem is not registered. + * The clientData value itself may also be NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ ClientData Tcl_FSData( - const Tcl_Filesystem *fsPtr) /* The filesystem record to query. */ + const Tcl_Filesystem *fsPtr) /* The filesystem to find in the list of + * registered filesystems. */ { ClientData retVal = NULL; FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); /* - * Traverse the list of filesystems look for a particular one. If found, - * return that filesystem's clientData (originally provided when calling - * Tcl_FSRegister). + * Find the filesystem in and retrieve its clientData. */ while ((retVal == NULL) && (fsRecPtr != NULL)) { if (fsRecPtr->fsPtr == fsPtr) { retVal = fsRecPtr->clientData; @@ -1355,57 +1288,59 @@ /* *--------------------------------------------------------------------------- * * TclFSNormalizeToUniquePath -- * - * Takes a path specification containing no ../, ./ sequences, and - * converts it into a unique path for the given platform. On Unix, this - * means the path must be free of symbolic links/aliases, and on Windows - * it means we want the long form, with that long form's case-dependence - * (which gives us a unique, case-dependent path). + * Converts the given pathname, containing no ../, ./ components, into a + * unique pathname for the given platform. On Unix the resulting pathname + * is free of symbolic links/aliases, and on Windows it is the long + * case-preserving form. + * * * Results: - * The pathPtr is modified in place. The return value is the last byte - * offset which was recognised in the path string. + * Stores the resulting pathname in pathPtr and returns the offset of the + * last byte processed in pathPtr. * * Side effects: * None (beyond the memory allocation for the result). * * Special notes: * If the filesystem-specific normalizePathProcs can re-introduce ../, ./ - * sequences into the path, then this function will not return the - * correct result. This may be possible with symbolic links on unix. + * components into the pathname, this function does not return the correct + * result. This may be possible with symbolic links on unix. * - * Important assumption: if startAt is non-zero, it must point to a - * directory separator that we know exists and is already normalized (so - * it is important not to point to the char just after the separator). * *--------------------------------------------------------------------------- */ int TclFSNormalizeToUniquePath( Tcl_Interp *interp, /* Used for error messages. */ - Tcl_Obj *pathPtr, /* The path to normalize in place. */ - int startAt) /* Start at this char-offset. */ + Tcl_Obj *pathPtr, /* An Pathname to normalize in-place. Must be + * unshared. */ + int startAt) /* Offset the string of pathPtr to start at. + * Must either be 0 or offset of a directory + * separator at the end of a pathname part that + * is already normalized, I.e. not the index of + * the byte just after the separator. */ { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - size_t i; + int i; int isVfsPath = 0; - char *path; + const char *path; /* - * Paths starting with a UNC prefix whose final character is a colon - * are reserved for VFS use. These names can not conflict with real - * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx - * and rfc3986's definition of reg-name. + * Pathnames starting with a UNC prefix and ending with a colon character + * are reserved for VFS use. These names can not conflict with real UNC + * pathnames per https://msdn.microsoft.com/en-us/library/gg465305.aspx and + * rfc3986's definition of reg-name. * * We check these first to avoid useless calls to the native filesystem's * normalizePathProc. */ - path = TclGetStringFromObj(pathPtr, &i); + path = Tcl_GetStringFromObj(pathPtr, &i); if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/') || (path[0] == '\\' && path[1] == '\\') ) ) { for ( i = 2; ; i++) { if (path[i] == '\0') break; @@ -1414,20 +1349,20 @@ --i; if (path[i] == ':') isVfsPath = 1; } /* - * Call each of the "normalise path" functions in succession. + * Call the the normalizePathProc routine of each registered filesystem. */ firstFsRecPtr = FsGetFirstFilesystem(); Claim(); if (!isVfsPath) { /* - * If we have a native filesystem handler, we call it first. This is + * Find and call the native filesystem handler first if there is one * because the root of Tcl's filesystem is always a native filesystem * (i.e., '/' on unix is native). */ for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { @@ -1434,12 +1369,12 @@ if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; } /* - * TODO: Assume that we always find the native file system; it should - * always be there... + * TODO: Always call the normalizePathProc here because it should + * always exist. */ if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, startAt); @@ -1447,25 +1382,24 @@ break; } } for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { - /* - * Skip the native system next time through. - */ - if (fsRecPtr->fsPtr == &tclNativeFilesystem) { + /* + * Skip the native system this time through. + */ continue; } if (fsRecPtr->fsPtr->normalizePathProc != NULL) { startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, startAt); } /* - * We could add an efficiency check like this: + * This efficiency check could be added: * if (retVal == length-of(pathPtr)) {break;} * but there's not much benefit. */ } Disclaim(); @@ -1476,30 +1410,31 @@ /* *--------------------------------------------------------------------------- * * TclGetOpenMode -- * - * This routine is an obsolete, limited version of TclGetOpenModeEx() - * below. It exists only to satisfy any extensions imprudently using it - * via Tcl's internal stubs table. + * Obsolete. A limited version of TclGetOpenModeEx() which exists only to + * satisfy any extensions imprudently using it via Tcl's internal stubs + * table. * * Results: - * Same as TclGetOpenModeEx(). + * See TclGetOpenModeEx(). * * Side effects: - * Same as TclGetOpenModeEx(). + * See TclGetOpenModeEx(). * *--------------------------------------------------------------------------- */ int TclGetOpenMode( - Tcl_Interp *interp, /* Interpreter to use for error reporting - - * may be NULL. */ - const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */ - int *seekFlagPtr) /* Set this to 1 if the caller should seek to - * EOF during the opening of the file. */ + Tcl_Interp *interp, /* Interpreter to use for error reporting. May + * be NULL. */ + const char *modeString, /* e.g. "r+" or "RDONLY CREAT". */ + int *seekFlagPtr) /* Sets this to 1 to tell the caller to seek to + EOF after opening the file, and + * 0 otherwise. */ { int binary = 0; return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary); } @@ -1506,61 +1441,58 @@ /* *--------------------------------------------------------------------------- * * TclGetOpenModeEx -- * - * Computes a POSIX mode mask for opening a file, from a given string, - * and also sets flags to indicate whether the caller should seek to EOF - * after opening the file, and whether the caller should configure the - * channel for binary data. + * Computes a POSIX mode mask for opening a file. * * Results: - * On success, returns mode to pass to "open". If an error occurs, the - * return value is -1 and if interp is not NULL, sets interp's result - * object to an error message. + * The mode to pass to "open", or -1 if an error occurs. * * Side effects: - * Sets the integer referenced by seekFlagPtr to 1 to tell the caller to - * seek to EOF after opening the file, or to 0 otherwise. Sets the - * integer referenced by binaryPtr to 1 to tell the caller to seek to - * configure the channel for binary data, or to 0 otherwise. + * Sets *seekFlagPtr to 1 to tell the caller to + * seek to EOF after opening the file, or to 0 otherwise. + * + * Sets *binaryPtr to 1 to tell the caller to configure the channel as a + * binary channel, or to 0 otherwise. + * + * If there is an error and interp is not NULL, sets interpreter result to + * an error message. * * Special note: - * This code is based on a prototype implementation contributed by Mark - * Diekhans. + * Based on a prototype implementation contributed by Mark Diekhans. * *--------------------------------------------------------------------------- */ int TclGetOpenModeEx( - Tcl_Interp *interp, /* Interpreter to use for error reporting - - * may be NULL. */ + Tcl_Interp *interp, /* Interpreter, possibly NULL, to use for + * error reporting. */ const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */ - int *seekFlagPtr, /* Set this to 1 if the caller should seek to - * EOF during the opening of the file. */ - int *binaryPtr) /* Set this to 1 if the caller should - * configure the opened channel for binary - * operations. */ + int *seekFlagPtr, /* Sets this to 1 to tell the the caller to seek to + * EOF after opening the file, and 0 otherwise. */ + int *binaryPtr) /* Sets this to 1 to tell the caller to + * configure the channel for binary + * operations after opening the file. */ { int mode, modeArgc, c, i, gotRW; const char **modeArgv, *flag; #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) /* - * Check for the simpler fopen-like access modes (e.g., "r"). They are + * Check for the simpler fopen-like access modes like "r" which are * distinguished from the POSIX access modes by the presence of a * lower-case first letter. */ *seekFlagPtr = 0; *binaryPtr = 0; mode = 0; /* - * Guard against international characters before using byte oriented - * routines. + * Guard against wide characters before using byte-oriented routines. */ if (!(modeString[0] & 0x80) && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */ switch (modeString[0]) { @@ -1570,11 +1502,11 @@ case 'w': mode = O_WRONLY|O_CREAT|O_TRUNC; break; case 'a': /* - * Added O_APPEND for proper automatic seek-to-end-on-write by the + * Add O_APPEND for proper automatic seek-to-end-on-write by the * OS. [Bug 680143] */ mode = O_WRONLY|O_CREAT|O_APPEND; *seekFlagPtr = 1; @@ -1588,12 +1520,12 @@ goto error; } switch (modeString[i++]) { case '+': /* - * Must remove the O_APPEND flag so that the seek command - * works. [Bug 1773127] + * Remove O_APPEND so that the seek command works. [Bug + * 1773127] */ mode &= ~(O_RDONLY|O_WRONLY|O_APPEND); mode |= O_RDWR; break; @@ -1618,15 +1550,13 @@ } return -1; } /* - * The access modes are specified using a list of POSIX modes such as - * O_CREAT. + * The access modes are specified as a list of POSIX modes like O_CREAT. * - * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when a NULL - * interpreter is passed in. + * Tcl_SplitList must work correctly when interp is NULL. */ if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) { if (interp != NULL) { Tcl_AddErrorInfo(interp, @@ -1665,11 +1595,11 @@ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" not supported by this system", flag)); } - Tcl_Free((void *)modeArgv); + ckfree(modeArgv); return -1; #endif } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { #ifdef O_NONBLOCK @@ -1678,11 +1608,11 @@ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "access mode \"%s\" not supported by this system", flag)); } - Tcl_Free((void *)modeArgv); + ckfree(modeArgv); return -1; #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { mode |= O_TRUNC; @@ -1694,16 +1624,16 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid access mode \"%s\": must be RDONLY, WRONLY, " "RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK," " or TRUNC", flag)); } - Tcl_Free((void *)modeArgv); + ckfree(modeArgv); return -1; } } - Tcl_Free((void *)modeArgv); + ckfree(modeArgv); if (!gotRW) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "access mode must include either RDONLY, WRONLY, or RDWR", @@ -1717,45 +1647,48 @@ /* *---------------------------------------------------------------------- * * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile -- * - * Read in a file and process the entire file as one gigantic Tcl - * command. Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument. + * Reads a file and evaluates it as a script. + * + * Tcl_FSEvalFile is Tcl_FSEvalFileEx without the encoding argument. + * * TclNREvalFile is an NRE-enabled version of Tcl_FSEvalFileEx. * * Results: * A standard Tcl result, which is either the result of executing the * file or an error indicating why the file couldn't be read. * * Side effects: - * Depends on the commands in the file. During the evaluation of the - * contents of the file, iPtr->scriptFile is made to point to pathPtr - * (the old value is cached and replaced when this function returns). + * Arbitrary, depending on the contents of the script. While the script + * is evaluated iPtr->scriptFile is a reference to pathPtr, and after the + * evaluation completes, has its original value restored again. * *---------------------------------------------------------------------- */ int Tcl_FSEvalFile( - Tcl_Interp *interp, /* Interpreter in which to process file. */ - Tcl_Obj *pathPtr) /* Path of file to process. Tilde-substitution - * will be performed on this name. */ + Tcl_Interp *interp, /* Interpreter that evaluates the script. */ + Tcl_Obj *pathPtr) /* Pathname of file containing the script. + * Tilde-substitution is performed on this + * pathname. */ { return Tcl_FSEvalFileEx(interp, pathPtr, NULL); } int Tcl_FSEvalFileEx( - Tcl_Interp *interp, /* Interpreter in which to process file. */ - Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution - * will be performed on this name. */ - const char *encodingName) /* If non-NULL, then use this encoding for the - * file. NULL means use the system encoding. */ -{ - size_t length; - int result = TCL_ERROR; + Tcl_Interp *interp, /* Interpreter that evaluates the script. */ + Tcl_Obj *pathPtr, /* Pathname of the file to process. + * Tilde-substitution is performed on this + * pathname. */ + const char *encodingName) /* Either the name of an encoding or NULL to + use the system encoding. */ +{ + int length, result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; const char *string; Tcl_Channel chan; @@ -1767,31 +1700,32 @@ if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return result; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return result; } /* - * The eofchar is \32 (^Z). This is the usual on Windows, but we effect - * this cross-platform to allow for scripted documents. [Bug: 2040] + * The eof character is \32 (^Z). This is standard on Windows, and Tcl + * uses it on every platform to allow for scripted documents. [Bug: 2040] */ Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}"); /* - * If the encoding is specified, set it for the channel. Else don't touch - * it (and use the system encoding) Report error on unknown encoding. + * If the encoding is specified, set the channel to that encoding. + * Otherwise don't touch it, leaving things up to the system encoding. If + * the encoding is unknown report an error. */ if (encodingName != NULL) { if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { @@ -1802,34 +1736,33 @@ objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); /* - * Try to read first character of stream, so we can check for utf-8 BOM to - * be handled especially. + * Read first character of stream to check for utf-8 BOM */ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); goto end; } - string = TclGetString(objPtr); + string = Tcl_GetString(objPtr); /* - * If first character is not a BOM, append the remaining characters, - * otherwise replace them. [Bug 3466099] + * If first character is not a BOM, append the remaining characters. + * Otherwise, replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); goto end; } if (Tcl_Close(interp, chan) != TCL_OK) { goto end; @@ -1840,20 +1773,20 @@ iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); string = TclGetStringFromObj(objPtr, &length); /* - * TIP #280 Force the evaluator to open a frame for a sourced file. + * TIP #280: Open a frame for the evaluated script. */ iPtr->evalFlags |= TCL_EVAL_FILE; result = TclEvalEx(interp, string, length, 0, 1, NULL, string); /* - * Now we have to be careful; the script may have changed the - * iPtr->scriptFile value, so we must reset it without assuming it still - * points to 'pathPtr'. + * Restore the original iPtr->scriptFile value, but because the value may + * have hanged during evaluation, don't assume it currently points to + * pathPtr. */ if (iPtr->scriptFile != NULL) { Tcl_DecrRefCount(iPtr->scriptFile); } @@ -1861,20 +1794,20 @@ if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* - * Record information telling where the error occurred. + * Record information about where the error occurred. */ const char *pathString = TclGetStringFromObj(pathPtr, &length); - unsigned limit = 150; + int limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", - (overflow ? limit : (unsigned)length), pathString, + (overflow ? limit : length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } end: Tcl_DecrRefCount(objPtr); @@ -1881,15 +1814,16 @@ return result; } int TclNREvalFile( - Tcl_Interp *interp, /* Interpreter in which to process file. */ - Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution - * will be performed on this name. */ - const char *encodingName) /* If non-NULL, then use this encoding for the - * file. NULL means use the system encoding. */ + Tcl_Interp *interp, /* Interpreter in which to evaluate the script. */ + Tcl_Obj *pathPtr, /* Pathname of a file containing the script to + * evaluate. Tilde-substitution is performed on + * this pathname. */ + const char *encodingName) /* The name of an encoding to use, or NULL to + * use the system encoding. */ { Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile, *objPtr; Interp *iPtr; Tcl_Channel chan; @@ -1901,32 +1835,33 @@ if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } - TclPkgFileSeen(interp, TclGetString(pathPtr)); + TclPkgFileSeen(interp, Tcl_GetString(pathPtr)); /* - * The eofchar is \32 (^Z). This is the usual on Windows, but we effect - * this cross-platform to allow for scripted documents. [Bug: 2040] + * The eof character is \32 (^Z). This is standard on Windows, and Tcl + * uses it on every platform to allow for scripted documents. [Bug: 2040] */ Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}"); /* - * If the encoding is specified, set it for the channel. Else don't touch - * it (and use the system encoding) Report error on unknown encoding. + * If the encoding is specified, set the channel to that encoding. + * Otherwise don't touch it, leaving things up to the system encoding. If + * the encoding is unknown report an error. */ if (encodingName != NULL) { if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { @@ -1937,35 +1872,34 @@ objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); /* - * Try to read first character of stream, so we can check for utf-8 BOM to - * be handled especially. + * Read first character of stream to check for utf-8 BOM */ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } - string = TclGetString(objPtr); + string = Tcl_GetString(objPtr); /* - * If first character is not a BOM, append the remaining characters, - * otherwise replace them. [Bug 3466099] + * If first character is not a BOM, append the remaining characters. + * Otherwise, replace them. [Bug 3466099] */ if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) { Tcl_Close(interp, chan); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } if (Tcl_Close(interp, chan) != TCL_OK) { @@ -1977,11 +1911,11 @@ oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); /* - * TIP #280: Force the evaluator to open a frame for a sourced file. + * TIP #280: Open a frame for the evaluated script. */ iPtr->evalFlags |= TCL_EVAL_FILE; TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr, NULL); @@ -1993,18 +1927,18 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *oldScriptFile = data[0]; - Tcl_Obj *pathPtr = data[1]; - Tcl_Obj *objPtr = data[2]; + Tcl_Obj *oldScriptFile = (Tcl_Obj *)data[0]; + Tcl_Obj *pathPtr = (Tcl_Obj *)data[1]; + Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; /* - * Now we have to be careful; the script may have changed the - * iPtr->scriptFile value, so we must reset it without assuming it still - * points to 'pathPtr'. + * Restore the original iPtr->scriptFile value, but because the value may + * have hanged during evaluation, don't assume it currently points to + * pathPtr. */ if (iPtr->scriptFile != NULL) { Tcl_DecrRefCount(iPtr->scriptFile); } @@ -2012,21 +1946,21 @@ if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } else if (result == TCL_ERROR) { /* - * Record information telling where the error occurred. + * Record information about where the error occurred. */ - size_t length; + int length; const char *pathString = TclGetStringFromObj(pathPtr, &length); - const unsigned int limit = 150; + const int limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", - (overflow ? limit : (unsigned int)length), pathString, + (overflow ? limit : length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } Tcl_DecrRefCount(objPtr); return result; @@ -2035,30 +1969,29 @@ /* *---------------------------------------------------------------------- * * Tcl_GetErrno -- * - * Gets the current value of the Tcl error code variable. This is - * currently the global variable "errno" but could in the future change + * Currently the global variable "errno", but could in the future change * to something else. * * Results: - * The value of the Tcl error code variable. + * The current Tcl error number. * * Side effects: - * None. Note that the value of the Tcl error code variable is UNDEFINED - * if a call to Tcl_SetErrno did not precede this call. + * None. The value of the Tcl error code variable is only defined if it + * was set by a previous call to Tcl_SetErrno. * *---------------------------------------------------------------------- */ int Tcl_GetErrno(void) { /* - * On some platforms, errno is really a thread local (implemented by the C - * library). + * On some platforms errno is thread-local, as implemented by the C + * library. */ return errno; } @@ -2065,30 +1998,30 @@ /* *---------------------------------------------------------------------- * * Tcl_SetErrno -- * - * Sets the Tcl error code variable to the supplied value. On some saner - * platforms this is actually a thread-local (this is implemented in the - * C library) but this is *really* unsafe to assume! + * Sets the Tcl error code to the given value. On some saner platforms + * this is implemented in the C library as a thread-local value , but this + * is *really* unsafe to assume! * * Results: * None. * * Side effects: - * Modifies the value of the Tcl error code variable. + * Modifies the the Tcl error code value. * *---------------------------------------------------------------------- */ void Tcl_SetErrno( int err) /* The new value. */ { /* - * On some platforms, errno is really a thread local (implemented by the C - * library). + * On some platforms, errno is implemented by the C library as a thread + * local value */ errno = err; } @@ -2095,28 +2028,25 @@ /* *---------------------------------------------------------------------- * * Tcl_PosixError -- * - * This function is typically called after UNIX kernel calls return - * errors. It stores machine-readable information about the error in - * errorCode field of interp and returns an information string for the - * caller's use. + * Typically called after a UNIX kernel call returns an error. Sets the + * interpreter errorCode to machine-parsable information about the error. * * Results: - * The return value is a human-readable string describing the error. + * A human-readable sring describing the error. * * Side effects: - * The errorCode field of the interp is set. + * Sets the errorCode value of the interpreter. * *---------------------------------------------------------------------- */ const char * Tcl_PosixError( - Tcl_Interp *interp) /* Interpreter whose errorCode field is to be - * set. */ + Tcl_Interp *interp) /* Interpreter to set the errorCode of */ { const char *id, *msg; msg = Tcl_ErrnoMsg(errno); id = Tcl_ErrnoId(); @@ -2128,15 +2058,14 @@ /* *---------------------------------------------------------------------- * * Tcl_FSStat -- + * Calls 'statProc' of the filesystem corresponding to pathPtr. * - * This function replaces the library version of stat and lsat. + * Replaces the standard library routines stat. * - * The appropriate function for the filesystem to which pathPtr belongs - * will be called. * * Results: * See stat documentation. * * Side effects: @@ -2145,12 +2074,14 @@ *---------------------------------------------------------------------- */ int Tcl_FSStat( - Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */ - Tcl_StatBuf *buf) /* Filled with results of stat call. */ + Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in + * current CP). */ + Tcl_StatBuf *buf) /* A buffer to hold the results of the call to + * stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->statProc != NULL) { return fsPtr->statProc(pathPtr, buf); @@ -2161,15 +2092,15 @@ /* *---------------------------------------------------------------------- * * Tcl_FSLstat -- + * Calls the 'lstatProc' of the filesystem corresponding to pathPtr. * - * This function replaces the library version of lstat. The appropriate - * function for the filesystem to which pathPtr belongs will be called. - * If no 'lstat' function is listed, but a 'stat' function is, then Tcl - * will fall back on the stat function. + * Replaces the library version of lstat. If the filesystem doesn't + * provide lstatProc but does provide statProc, Tcl falls back to + * statProc. * * Results: * See lstat documentation. * * Side effects: @@ -2178,12 +2109,13 @@ *---------------------------------------------------------------------- */ int Tcl_FSLstat( - Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */ - Tcl_StatBuf *buf) /* Filled with results of stat call. */ + Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in + current CP). */ + Tcl_StatBuf *buf) /* Filled with results of that call to stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { if (fsPtr->lstatProc != NULL) { @@ -2200,12 +2132,13 @@ /* *---------------------------------------------------------------------- * * Tcl_FSAccess -- * - * This function replaces the library version of access. The appropriate - * function for the filesystem to which pathPtr belongs will be called. + * Calls 'accessProc' of the filesystem corresponding to pathPtr. + * + * Replaces the library version of access. * * Results: * See access documentation. * * Side effects: @@ -2214,11 +2147,11 @@ *---------------------------------------------------------------------- */ int Tcl_FSAccess( - Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */ + Tcl_Obj *pathPtr, /* Pathname of file to access (in current CP). */ int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->accessProc != NULL) { @@ -2231,79 +2164,77 @@ /* *---------------------------------------------------------------------- * * Tcl_FSOpenFileChannel -- * - * The appropriate function for the filesystem to which pathPtr belongs - * will be called. + * Calls 'openfileChannelProc' of the filesystem corresponding to + * pathPtr. * * Results: - * The new channel or NULL, if the named file could not be opened. + * The new channel, or NULL if the named file could not be opened. * * Side effects: - * May open the channel and may cause creation of a file on the file - * system. + * Opens a channel, possibly creating the corresponding the file on the + * filesystem. * *---------------------------------------------------------------------- */ Tcl_Channel Tcl_FSOpenFileChannel( - Tcl_Interp *interp, /* Interpreter for error reporting; can be - * NULL. */ - Tcl_Obj *pathPtr, /* Name of file to open. */ + Tcl_Interp *interp, /* Interpreter for error reporting, or NULL */ + Tcl_Obj *pathPtr, /* Pathname of file to open. */ const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ - int permissions) /* If the open involves creating a file, with - * what modes to create it? */ + int permissions) /* What modes to use if opening the file + involves creating it. */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; - /* - * We need this just to ensure we return the correct error messages under - * some circumstances. - */ if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { + /* + * Return the correct error message. + */ return NULL; } fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) { int mode, seekFlag, binary; /* - * Parse the mode, picking up whether we want to seek to start with - * and/or set the channel automatically into binary mode. + * Parse the mode to determine whether to seek at the outset + * and/or set the channel into binary mode. */ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { return NULL; } /* - * Do the actual open() call. + * Open the file. */ retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode, permissions); if (retVal == NULL) { return NULL; } /* - * Apply appropriate flags parsed out above. + * Seek and/or set binary mode as determined above. */ if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END) < (Tcl_WideInt) 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not seek to end of file while opening \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); } Tcl_Close(NULL, retVal); return NULL; } if (binary) { @@ -2318,22 +2249,24 @@ Tcl_SetErrno(ENOENT); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } /* *---------------------------------------------------------------------- * * Tcl_FSUtime -- * - * This function replaces the library version of utime. The appropriate - * function for the filesystem to which pathPtr belongs will be called. + * Calls 'uTimeProc' of the filesystem corresponding to the given + * pathname. + * + * Replaces the library version of utime. * * Results: * See utime documentation. * * Side effects: @@ -2342,13 +2275,12 @@ *---------------------------------------------------------------------- */ int Tcl_FSUtime( - Tcl_Obj *pathPtr, /* File to change access/modification - * times. */ - struct utimbuf *tval) /* Structure containing access/modification + Tcl_Obj *pathPtr, /* Pathaname of file to call uTimeProc on */ + struct utimbuf *tval) /* Specifies the access/modification * times to use. Should not be modified. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->utimeProc != NULL) { @@ -2361,15 +2293,14 @@ /* *---------------------------------------------------------------------- * * NativeFileAttrStrings -- * - * This function implements the platform dependent 'file attributes' - * subcommand, for the native filesystem, for listing the set of possible - * attribute strings. This function is part of Tcl's native filesystem - * support, and is placed here because it is shared by Unix and Windows - * code. + * Implements the platform-dependent 'file attributes' subcommand for the + * native filesystem, for listing the set of possible attribute strings. + * Part of Tcl's native filesystem support. Placed here because it is used + * under both Unix and Windows. * * Results: * An array of strings * * Side effects: @@ -2378,31 +2309,33 @@ *---------------------------------------------------------------------- */ static const char *const * NativeFileAttrStrings( - Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef) + TCL_UNUSED(Tcl_Obj *), + TCL_UNUSED(Tcl_Obj **)) { return tclpFileAttrStrings; } /* *---------------------------------------------------------------------- * * NativeFileAttrsGet -- * - * This function implements the platform dependent 'file attributes' - * subcommand, for the native filesystem, for 'get' operations. This - * function is part of Tcl's native filesystem support, and is placed - * here because it is shared by Unix and Windows code. + * Implements the platform-dependent 'file attributes' subcommand for the + * native filesystem for 'get' operations. Part of Tcl's native + * filesystem support. Defined here because it is used under both Unix + * and Windows. * * Results: - * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK - * was returned) is likely to have a refCount of zero. Either way we must - * either store it somewhere (e.g. the Tcl result), or Incr/Decr its - * refCount to ensure it is properly freed. + * Standard Tcl return code. + * + * If there was no error, stores in objPtrRef a pointer to a new object + * having a refCount of zero and holding the result. The caller should + * store it somewhere, e.g. as the Tcl result, or decrement its refCount + * to free it. * * Side effects: * None. * *---------------------------------------------------------------------- @@ -2410,28 +2343,28 @@ static int NativeFileAttrsGet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ - Tcl_Obj *pathPtr, /* path of file we are operating on. */ - Tcl_Obj **objPtrRef) /* for output. */ + Tcl_Obj *pathPtr, /* Pathname of the file */ + Tcl_Obj **objPtrRef) /* Where to store the a pointer to the result. */ { return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef); } /* *---------------------------------------------------------------------- * * NativeFileAttrsSet -- * - * This function implements the platform dependent 'file attributes' - * subcommand, for the native filesystem, for 'set' operations. This - * function is part of Tcl's native filesystem support, and is placed - * here because it is shared by Unix and Windows code. + * Implements the platform-dependent 'file attributes' subcommand for the + * native filesystem for 'set' operations. A part of Tcl's native + * filesystem support, it is defined here because it is used under both + * Unix and Windows. * * Results: - * Standard Tcl return code. + * A standard Tcl return code. * * Side effects: * None. * *---------------------------------------------------------------------- @@ -2439,33 +2372,31 @@ static int NativeFileAttrsSet( Tcl_Interp *interp, /* The interpreter for error reporting. */ int index, /* index of the attribute command. */ - Tcl_Obj *pathPtr, /* path of file we are operating on. */ - Tcl_Obj *objPtr) /* set to this value. */ + Tcl_Obj *pathPtr, /* Pathname of the file */ + Tcl_Obj *objPtr) /* The value to set. */ { return tclpFileAttrProcs[index].setProc(interp, index, pathPtr, objPtr); } /* *---------------------------------------------------------------------- * * Tcl_FSFileAttrStrings -- * - * This function implements part of the hookable 'file attributes' - * subcommand. The appropriate function for the filesystem to which - * pathPtr belongs will be called. + * Implements part of the hookable 'file attributes' + * subcommand. + * + * Calls 'fileAttrStringsProc' of the filesystem corresponding to the + * given pathname. * * Results: - * The called function may either return an array of strings, or may - * instead return NULL and place a Tcl list into the given objPtrRef. - * Tcl will take that list and first increment its refCount before using - * it. On completion of that use, Tcl will decrement its refCount. Hence - * if the list should be disposed of by Tcl when done, it should have a - * refCount of zero, and if the list should not be disposed of, the - * filesystem should ensure it retains a refCount on the object. + * Returns an array of strings, or returns NULL and stores in objPtrRef + * a pointer to a new Tcl list having a refCount of zero, and containing + * the file attribute strings. * * Side effects: * None. * *---------------------------------------------------------------------- @@ -2488,28 +2419,29 @@ /* *---------------------------------------------------------------------- * * TclFSFileAttrIndex -- * - * Helper function for converting an attribute name to an index into the + * Given an attribute name, determines the index of the attribute in the * attribute table. * * Results: - * Tcl result code, index written to *indexPtr on result==TCL_OK + * A standard Tcl result code. + * + * If there is no error, stores the index in *indexPtr. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclFSFileAttrIndex( - Tcl_Obj *pathPtr, /* File whose attributes are to be indexed - * into. */ - const char *attributeName, /* The attribute being looked for. */ - int *indexPtr) /* Where to write the found index. */ + Tcl_Obj *pathPtr, /* Pathname of the file. */ + const char *attributeName, /* The name of the attribute. */ + int *indexPtr) /* A place to store the result. */ { Tcl_Obj *listObj = NULL; const char *const *attrTable; /* @@ -2565,19 +2497,20 @@ /* *---------------------------------------------------------------------- * * Tcl_FSFileAttrsGet -- * - * This function implements read access for the hookable 'file - * attributes' subcommand. The appropriate function for the filesystem to - * which pathPtr belongs will be called. + * Implements read access for the hookable 'file attributes' subcommand. + * + * Calls 'fileAttrsGetProc' of the filesystem corresponding to the given + * pathname. * * Results: - * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK - * was returned) is likely to have a refCount of zero. Either way we must - * either store it somewhere (e.g. the Tcl result), or Incr/Decr its - * refCount to ensure it is properly freed. + * A standard Tcl return code. + * + * On success, stores in objPtrRef a pointer to a new Tcl_Obj having a + * refCount of zero, and containing the result. * * Side effects: * None. * *---------------------------------------------------------------------- @@ -2584,13 +2517,13 @@ */ int Tcl_FSFileAttrsGet( Tcl_Interp *interp, /* The interpreter for error reporting. */ - int index, /* index of the attribute command. */ - Tcl_Obj *pathPtr, /* filename we are operating on. */ - Tcl_Obj **objPtrRef) /* for output. */ + int index, /* The index of the attribute command. */ + Tcl_Obj *pathPtr, /* The pathname of the file. */ + Tcl_Obj **objPtrRef) /* A place to store the result. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) { return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef); @@ -2602,16 +2535,18 @@ /* *---------------------------------------------------------------------- * * Tcl_FSFileAttrsSet -- * - * This function implements write access for the hookable 'file - * attributes' subcommand. The appropriate function for the filesystem to - * which pathPtr belongs will be called. + * Implements write access for the hookable 'file + * attributes' subcommand. + * + * Calls 'fileAttrsSetProc' for the filesystem corresponding to the given + * pathname. * * Results: - * Standard Tcl return code. + * A standard Tcl return code. * * Side effects: * None. * *---------------------------------------------------------------------- @@ -2618,13 +2553,13 @@ */ int Tcl_FSFileAttrsSet( Tcl_Interp *interp, /* The interpreter for error reporting. */ - int index, /* index of the attribute command. */ - Tcl_Obj *pathPtr, /* filename we are operating on. */ - Tcl_Obj *objPtr) /* Input value. */ + int index, /* The index of the attribute command. */ + Tcl_Obj *pathPtr, /* The pathname of the file. */ + Tcl_Obj *objPtr) /* A place to store the result. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) { return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr); @@ -2636,37 +2571,29 @@ /* *---------------------------------------------------------------------- * * Tcl_FSGetCwd -- * - * This function replaces the library version of getcwd(). - * - * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its own - * record (in a Tcl_Obj) of the cwd, and an attempt is made to synch this - * with the cwd's containing filesystem, if that filesystem provides a - * cwdProc (e.g. the native filesystem). - * - * Note that if Tcl's cwd is not in the native filesystem, then of course - * Tcl's cwd and the native cwd are different: extensions should - * therefore ensure they only access the cwd through this function to - * avoid confusion. - * - * If a global cwdPathPtr already exists, it is cached in the thread's - * private data structures and reference to the cached copy is returned, - * subject to a synchronisation attempt in that cwdPathPtr's fs. - * - * Otherwise, the chain of functions that have been "inserted" into the - * filesystem will be called in succession until either a value other - * than NULL is returned, or the entire list is visited. + * Replaces the library version of getcwd(). + * + * Most virtual filesystems do not implement cwdProc. Tcl maintains its + * own record of the current directory which it keeps synchronized with + * the filesystem corresponding to the pathname of the current directory + * if the filesystem provides a cwdProc (the native filesystem does). + * + * If Tcl's current directory is not in the native filesystem, Tcl's + * current directory and the current directory of the process are + * different. To avoid confusion, extensions should call Tcl_FSGetCwd to + * obtain the current directory from Tcl rather than from the operating + * system. * * Results: - * The result is a pointer to a Tcl_Obj specifying the current directory, - * or NULL if the current directory could not be determined. If NULL is - * returned, an error message is left in the interp's result. + * Returns a pointer to a Tcl_Obj having a refCount of 1 and containing + * the current thread's local copy of the global cwdPathPtr value. * - * The result already has its refCount incremented for the caller. When - * it is no longer needed, that refCount should be decremented. + * Returns NULL if the current directory could not be determined, and + * leaves an error message in the interpreter's result. * * Side effects: * Various objects may be freed and allocated. * *---------------------------------------------------------------------- @@ -2681,13 +2608,14 @@ if (TclFSCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; Tcl_Obj *retVal = NULL; /* - * We've never been called before, try to find a cwd. Call each of the - * "Tcl_GetCwd" function in succession. A non-NULL return value - * indicates the particular function has succeeded. + * This is the first time this routine has been called. Call + * 'getCwdProc' for each registered filsystems until one returns + * something other than NULL, which is a pointer to the pathname of the + * current directory. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); for (; (retVal == NULL) && (fsRecPtr != NULL); @@ -2708,27 +2636,27 @@ retCd = proc2(NULL); if (retCd != NULL) { Tcl_Obj *norm; /* - * Looks like a new current directory. + * Found the pathname of the current directory. */ retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); norm = TclFSNormalizeAbsolutePath(interp,retVal); if (norm != NULL) { /* - * We found a cwd, which is now in our global storage. We - * must make a copy. Norm already has a refCount of 1. - * - * Threading issue: note that multiple threads at system - * startup could in principle call this function - * simultaneously. They will therefore each set the - * cwdPathPtr independently. That behaviour is a bit - * peculiar, but should be fine. Once we have a cwd, we'll - * always be in the 'else' branch below which is simpler. + * Assign to global storage the pathname of the current directory + * and copy it into thread-local storage as well. + * + * At system startup multiple threads could in principle + * call this function simultaneously, which is a little + * peculiar, but should be fine given the mutex locks in + * FSUPdateCWD. Once some value is assigned to the global + * variable the 'else' branch below is always taken, which + * is simpler. */ FsUpdateCwd(norm, retCd); Tcl_DecrRefCount(norm); } else { @@ -2744,65 +2672,64 @@ Tcl_PosixError(interp))); } } Disclaim(); - /* - * Now the 'cwd' may NOT be normalized, at least on some platforms. - * For the sake of efficiency, we want a completely normalized cwd at - * all times. - * - * Finally, if retVal is NULL, we do not have a cwd, which could be - * problematic. - */ - if (retVal != NULL) { + /* + * On some platforms the pathname of the current directory might + * not be normalized. For efficiency, ensure that it is + * normalized. For the sake of efficiency, we want a completely + * normalized current working directory at all times. + */ + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* - * We found a cwd, which is now in our global storage. We must - * make a copy. Norm already has a refCount of 1. - * - * Threading issue: note that multiple threads at system - * startup could in principle call this function - * simultaneously. They will therefore each set the cwdPathPtr - * independently. That behaviour is a bit peculiar, but should - * be fine. Once we have a cwd, we'll always be in the 'else' - * branch below which is simpler. + * We found a current working directory, which is now in our + * global storage. We must make a copy. Norm already has a + * refCount of 1. + * + * Threading issue: Multiple threads at system startup could in + * principle call this function simultaneously. They will + * therefore each set the cwdPathPtr independently, which is a + * bit peculiar, but should be fine. Once we have a cwd, we'll + * always be in the 'else' branch below which is simpler. */ ClientData cd = (ClientData) Tcl_FSGetNativePath(norm); FsUpdateCwd(norm, TclNativeDupInternalRep(cd)); Tcl_DecrRefCount(norm); } Tcl_DecrRefCount(retVal); + } else { + /* + * retVal is NULL. There is no current directory, which could be + * problematic. + */ } } else { /* - * We already have a cwd cached, but we want to give the filesystem it - * is in a chance to check whether that cwd has changed, or is perhaps - * no longer accessible. This allows an error to be thrown if, say, - * the permissions on that directory have changed. + * There is a thread-local value for the pathname of the current + * directory. Give corresponding filesystem a chance update the value + * if it is out-of-date. This allows an error to be thrown if, for + * example, the permissions on the current working directory have + * changed. */ const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); ClientData retCd = NULL; Tcl_Obj *retVal, *norm; - /* - * If the filesystem couldn't be found, or if no cwd function exists - * for this filesystem, then we simply assume the cached cwd is ok. - * If we do call a cwd, we must watch for errors (if the cwd returns - * NULL). This ensures that, say, on Unix if the permissions of the - * cwd change, 'pwd' does actually throw the correct error in Tcl. - * (This is tested for in the test suite on unix). - */ - if (fsPtr == NULL || fsPtr->getCwdProc == NULL) { + /* + * There is no corresponding filesystem or the filesystem does not + * have a getCwd routine. Just assume current local value is ok. + */ goto cdDidNotChange; } if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) { retVal = fsPtr->getCwdProc(interp); @@ -2830,65 +2757,65 @@ retVal = fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); } - /* - * Check if the 'cwd' function returned an error; if so, reset the - * cwd. - */ - if (retVal == NULL) { + /* + * The current directory could not not determined. Reset the + * current direcory to ensure, for example, that 'pwd' does actually + * throw the correct error in Tcl. This is tested for in the test + * suite on unix. + */ + FsUpdateCwd(NULL, NULL); goto cdDidNotChange; } - /* - * Normalize the path. - */ - norm = TclFSNormalizeAbsolutePath(interp, retVal); - /* - * Check whether cwd has changed from the value previously stored in - * cwdPathPtr. Really 'norm' shouldn't be NULL, but we are careful. - */ - if (norm == NULL) { + /* + * 'norm' shouldn't ever be NULL, but we are careful. + */ + /* Do nothing */ if (retCd != NULL) { fsPtr->freeInternalRepProc(retCd); } } else if (norm == tsdPtr->cwdPathPtr) { goto cdEqual; } else { - /* - * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are normalized - * paths. Therefore we can be more efficient than calling - * 'Tcl_FSEqualPaths', and in addition avoid a nasty infinite loop - * bug when trying to normalize tsdPtr->cwdPathPtr. + /* + * Determine whether the filesystem's answer is the same as the + * cached local value. Since both 'norm' and 'tsdPtr->cwdPathPtr' + * are normalized pathnames, do something more efficient than + * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty + * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ - size_t len1, len2; + int len1, len2; const char *str1, *str2; str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = TclGetStringFromObj(norm, &len2); if ((len1 == len2) && (strcmp(str1, str2) == 0)) { /* - * If the paths were equal, we can be more efficient and - * retain the old path object which will probably already be - * shared. In this case we can simply free the normalized path - * we just calculated. + * The pathname values are equal so retain the old pathname + * object which is probably already shared and free the + * normalized pathname that was just produced. */ - cdEqual: Tcl_DecrRefCount(norm); if (retCd != NULL) { fsPtr->freeInternalRepProc(retCd); } } else { + /* + * The pathname of the current directory is not the same as + * this thread's local cached value. Replace the local value. + */ FsUpdateCwd(norm, retCd); Tcl_DecrRefCount(norm); } } Tcl_DecrRefCount(retVal); @@ -2905,21 +2832,23 @@ /* *---------------------------------------------------------------------- * * Tcl_FSChdir -- * - * This function replaces the library version of chdir(). + * Replaces the library version of chdir(). * - * The path is normalized and then passed to the filesystem which claims - * it. + * Calls 'chdirProc' of the filesystem that corresponds to the given + * pathname. * * Results: - * See chdir() documentation. If successful, we keep a record of the - * successful path in cwdPathPtr for subsequent calls to getcwd. + * See chdir() documentation. * * Side effects: - * See chdir() documentation. The global cwdPathPtr may change value. + * See chdir() documentation. + * + * On success stores in cwdPathPtr the pathname of the new current + * directory. * *---------------------------------------------------------------------- */ int @@ -2940,74 +2869,50 @@ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { if (fsPtr->chdirProc != NULL) { /* - * If this fails, an appropriate errno will have been stored using - * 'Tcl_SetErrno()'. + * If this fails Tcl_SetErrno() has already been called. */ retVal = fsPtr->chdirProc(pathPtr); } else { /* - * Fallback on stat-based implementation. + * Fallback to stat-based implementation. */ Tcl_StatBuf buf; - /* - * If the file can be stat'ed and is a directory and is readable, - * then we can chdir. If any of these actions fail, then - * 'Tcl_SetErrno()' should automatically have been called to set - * an appropriate error code. - */ - if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode)) && (Tcl_FSAccess(pathPtr, R_OK) == 0)) { /* - * We allow the chdir. + * stat was successful, and the file is a directory and is + * readable. Can proceed to change the current directory. */ retVal = 0; + } else { + /* + * 'Tcl_SetErrno()' has already been called. + */ } } } else { Tcl_SetErrno(ENOENT); } - /* - * The cwd changed, or an error was thrown. If an error was thrown, we can - * just continue (and that will report the error to the user). If there - * was no error we must assume that the cwd was actually changed to the - * normalized value we calculated above, and we must therefore cache that - * information. - * - * If the filesystem in question has a getCwdProc, then the correct logic - * which performs the part below is already part of the Tcl_FSGetCwd() - * call, so no need to replicate it again. This will have a side effect - * though. The private authoritative representation of the current working - * directory stored in cwdPathPtr in static memory will be out-of-sync - * with the real OS-maintained value. The first call to Tcl_FSGetCwd will - * however recalculate the private copy to match the OS-value so - * everything will work right. - * - * However, if there is no getCwdProc, then we _must_ update our private - * storage of the cwd, since this is the only opportunity to do that! - * - * Note: We currently call this block of code irrespective of whether - * there was a getCwdProc or not, but the code should all in principle - * work if we only call this block if fsPtr->getCwdProc == NULL. - */ - if (retVal == 0) { + + /* Assume that the cwd was actually changed to the normalized value + * just calculated, and cache that information. */ + /* - * Note that this normalized path may be different to what we found - * above (or at least a different object), if the filesystem epoch - * changed recently. This can actually happen with scripted documents - * very easily. Therefore we ask for the normalized path again (the - * correct value will have been cached as a result of the - * Tcl_FSGetFileSystemForPath call above anyway). + * If the filesystem epoch changed recently, the normalized pathname or + * its internal handle may be different from what was found above. + * This can easily be the case with scripted documents . Therefore get + * the normalized pathname again. The correct value will have been + * cached as a result of the Tcl_FSGetFileSystemForPath call, above. */ Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normDirName == NULL) { @@ -3015,49 +2920,64 @@ Tcl_SetErrno(ENOENT); return -1; } if (fsPtr == &tclNativeFilesystem) { - /* - * For the native filesystem, we keep a cache of the native - * representation of the cwd. But, we want to do that for the - * exact format that is returned by 'getcwd' (so that we can later - * compare the two representations for equality), which might not - * be exactly the same char-string as the native representation of - * the fully normalized path (e.g. on Windows there's a - * forward-slash vs backslash difference). Hence we ask for this - * again here. On Unix it might actually be true that we always - * have the correct form in the native rep in which case we could - * simply use: - * cd = Tcl_FSGetNativePath(pathPtr); - * instead. This should be examined by someone on Unix. - */ - ClientData cd; ClientData oldcd = tsdPtr->cwdClientData; /* - * Assumption we are using a filesystem version 2. + * Assume that the native filesystem has a getCwdProc and that it + * is at version 2. */ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc; cd = proc2(oldcd); if (cd != oldcd) { + /* + * Call getCwdProc() and store the resulting internal handle to + * compare things with it later. This might might not be + * exactly the same string as that of the fully normalized + * pathname. For example, for the Windows internal handle the + * separator is the backslash character. On Unix it might well + * be true that the internal handle is the fully normalized + * pathname and one could simply use: + * cd = Tcl_FSGetNativePath(pathPtr); + * but this can't be guaranteed in the general case. In fact, + * the internal handle could be any value the filesystem + * decides to use to identify a node. + */ + FsUpdateCwd(normDirName, cd); } } else { + /* + * Tcl_FSGetCwd() synchronizes the file-global cwdPathPtr if + * needed. However, if there is no 'getCwdProc', cwdPathPtr must be + * updated right now because there won't be another chance. This + * block of code is currently executed whether or not the + * filesystem provides a getCwdProc, but it should in principle + * work to only call this block if fsPtr->getCwdProc == NULL. + */ + FsUpdateCwd(normDirName, NULL); } - /* - * If the filesystem changed between old and new cwd - * force filesystem refresh on path objects. - */ if (oldFsPtr != NULL && fsPtr != oldFsPtr) { + /* + * The filesystem of the current directory is not the same as the + * filesystem of the previous current directory. Invalidate All + * FsPath objects. + */ Tcl_FSMountsChanged(NULL); } + } else { + /* + * The current directory is now changed or an error occurred and an + * error message is now set. Just continue. + */ } return retVal; } @@ -3064,68 +2984,49 @@ /* *---------------------------------------------------------------------- * * Tcl_FSLoadFile -- * - * Dynamically loads a binary code file into memory and returns the - * addresses of two functions within that file, if they are defined. The - * appropriate function for the filesystem to which pathPtr belongs will - * be called. - * - * Note that the native filesystem doesn't actually assume 'pathPtr' is a - * path. Rather it assumes pathPtr is either a path or just the name - * (tail) of a file which can be found somewhere in the environment's - * loadable path. This behaviour is not very compatible with virtual - * filesystems (and has other problems documented in the load man-page), - * so it is advised that full paths are always used. + * Loads a dynamic shared object by passing the given pathname unmodified + * to Tcl_LoadFile, and provides pointers to the functions named by 'sym1' + * and 'sym2', and another pointer to a function that unloads the object. * * Results: - * A standard Tcl completion code. If an error occurs, an error message - * is left in the interp's result. + * A standard Tcl completion code. If an error occurs, sets the + * interpreter's result to an error message. * * Side effects: - * New code suddenly appears in memory. This may later be unloaded by - * passing the clientData to the unloadProc. + * A dynamic shared object is loaded into memory. This may later be + * unloaded by passing the handlePtr to *unloadProcPtr. * *---------------------------------------------------------------------- */ int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Name of the file containing the desired - * code. */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object. + */ const char *sym1, const char *sym2, - /* Names of two functions to look up in the - * file's symbol table. */ + /* Names of two functions to find in the + * dynamic shared object. */ Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, - /* Where to return the addresses corresponding - * to sym1 and sym2. */ - Tcl_LoadHandle *handlePtr, /* Filled with token for dynamically loaded - * file which will be passed back to + /* Places to store pointers to the functions + * named by sym1 and sym2. */ + Tcl_LoadHandle *handlePtr, /* A place to store the token for the loaded + * object. Can be passed to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr) - /* Filled with address of Tcl_FSUnloadFileProc - * function which should be used for this - * file. */ + TCL_UNUSED(Tcl_FSUnloadFileProc **)) { const char *symbols[3]; void *procPtrs[2]; int res; - /* - * Initialize the arrays. - */ - symbols[0] = sym1; symbols[1] = sym2; symbols[2] = NULL; - /* - * Perform the load. - */ - res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr); if (res == TCL_OK) { *proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0]; *proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1]; } else { @@ -3138,127 +3039,123 @@ /* *---------------------------------------------------------------------- * * Tcl_LoadFile -- * - * Dynamically loads a binary code file into memory and returns the - * addresses of a number of given functions within that file, if they are - * defined. The appropriate function for the filesystem to which pathPtr - * belongs will be called. - * - * Note that the native filesystem doesn't actually assume 'pathPtr' is a - * path. Rather it assumes pathPtr is either a path or just the name - * (tail) of a file which can be found somewhere in the environment's - * loadable path. This behaviour is not very compatible with virtual - * filesystems (and has other problems documented in the load man-page), - * so it is advised that full paths are always used. + * Load a dynamic shared object by calling 'loadFileProc' of the + * filesystem corresponding to the given pathname, and then finds within + * the loaded object the functions named in symbols[]. + * + * The given pathname is passed unmodified to `loadFileProc`, which + * decides how to resolve it. On POSIX systems the native filesystem + * passes the given pathname to dlopen(), which resolves the filename + * according to its own set of rules. This behaviour is not very + * compatible with virtual filesystems, and has other problems as + * documented for [load], so it is recommended to use an absolute + * pathname. * * Results: - * A standard Tcl completion code. If an error occurs, an error message - * is left in the interp's result. + * A standard Tcl completion code. If an error occurs, sets the + * interpreter result to an error message. * * Side effects: - * New code suddenly appears in memory. This may later be unloaded by - * calling TclFS_UnloadFile. + * Memory is allocated for the new object. May be freed by calling + * TclFS_UnloadFile. * *---------------------------------------------------------------------- */ /* - * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY - * error) yet somehow trash some internal data structures which prevents the - * second and further shared libraries from getting properly loaded. Only the - * first is ok. We try to get around the issue by not unlinking, i.e., - * emulating the behaviour of the older HPUX which denied removal. + * Modern HPUX allows the unlink (no ETXTBSY error) yet somehow trashes some + * internal data structures, preventing any additional dynamic shared objects + * from getting properly loaded. Only the first is ok. Work around the issue + * by not unlinking, i.e., emulating the behaviour of the older HPUX which + * denied removal. * * Doing the unlink is also an issue within docker containers, whose AUFS * bungles this as well, see * https://github.com/dotcloud/docker/issues/1911 * - * For these situations the change below makes the execution of the unlink - * semi-controllable at runtime. - * - * An AUFS filesystem (if it can be detected) will force avoidance of - * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a - * users general request (unlink and not. - * - * By default the unlink is done (if not in AUFS). However if the variable is - * present and set to true (any integer > 0) then the unlink is skipped. */ static int skipUnlink( Tcl_Obj *shlibFile) { /* - * Order of testing: - * 1. On hpux we generally want to skip unlink in general - * - * Outside of hpux then: - * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, - * non-empty, => int) - * 3. For general AUFS environment (statfs, if available). - * - * Ad 2: This variable can disable/override the AUFS detection, i.e. for - * testing if a newer AUFS does not have the bug any more. - * - * Ad 3: This is conditionally compiled in. Condition currently must be - * set manually. This part needs proper tests in the configure(.in). - */ + * Unlinking is not performed in the following cases: + * + * 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). + * + */ + #ifdef hpux + (void)shlibFile; return 1; #else char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK"); if (skipstr && (skipstr[0] != '\0')) { return atoi(skipstr); } -#ifdef TCL_TEMPLOAD_NO_UNLINK +#ifndef TCL_TEMPLOAD_NO_UNLINK + (void)shlibFile; +#else +/* At built time TCL_TEMPLOAD_NO_UNLINK can be set manually to control whether + * this automatic overriding of unlink is included. + */ #ifndef NO_FSTATFS { struct statfs fs; /* * Have fstatfs. May not have the AUFS super magic ... Indeed our build * box is too old to have it directly in the headers. Define taken from * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h * http://aufs.sourceforge.net/ - * Better reference will be gladly taken. + * Better reference will be gladly accepted. */ #ifndef AUFS_SUPER_MAGIC +/* AUFS_SUPER_MAGIC can disable/override the AUFS detection, i.e. for + * testing if a newer AUFS does not have the bug any more. +*/ #define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's') #endif /* AUFS_SUPER_MAGIC */ - if ((statfs(TclGetString(shlibFile), &fs) == 0) + if ((statfs(Tcl_GetString(shlibFile), &fs) == 0) && (fs.f_type == AUFS_SUPER_MAGIC)) { return 1; } } #endif /* ... NO_FSTATFS */ #endif /* ... TCL_TEMPLOAD_NO_UNLINK */ /* - * Fallback: !hpux, no EV override, no AUFS (detection, nor detected): - * Don't skip + * No HPUX, environment variable override, or AUFS detected. Perform + * unlink. */ return 0; #endif /* hpux */ } int Tcl_LoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Name of the file containing the desired - * code. */ - const char *const symbols[],/* Names of functions to look up in the file's - * symbol table. */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic + * shared object. */ + const char *const symbols[],/* A null-terminated array of names of + * functions to find in the loaded object. */ int flags, /* Flags */ - void *procVPtrs, /* Where to return the addresses corresponding - * to symbols[]. */ - Tcl_LoadHandle *handlePtr) /* Filled with token for shared library - * information which can be used in - * TclpFindSymbol. */ + void *procVPtrs, /* A place to store pointers to the functions + * named by symbols[]. */ + Tcl_LoadHandle *handlePtr) /* A place to hold a token for the loaded object. + * Can be used by TclpFindSymbol. */ { void **procPtrs = (void **) procVPtrs; const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); const Tcl_Filesystem *copyFsPtr; Tcl_FSUnloadFileProc *unloadProcPtr; @@ -3274,11 +3171,11 @@ Tcl_SetErrno(ENOENT); return TCL_ERROR; } if (fsPtr->loadFileProc != NULL) { - int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc)) + int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc)) (interp, pathPtr, handlePtr, &unloadProcPtr, flags); if (retVal == TCL_OK) { if (*handlePtr == NULL) { return TCL_ERROR; @@ -3292,30 +3189,31 @@ return retVal; } } /* - * The filesystem doesn't support 'load', so we fall back on the following - * technique: - * - * First check if it is readable -- and exists! + * The filesystem doesn't support 'load'. Fall to the following: + */ + + /* + * Make sure the file is accessible. */ if (Tcl_FSAccess(pathPtr, R_OK) != 0) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load library \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + Tcl_GetString(pathPtr), Tcl_PosixError(interp))); } return TCL_ERROR; } #ifdef TCL_LOAD_FROM_MEMORY /* - * The platform supports loading code from memory, so ask for a buffer of - * the appropriate size, read the file into it and load the code from the - * buffer: + * The platform supports loading a dynamic shared object from memory. + * Create a sufficiently large buffer, read the file into it, and then load + * the dynamic shared object from the buffer: */ { int ret, size; void *buffer; @@ -3327,11 +3225,11 @@ goto mustCopyToTempAnyway; } size = (int) statBuf.st_size; /* - * Tcl_Read takes an int: check that file size isn't wide. + * Tcl_Read takes an int: Determine whether the file size is wide. */ if (size != (Tcl_WideInt) statBuf.st_size) { goto mustCopyToTempAnyway; } @@ -3342,11 +3240,11 @@ buffer = TclpLoadMemoryGetBuffer(interp, size); if (!buffer) { Tcl_Close(interp, data); goto mustCopyToTempAnyway; } - ret = Tcl_Read(data, buffer, size); + ret = Tcl_Read(data, (char *)buffer, size); Tcl_Close(interp, data); ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, &unloadProcPtr, flags); if (ret == TCL_OK && *handlePtr != NULL) { goto resolveSymbols; @@ -3358,12 +3256,11 @@ Tcl_ResetResult(interp); } #endif /* TCL_LOAD_FROM_MEMORY */ /* - * Get a temporary filename to use, first to copy the file into, and then - * to load. + * Get a temporary filename, first to copy the file into, and then to load. */ copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr); if (copyToPtr == NULL) { return TCL_ERROR; @@ -3371,15 +3268,19 @@ Tcl_IncrRefCount(copyToPtr); copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr); if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) { /* - * We already know we can't use Tcl_FSLoadFile from this filesystem, - * and we must avoid a possible infinite loop. Try to delete the file - * we probably created, and then exit. + * Tcl_FSLoadFile isn't available for the filesystem of the temporary + * file. In order to avoid a possible infinite loop, do not attempt to + * load further. */ + /* + * Try to delete the file we probably created and then exit. + */ + Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't load from current filesystem", -1)); @@ -3386,25 +3287,20 @@ } return TCL_ERROR; } if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) { - /* - * Cross-platform copy failed. - */ - Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); return TCL_ERROR; } #ifndef _WIN32 /* - * Do we need to set appropriate permissions on the file? This may be - * required on some systems. On Unix we could loop over the file - * attributes, and set any that are called "-permissions" to 0700. However - * we just do this directly, like this: + * It might be necessary on some systems to set the appropriate permissions + * on the file. On Unix we could loop over the file attributes and set any + * that are called "-permissions" to 0700, but just do it directly instead: */ { int index; Tcl_Obj *perm; @@ -3417,44 +3313,39 @@ Tcl_DecrRefCount(perm); } #endif /* - * We need to reset the result now, because the cross-filesystem copy may - * have stored the number of bytes in the result. + * The cross-filesystem copy may have stored the number of bytes in the + * result, so reset the result now. */ if (interp) { Tcl_ResetResult(interp); } retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs, &newLoadHandle); if (retVal != TCL_OK) { - /* - * The file didn't load successfully. - */ - Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); return retVal; } /* - * Try to delete the file immediately - this is possible in some OSes, and - * avoids any worries about leaving the copy laying around on exit. + * Try to delete the file immediately. Some operatings systems allow this, + * and it avoids leaving the copy laying around after exit. */ if (!skipUnlink(copyToPtr) && (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { Tcl_DecrRefCount(copyToPtr); /* - * We tell our caller about the real shared library which was loaded. - * Note that this does mean that the package list maintained by 'load' - * will store the original (vfs) path alongside the temporary load - * handle and unload proc ptr. + * Tell the caller all the details: The package list maintained by + * 'load' stores the original (vfs) pathname, the handle of object + * loaded from the temporary file, and the unloadProcPtr. */ *handlePtr = newLoadHandle; if (interp) { Tcl_ResetResult(interp); @@ -3461,61 +3352,55 @@ } return TCL_OK; } /* - * When we unload this file, we need to divert the unloading so we can - * unload and cleanup the temporary file correctly. + * Divert the unloading in order to unload and cleanup the temporary file. */ - tvdlPtr = Tcl_Alloc(sizeof(FsDivertLoad)); + tvdlPtr = (FsDivertLoad *)ckalloc(sizeof(FsDivertLoad)); /* - * Remember three pieces of information. This allows us to cleanup the - * diverted load completely, on platforms which allow proper unloading of - * code. + * Remember three pieces of information in order to clean up the diverted + * load completely on platforms which allow proper unloading of code. */ tvdlPtr->loadHandle = newLoadHandle; tvdlPtr->unloadProcPtr = newUnloadProcPtr; if (copyFsPtr != &tclNativeFilesystem) { - /* - * copyToPtr is already incremented for this reference. - */ - + /* refCount of copyToPtr is already incremented. */ tvdlPtr->divertedFile = copyToPtr; /* - * This is the filesystem we loaded it into. Since we have a reference - * to 'copyToPtr', we already have a refCount on this filesystem, so - * we don't need to worry about it disappearing on us. + * This is the filesystem for the temporary file the object was loaded + * from. A reference to copyToPtr is already stored in + * tvdlPtr->divertedFile, so need need to increment the refCount again. */ tvdlPtr->divertedFilesystem = copyFsPtr; tvdlPtr->divertedFileNativeRep = NULL; } else { /* - * We need the native rep. + * Grab the native representation. */ tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep( Tcl_FSGetInternalRep(copyToPtr, copyFsPtr)); /* - * We don't need or want references to the copied Tcl_Obj or the - * filesystem if it is the native one. + * Don't keeep a reference to the Tcl_Obj or the native filesystem. */ tvdlPtr->divertedFile = NULL; tvdlPtr->divertedFilesystem = NULL; Tcl_DecrRefCount(copyToPtr); } copyToPtr = NULL; - divertedLoadHandle = Tcl_Alloc(sizeof(struct Tcl_LoadHandle_)); + divertedLoadHandle = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); divertedLoadHandle->clientData = tvdlPtr; divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol; divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile; *handlePtr = divertedLoadHandle; @@ -3524,23 +3409,22 @@ } return retVal; resolveSymbols: /* - * At this point, *handlePtr is already set up to the handle for the - * loaded library. We now try to resolve the symbols. + * handlePtr now contains a token for the loaded object. + * Resolve the symbols. */ if (symbols != NULL) { for (i=0 ; symbols[i] != NULL; i++) { procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]); if (procPtrs[i] == NULL) { /* * At least one symbol in the list was not found. Unload the - * file, and report the problem back to the caller. - * (Tcl_FindSymbol should already have left an appropriate - * error message.) + * file and return an error code. Tcl_FindSymbol should have + * already left an appropriate error message. */ (*handlePtr)->unloadFileProcPtr(*handlePtr); *handlePtr = NULL; return TCL_ERROR; @@ -3553,20 +3437,21 @@ /* *---------------------------------------------------------------------- * * DivertFindSymbol -- * - * Find a symbol in a shared library loaded by copy-from-VFS. + * Find a symbol in a shared library loaded by making a copying a file + * from the virtual filesystem to a native filesystem. * *---------------------------------------------------------------------- */ static void * DivertFindSymbol( - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_LoadHandle loadHandle, /* Handle to the diverted module */ - const char *symbol) /* Symbol to resolve */ + Tcl_Interp *interp, /* The relevant interpreter. */ + Tcl_LoadHandle loadHandle, /* A handle to the diverted module. */ + const char *symbol) /* The name of symbol to resolve. */ { FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData; Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle; return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol); @@ -3575,137 +3460,128 @@ /* *---------------------------------------------------------------------- * * DivertUnloadFile -- * - * Unloads a file that has been loaded by copying from VFS to the native - * filesystem. - * - * Parameters: - * loadHandle -- Handle of the file to unload + * Unloads an object that was loaded from a temporary file copied from the + * virtual filesystem the native filesystem. * *---------------------------------------------------------------------- */ static void DivertUnloadFile( - Tcl_LoadHandle loadHandle) + Tcl_LoadHandle loadHandle) /* A handle for the loaded object. */ { FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData; Tcl_LoadHandle originalHandle; - /* - * This test should never trigger, since we give the client data in the - * function above. - */ - if (tvdlPtr == NULL) { + /* + * tvdlPtr was provided by Tcl_LoadFile so it should not be NULL here. + */ + return; } originalHandle = tvdlPtr->loadHandle; /* - * Call the real 'unloadfile' proc we actually used. It is very important - * that we call this first, so that the shared library is actually - * unloaded by the OS. Otherwise, the following 'delete' may well fail - * because the shared library is still in use. + * Call the real 'unloadfile' proc. This must be called first so that the + * shared library is actually unloaded by the OS. Otherwise, the following + * 'delete' may fail because the shared library is still in use. */ originalHandle->unloadFileProcPtr(originalHandle); /* - * What filesystem contains the temp copy of the library? + * Determine which filesystem contains the temporary copy of the file. */ if (tvdlPtr->divertedFilesystem == NULL) { /* - * It was the native filesystem, and we have a special function - * available just for this purpose, which we know works even at this - * late stage. + * Use the function for the native filsystem, which works works even at + * this late stage. */ TclpDeleteFile(tvdlPtr->divertedFileNativeRep); NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep); } else { /* - * Remove the temporary file we created. Note, we may crash here - * because encodings have been taken down already. + * Remove the temporary file. If encodings have been cleaned up + * already, this may crash. */ if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile) != TCL_OK) { /* - * The above may have failed because the filesystem, or something - * it depends upon (e.g. encodings) have been taken down because - * Tcl is exiting. - * - * We may need to work out how to delete this file more robustly - * (or give the filesystem the information it needs to delete the - * file more robustly). - * - * In particular, one problem might be that the filesystem cannot - * extract the information it needs from the above path object - * because Tcl's entire filesystem apparatus (the code in this - * file) has been finalized, and it refuses to pass the internal - * representation to the filesystem. + * This may have happened because Tcl is exiting, and encodings may + * have already been deleted or something else the filesystem + * depends on may be gone. + * + * TO DO: Figure out how to delete this file more robustly, or + * give the filesystem the information it needs to delete the file + * more robustly. One problem might be that the filesystem cannot + * extract the information it needs from the above pathname object + * because Tcl's entire filesystem apparatus (the code in this + * file) has been finalized and there is no way to get the native + * handle of the file. */ } /* - * And free up the allocations. This will also of course remove a - * refCount from the Tcl_Filesystem to which this file belongs, which - * could then free up the filesystem if we are exiting. + * This also decrements the refCount of the Tcl_Filesystem + * corresponding to this file. which might cause the filesystem to be + * deallocated if Tcl is exiting. */ Tcl_DecrRefCount(tvdlPtr->divertedFile); } - Tcl_Free(tvdlPtr); - Tcl_Free(loadHandle); + ckfree(tvdlPtr); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * * Tcl_FindSymbol -- * - * Find a symbol in a loaded library + * Find a symbol in a loaded object. + * + * Previously filesystem-specific, but has been made portable by having + * TclpDlopen return a structure that includes procedure pointers. * * Results: - * Returns a pointer to the symbol if found. If not found, returns NULL - * and leaves an error message in the interpreter result. - * - * This function was once filesystem-specific, but has been made portable by - * having TclpDlopen return a structure that includes procedure pointers. + * Returns a pointer to the symbol if found. Otherwise, sets + * an error message in the interpreter result and returns NULL. * *---------------------------------------------------------------------- */ void * Tcl_FindSymbol( - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_LoadHandle loadHandle, /* Handle to the loaded library */ - const char *symbol) /* Name of the symbol to resolve */ + Tcl_Interp *interp, /* The relevant interpreter. */ + Tcl_LoadHandle loadHandle, /* A handle for the loaded object. */ + const char *symbol) /* The name name of the symbol to resolve. */ { return loadHandle->findSymbolProcPtr(interp, loadHandle, symbol); } /* *---------------------------------------------------------------------- * * Tcl_FSUnloadFile -- * - * Unloads a library given its handle. Checks first that the library - * supports unloading. + * Unloads a loaded object if unloading is supported for the object. * *---------------------------------------------------------------------- */ int Tcl_FSUnloadFile( - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_LoadHandle handle) /* Handle of the file to unload */ + Tcl_Interp *interp, /* The relevant interpreter. */ + Tcl_LoadHandle handle) /* A handle for the object to unload. */ { if (handle->unloadFileProcPtr == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot unload: filesystem does not support unloading", @@ -3722,149 +3598,143 @@ /* *---------------------------------------------------------------------- * * TclFSUnloadTempFile -- * - * This function is called when we loaded a library of code via an - * intermediate temporary file. This function ensures the library is - * correctly unloaded and the temporary file is correctly deleted. + * Unloads an object loaded via temporary file from a virtual filesystem + * to a native filesystem. * * Results: * None. * * Side effects: - * The effects of the 'unload' function called, and of course the - * temporary file will be deleted. + * Frees resources for the loaded object and deletes the temporary file. * *---------------------------------------------------------------------- */ void TclFSUnloadTempFile( - Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to - * Tcl_FSLoadFile(). The loadHandle is a token - * that represents the loaded file. */ + Tcl_LoadHandle loadHandle) /* A handle for the object, as provided by a + * previous call to Tcl_FSLoadFile(). */ { FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle; - /* - * This test should never trigger, since we give the client data in the - * function above. - */ - if (tvdlPtr == NULL) { + /* + * tvdlPtr was provided by Tcl_LoadFile so it should not be NULL here. + */ return; } - /* - * Call the real 'unloadfile' proc we actually used. It is very important - * that we call this first, so that the shared library is actually - * unloaded by the OS. Otherwise, the following 'delete' may well fail - * because the shared library is still in use. - */ - if (tvdlPtr->unloadProcPtr != NULL) { + /* + * 'unloadProcPtr' must be called first so that the shared library is + * actually unloaded by the OS. Otherwise, the following 'delete' may + * well fail because the shared library is still in use. + */ + tvdlPtr->unloadProcPtr(tvdlPtr->loadHandle); } if (tvdlPtr->divertedFilesystem == NULL) { /* - * It was the native filesystem, and we have a special function - * available just for this purpose, which we know works even at this + * Call the function for the native fileystem, which works even at this * late stage. */ TclpDeleteFile(tvdlPtr->divertedFileNativeRep); NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep); } else { /* - * Remove the temporary file we created. Note, we may crash here - * because encodings have been taken down already. + * Remove the temporary file that was created. If encodings have + * already been freed because the interpreter is exiting this may + * crash. */ if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile) != TCL_OK) { /* - * The above may have failed because the filesystem, or something - * it depends upon (e.g. encodings) have been taken down because - * Tcl is exiting. - * - * We may need to work out how to delete this file more robustly - * (or give the filesystem the information it needs to delete the - * file more robustly). - * - * In particular, one problem might be that the filesystem cannot - * extract the information it needs from the above path object - * because Tcl's entire filesystem apparatus (the code in this - * file) has been finalized, and it refuses to pass the internal - * representation to the filesystem. + * This may have happened because Tcl is exiting and encodings may + * have already been deleted, or something else the filesystem + * depends on may be gone. + * + * TO DO: Figure out how to delete this file more robustly, or + * give the filesystem the information it needs to delete the file + * more robustly. One problem might be that the filesystem cannot + * extract the information it needs from the above pathname object + * because Tcl's entire filesystem apparatus (the code in this + * file) has been finalized and there is no way to get the native + * handle of the file. */ } /* - * And free up the allocations. This will also of course remove a - * refCount from the Tcl_Filesystem to which this file belongs, which - * could then free up the filesystem if we are exiting. + * This also decrements the refCount of the Tcl_Filesystem + * corresponding to this file. which might case filesystem to be freed + * if Tcl is exiting. */ Tcl_DecrRefCount(tvdlPtr->divertedFile); } - Tcl_Free(tvdlPtr); + ckfree(tvdlPtr); } /* *--------------------------------------------------------------------------- * * Tcl_FSLink -- * - * This function replaces the library version of readlink() and can also - * be used to make links. The appropriate function for the filesystem to - * which pathPtr belongs will be called. + * Creates or inspects a link by calling 'linkProc' of the filesystem + * corresponding to the given pathname. Replaces the library version of + * readlink(). * * Results: - * If toPtr is NULL, then the result is a Tcl_Obj specifying the contents - * of the symbolic link given by 'pathPtr', or NULL if the symbolic link - * could not be read. The result is owned by the caller, which should - * call Tcl_DecrRefCount when the result is no longer needed. - * - * If toPtr is non-NULL, then the result is toPtr if the link action was - * successful, or NULL if not. In this case the result has no additional - * reference count, and need not be freed. The actual action to perform - * is given by the 'linkAction' flags, which is an or'd combination of: + * If toPtr is NULL, a Tcl_Obj containing the value the symbolic link for + * 'pathPtr', or NULL if a symbolic link was not accessible. The caller + * should Tcl_DecrRefCount on the result to release it. Otherwise NULL. + * + * In this case the result has no additional reference count and need not + * be freed. The actual action to perform is given by the 'linkAction' + * flags, which is a combination of: * * TCL_CREATE_SYMBOLIC_LINK * TCL_CREATE_HARD_LINK * - * Note that most filesystems will not support linking across to - * different filesystems, so this function will usually fail unless toPtr - * is in the same FS as pathPtr. + * Most filesystems do not support linking across to different + * filesystems, so this function usually fails if the filesystem + * corresponding to toPtr is not the same as the filesystem corresponding + * to pathPtr. * * Side effects: - * See readlink() documentation. A new filesystem link object may appear. + * Creates or sets a link if toPtr is not NULL. + * + * See readlink(). * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSLink( - Tcl_Obj *pathPtr, /* Path of file to readlink or link. */ - Tcl_Obj *toPtr, /* NULL or path to be linked to. */ + Tcl_Obj *pathPtr, /* Pathaname of file. */ + 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); if (fsPtr != NULL && fsPtr->linkProc != NULL) { return fsPtr->linkProc(pathPtr, toPtr, linkAction); } /* - * If S_IFLNK isn't defined it means that the machine doesn't support - * symbolic links, so the file can't possibly be a symbolic link. Generate - * an EINVAL error, which is what happens on machines that do support - * symbolic links when you invoke readlink on a file that isn't a symbolic - * link. + * If S_IFLNK isn't defined the machine doesn't support symbolic links, so + * the file can't possibly be a symbolic link. Generate an EINVAL error, + * which is what happens on machines that do support symbolic links when + * readlink is called for a file that isn't a symbolic link. */ #ifndef S_IFLNK errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */ #else @@ -3876,20 +3746,13 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSListVolumes -- * - * Lists the currently mounted volumes. The chain of functions that have - * been "inserted" into the filesystem will be called in succession; each - * may return a list of volumes, all of which are added to the result - * until all mounted file systems are listed. - * - * Notice that we assume the lists returned by each filesystem (if non - * NULL) have been given a refCount for us already. However, we are NOT - * allowed to hang on to the list itself (it belongs to the filesystem we - * called). Therefore we quite naturally add its contents to the result - * we are building, and then decrement the refCount. + * Lists the currently mounted volumes by calling `listVolumesProc` of + * each registered filesystem, and combining the results to form a list of + * volumes. * * Results: * The list of volumes, in an object which has refCount 0. * * Side effects: @@ -3903,14 +3766,13 @@ { FilesystemRecord *fsRecPtr; Tcl_Obj *resultPtr = Tcl_NewObj(); /* - * Call each of the "listVolumes" function in succession. A non-NULL - * return value indicates the particular function has succeeded. We call - * all the functions registered, since we want a list of all drives from - * all filesystems. + * Call each "listVolumes" function of each registered filesystem in + * succession. A non-NULL return value indicates the particular function + * has succeeded. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); while (fsRecPtr != NULL) { @@ -3917,10 +3779,14 @@ if (fsRecPtr->fsPtr->listVolumesProc != NULL) { Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes); + /* The refCount of each list returned by a `listVolumesProc` is + * already incremented. Do not hang onto the list, though. It + * belongs to the filesystem. Add its contents to * the result + * we are building, and then decrement the refCount. */ Tcl_DecrRefCount(thisFsVolumes); } } fsRecPtr = fsRecPtr->nextPtr; } @@ -3932,37 +3798,34 @@ /* *--------------------------------------------------------------------------- * * FsListMounts -- * - * List all mounts within the given directory, which match the given - * pattern. + * Lists the mounts mathing the given pattern in the given directory. * * Results: - * The list of mounts, in a list object which has refCount 0, or NULL if - * we didn't even find any filesystems to try to list mounts. + * A list, having a refCount of 0, of the matching mounts, or NULL if no + * search was performed because no filesystem provided a search routine. * * Side effects: - * None + * None. * *--------------------------------------------------------------------------- */ static Tcl_Obj * FsListMounts( - Tcl_Obj *pathPtr, /* Contains path to directory to search. */ + Tcl_Obj *pathPtr, /* Pathname of directory to search. */ const char *pattern) /* Pattern to match against. */ { FilesystemRecord *fsRecPtr; Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL }; Tcl_Obj *resultPtr = NULL; /* - * Call each of the "matchInDirectory" functions in succession, with the - * specific type information 'mountsOnly'. A non-NULL return value - * indicates the particular function has succeeded. We call all the - * functions registered, since we want a list from each filesystems. + * Call the matchInDirectory function of each registered filesystem, + * passing it 'mountsOnly'. Results accumulate in resultPtr. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); while (fsRecPtr != NULL) { @@ -3984,38 +3847,35 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSSplitPath -- * - * This function takes the given Tcl_Obj, which should be a valid path, - * and returns a Tcl List object containing each segment of that path as - * an element. + * Splits a pathname into its components. * * Results: - * Returns list object with refCount of zero. If the passed in lenPtr is - * non-NULL, we use it to return the number of elements in the returned - * list. + * A list with refCount of zero. * * Side effects: - * None. + * If lenPtr is not null, sets it to the number of elements in the result. * *--------------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSSplitPath( - Tcl_Obj *pathPtr, /* Path to split. */ - int *lenPtr) /* int to store number of path elements. */ + Tcl_Obj *pathPtr, /* The pathname to split. */ + int *lenPtr) /* A place to hold the number of pathname + * elements. */ { - Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */ + Tcl_Obj *result = NULL; /* Just to squelch gcc warnings. */ const Tcl_Filesystem *fsPtr; char separator = '/'; int driveNameLength; const char *p; /* - * Perform platform specific splitting. + * Perform platform-specific splitting. */ if (TclFSGetPathType(pathPtr, &fsPtr, &driveNameLength) == TCL_PATH_ABSOLUTE) { if (fsPtr == &tclNativeFilesystem) { @@ -4023,38 +3883,36 @@ } } else { return TclpNativeSplitPath(pathPtr, lenPtr); } - /* - * We assume separators are single characters. - */ + /* Assume each separator is a single character. */ if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr); if (sep != NULL) { Tcl_IncrRefCount(sep); - separator = TclGetString(sep)[0]; + separator = Tcl_GetString(sep)[0]; Tcl_DecrRefCount(sep); } } /* - * Place the drive name as first element of the result list. The drive - * name may contain strange characters, like colons and multiple forward - * slashes (for example 'ftp://' is a valid vfs drive name) + * Add the drive name as first element of the result. The drive name may + * contain strange characters like colons and sequences of forward slashes + * For example, 'ftp://' is a valid drive name. */ result = Tcl_NewObj(); - p = TclGetString(pathPtr); + p = Tcl_GetString(pathPtr); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(p, driveNameLength)); p += driveNameLength; /* - * Add the remaining path elements to the list. + * Add the remaining pathname elements to the list. */ for (;;) { const char *elementStart = p; int length; @@ -4077,14 +3935,10 @@ if (*p++ == '\0') { break; } } - /* - * Compute the number of elements in the result. - */ - if (lenPtr != NULL) { TclListObjLength(NULL, result, lenPtr); } return result; } @@ -4091,41 +3945,37 @@ /* *---------------------------------------------------------------------- * * TclGetPathType -- * - * Helper function used by FSGetPathType. + * Helper function used by TclFSGetPathType and TclJoinPath. * * Results: - * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or - * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and - * only if it is non-NULL and the function's return value is - * TCL_PATH_ABSOLUTE. + * One of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or + * TCL_PATH_VOLUME_RELATIVE. * * Side effects: - * None. + * See **filesystemPtrptr, *driveNameLengthPtr and **driveNameRef, * *---------------------------------------------------------------------- */ Tcl_PathType TclGetPathType( - Tcl_Obj *pathPtr, /* Path to determine type for. */ + Tcl_Obj *pathPtr, /* Pathname to determine type of. */ const Tcl_Filesystem **filesystemPtrPtr, - /* If absolute path and this is not NULL, then - * set to the filesystem which claims this - * path. */ - int *driveNameLengthPtr, /* If the path is absolute, and this is - * non-NULL, then set to the length of the - * driveName. */ - Tcl_Obj **driveNameRef) /* If the path is absolute, and this is - * non-NULL, then set to the name of the - * drive, network-volume which contains the - * path, already with a refCount for the - * caller. */ -{ - size_t pathLen; + /* If not NULL, a place in which to store a + * pointer to the filesystem for this pathname + * if it is absolute. */ + int *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 + * refCount of 1, and whose value is the name + * of the volume. */ +{ + int pathLen; const char *path = TclGetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr, driveNameRef); @@ -4143,18 +3993,18 @@ /* *---------------------------------------------------------------------- * * TclFSNonnativePathType -- * - * Helper function used by TclGetPathType. Its purpose is to check - * whether the given path starts with a string which corresponds to a - * file volume in any registered filesystem except the native one. For - * speed and historical reasons the native filesystem has special - * hard-coded checks dotted here and there in the filesystem code. + * Helper function used by TclGetPathType. Checks whether the given + * pathname starts with a string which corresponds to a file volume in + * some registered filesystem other than the native one. For speed and + * historical reasons the native filesystem has special hard-coded checks + * dotted here and there in the filesystem code. * * Results: - * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem + * One of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem * reference will be set if and only if it is non-NULL and the function's * return value is TCL_PATH_ABSOLUTE. * * Side effects: * None. @@ -4162,53 +4012,49 @@ *---------------------------------------------------------------------- */ Tcl_PathType TclFSNonnativePathType( - const char *path, /* Path to determine type for. */ - int pathLen, /* Length of the path. */ + const char *path, /* Pathname to determine the type of. */ + int pathLen, /* Length of the pathname. */ const Tcl_Filesystem **filesystemPtrPtr, - /* If absolute path and this is not NULL, then - * set to the filesystem which claims this - * path. */ - int *driveNameLengthPtr, /* If the path is absolute, and this is - * non-NULL, then set to the length of the - * driveName. */ - Tcl_Obj **driveNameRef) /* If the path is absolute, and this is - * non-NULL, then set to the name of the - * drive, network-volume which contains the - * path, already with a refCount for the - * caller. */ + /* If not NULL, a place to store a pointer to + * the filesystem for this pathname when it is + * an absolute pathname. */ + int *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 + * volume if the pathname is absolute. */ { FilesystemRecord *fsRecPtr; Tcl_PathType type = TCL_PATH_RELATIVE; /* - * Call each of the "listVolumes" function in succession, checking whether - * the given path is an absolute path on any of the volumes returned (this - * is done by checking whether the path's prefix matches). + * Determine whether the given pathname is an absolute pathname on some + * filesystem other than the native filesystem. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); while (fsRecPtr != NULL) { /* - * We want to skip the native filesystem in this loop because - * otherwise we won't necessarily pass all the Tcl testsuite - this is - * because some of the tests artificially change the current platform - * (between win, unix) but the list of volumes we get by calling - * fsRecPtr->fsPtr->listVolumesProc will reflect the current (real) - * platform only and this may cause some tests to fail. In particular, - * on Unix '/' will match the beginning of certain absolute Windows - * paths starting '//' and those tests will go wrong. - * - * Besides these test-suite issues, there is one other reason to skip - * the native filesystem - since the tclFilename.c code has nice fast - * 'absolute path' checkers, we don't want to waste time repeating - * that effort here, and this function is actually called quite often, - * so if we can save the overhead of the native filesystem returning - * us a list of volumes all the time, it is better. + * Skip the the native filesystem because otherwise some of the tests + * in the Tcl testsuite might fail because some of the tests + * artificially change the current platform (between win, unix) but the + * list of volumes obtained by calling fsRecPtr->fsPtr->listVolumesProc + * reflects the current (real) platform only. In particular, on Unix + * '/' matchs the beginning of certain absolute Windows pathnames + * starting '//' and those tests go wrong. + * + * There is another reason to skip the native filesystem: Since the + * tclFilename.c code has nice fast 'absolute path' checkers, there is + * no reason to waste time doing that in this frequently-called + * function. It is better to save the overhead of the native + * filesystem continuously returning a list of volumes. */ if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (fsRecPtr->fsPtr->listVolumesProc != NULL)) { int numVolumes; @@ -4217,32 +4063,31 @@ if (thisFsVolumes != NULL) { if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes) != TCL_OK) { /* * This is VERY bad; the listVolumesProc didn't return a - * valid list. Set numVolumes to -1 so that we skip the - * while loop below and just return with the current value - * of 'type'. + * valid list. Set numVolumes to -1 to skip the loop below + * and just return with the current value of 'type'. * - * It would be better if we could signal an error here - * (but Tcl_Panic seems a bit excessive). + * It would be better to signal an error here, but + * Tcl_Panic seems a bit excessive. */ numVolumes = -1; } while (numVolumes > 0) { Tcl_Obj *vol; - size_t len; + int len; const char *strVol; numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); strVol = TclGetStringFromObj(vol,&len); - if ((size_t) pathLen < len) { + if (pathLen < len) { continue; } - if (strncmp(strVol, path, len) == 0) { + if (strncmp(strVol, path, (size_t) len) == 0) { type = TCL_PATH_ABSOLUTE; if (filesystemPtrPtr != NULL) { *filesystemPtrPtr = fsRecPtr->fsPtr; } if (driveNameLengthPtr != NULL) { @@ -4256,11 +4101,11 @@ } } Tcl_DecrRefCount(thisFsVolumes); if (type == TCL_PATH_ABSOLUTE) { /* - * We don't need to examine any more filesystems. + * No need to to examine additional filesystems. */ break; } } @@ -4274,29 +4119,29 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSRenameFile -- * - * If the two paths given belong to the same filesystem, we call that - * filesystems rename function. Otherwise we simply return the POSIX - * error 'EXDEV', and -1. + * If the two pathnames correspond to the same filesystem, call + * 'renameFileProc' of that filesystem. Otherwise return the POSIX error + * 'EXDEV', and -1. * * Results: - * Standard Tcl error code if a function was called. + * A standard Tcl error code if a rename function was called, or -1 + * otherwise. * * Side effects: * A file may be renamed. * *--------------------------------------------------------------------------- */ int Tcl_FSRenameFile( - Tcl_Obj *srcPathPtr, /* Pathname of file or dir to be renamed - * (UTF-8). */ - Tcl_Obj *destPathPtr) /* New pathname of file or directory - * (UTF-8). */ + Tcl_Obj *srcPathPtr, /* The pathname of a file or directory to be + renamed. */ + Tcl_Obj *destPathPtr) /* The new pathname for the file. */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr); @@ -4315,31 +4160,31 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSCopyFile -- * - * If the two paths given belong to the same filesystem, we call that - * filesystem's copy function. Otherwise we simply return the POSIX error - * 'EXDEV', and -1. + * If both pathnames correspond to the same filesystem, calls + * 'copyFileProc' of that filesystem. * - * Note that in the native filesystems, 'copyFileProc' is defined to copy - * soft links (i.e. it copies the links themselves, not the things they - * point to). + * In the native filesystems, 'copyFileProc' copies a link itself, not the + * thing the link points to. * * Results: - * Standard Tcl error code if a function was called. + * A standard Tcl return code if a copyFileProc was called, or -1 + * otherwise. * * Side effects: - * A file may be copied. + * A file might be copied. The POSIX error 'EXDEV' is set if a copy + * function was not called. * *--------------------------------------------------------------------------- */ int Tcl_FSCopyFile( - Tcl_Obj *srcPathPtr, /* Pathname of file to be copied (UTF-8). */ - Tcl_Obj *destPathPtr) /* Pathname of file to copy to (UTF-8). */ + Tcl_Obj *srcPathPtr, /* The pathname of file to be copied. */ + Tcl_Obj *destPathPtr) /* The new pathname to copy the file to. */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr); @@ -4357,28 +4202,27 @@ /* *--------------------------------------------------------------------------- * * TclCrossFilesystemCopy -- * - * Helper for above function, and for Tcl_FSLoadFile, to copy files from - * one filesystem to another. This function will overwrite the target - * file if it already exists. + * Helper for Tcl_FSCopyFile and Tcl_FSLoadFile. Copies a file from one + * filesystem to another, overwiting any file that already exists. * * Results: - * Standard Tcl error code. + * A standard Tcl return code. * * Side effects: - * A file may be created. + * A file may be copied. * *--------------------------------------------------------------------------- */ int TclCrossFilesystemCopy( Tcl_Interp *interp, /* For error messages. */ - Tcl_Obj *source, /* Pathname of file to be copied (UTF-8). */ - Tcl_Obj *target) /* Pathname of file to copy to (UTF-8). */ + Tcl_Obj *source, /* Pathname of file to be copied. */ + Tcl_Obj *target) /* Pathname to copy the file to. */ { int result = TCL_ERROR; int prot = 0666; Tcl_Channel in, out; Tcl_StatBuf sourceStatBuf; @@ -4385,36 +4229,36 @@ struct utimbuf tval; out = Tcl_FSOpenFileChannel(interp, target, "wb", prot); if (out == NULL) { /* - * It looks like we cannot copy it over. Bail out... + * Failed to open an output channel. Bail out. */ goto done; } in = Tcl_FSOpenFileChannel(interp, source, "rb", prot); if (in == NULL) { /* - * This is very strange, caller should have checked this... + * Could not open an input channel. Why didn't the caller check this? */ Tcl_Close(interp, out); goto done; } /* - * Copy it synchronously. We might wish to add an asynchronous option to - * support vfs's which are slow (e.g. network sockets). + * Copy the file synchronously. TO DO: Maybe add an asynchronous option + * to support virtual filesystems that are slow (e.g. network sockets). */ if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) { result = TCL_OK; } /* - * If the copy failed, assume that copy channel left a good error message. + * If the copy failed, assume that copy channel left an error message. */ Tcl_Close(interp, in); Tcl_Close(interp, out); @@ -4421,12 +4265,12 @@ /* * Set modification date of copied file. */ if (Tcl_FSLstat(source, &sourceStatBuf) == 0) { - tval.actime = sourceStatBuf.st_atime; - tval.modtime = sourceStatBuf.st_mtime; + tval.actime = Tcl_GetAccessTimeFromStat(&sourceStatBuf); + tval.modtime = Tcl_GetModificationTimeFromStat(&sourceStatBuf); Tcl_FSUtime(target, &tval); } done: return result; @@ -4435,15 +4279,15 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSDeleteFile -- * - * The appropriate function for the filesystem to which pathPtr belongs - * will be called. + * Calls 'deleteFileProc' of the filesystem corresponding to the given + * pathname. * * Results: - * Standard Tcl error code. + * A standard Tcl return code. * * Side effects: * A file may be deleted. * *--------------------------------------------------------------------------- @@ -4465,18 +4309,19 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSCreateDirectory -- * - * The appropriate function for the filesystem to which pathPtr belongs - * will be called. + * Calls 'createDirectoryProc' of the filesystem corresponding to the + * given pathname. * * Results: - * Standard Tcl error code. + * A standard Tcl return code, or -1 if no createDirectoryProc is found. * * Side effects: - * A directory may be created. + * A directory may be created. POSIX error 'ENOENT' is set if no + * createDirectoryProc is found. * *--------------------------------------------------------------------------- */ int @@ -4495,31 +4340,34 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSCopyDirectory -- * - * If the two paths given belong to the same filesystem, we call that - * filesystems copy-directory function. Otherwise we simply return the - * POSIX error 'EXDEV', and -1. + * If both pathnames correspond to the the same filesystem, calls + * 'copyDirectoryProc' of that filesystem. * * Results: - * Standard Tcl error code if a function was called. + * A standard Tcl return code, or -1 if no 'copyDirectoryProc' is found. * * Side effects: - * A directory may be copied. + * A directory may be copied. POSIX error 'EXDEV' is set if no + * copyDirectoryProc is found. * *--------------------------------------------------------------------------- */ int Tcl_FSCopyDirectory( - Tcl_Obj *srcPathPtr, /* Pathname of directory to be copied - * (UTF-8). */ - Tcl_Obj *destPathPtr, /* Pathname of target directory (UTF-8). */ - Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new - * object containing name of file causing - * error, with refCount 1. */ + Tcl_Obj *srcPathPtr, /* + * The pathname of the directory to be copied. + */ + Tcl_Obj *destPathPtr, /* The pathname of the target directory. */ + Tcl_Obj **errorPtr) /* If not NULL, and there is an error, a place + * to store a pointer to a new object, with + * its refCount already incremented, and + * containing the pathname name of file + * causing the error. */ { int retVal = -1; const Tcl_Filesystem *fsPtr, *fsPtr2; fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr); @@ -4537,61 +4385,58 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSRemoveDirectory -- * - * The appropriate function for the filesystem to which pathPtr belongs - * will be called. + * Calls 'removeDirectoryProc' of the filesystem corresponding to remove + * pathPtr. * * Results: - * Standard Tcl error code. + * A standard Tcl return code, or -1 if no removeDirectoryProc is found. * * Side effects: - * A directory may be deleted. + * A directory may be removed. POSIX error 'ENOENT' is set if no + * removeDirectoryProc is found. * *--------------------------------------------------------------------------- */ int Tcl_FSRemoveDirectory( - Tcl_Obj *pathPtr, /* Pathname of directory to be removed - * (UTF-8). */ - int recursive, /* If non-zero, removes directories that are - * nonempty. Otherwise, will only remove empty - * directories. */ - Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new - * object containing name of file causing - * error, with refCount 1. */ + Tcl_Obj *pathPtr, /* The pathname of the directory to be removed. + */ + int recursive, /* If zero, removes only an empty directory. + * Otherwise, removes the directory and all its + * contents. */ + Tcl_Obj **errorPtr) /* If not NULL and an error occurs, stores a + * place to store a a pointer to a new + * object having a refCount of 1 and containing + * the name of the file that produced an error. + * */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) { Tcl_SetErrno(ENOENT); return -1; } - /* - * When working recursively, we check whether the cwd lies inside this - * directory and move it if it does. - */ - if (recursive) { Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); - if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; - size_t cwdLen, normLen; + int cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { normPathStr = TclGetStringFromObj(normPath, &normLen); cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen); if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr, - normLen) == 0)) { + (size_t) normLen) == 0)) { /* - * The cwd is inside the directory, so we perform a 'cd - * [file dirname $path]'. + * The cwd is inside the directory to be removed. Change + * the cwd to [file dirname $path]. */ Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr, TCL_PATH_DIRNAME); @@ -4608,20 +4453,18 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSGetFileSystemForPath -- * - * This function determines which filesystem to use for a particular path - * object, and returns the filesystem which accepts this file. If no - * filesystem will accept this object as a valid file path, then NULL is - * returned. + * Produces the filesystem that corresponds to the given pathname. * * Results: - * NULL or a filesystem which will accept this path. + * The corresponding Tcl_Filesystem, or NULL if the pathname is invalid. * * Side effects: - * The object may be converted to a path type. + * The internal representation of fsPtrPtr is converted to fsPathType if + * needed, and that internal representation is updated as needed. * *--------------------------------------------------------------------------- */ const Tcl_Filesystem * @@ -4634,57 +4477,54 @@ if (pathPtr == NULL) { Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object"); return NULL; } - /* - * If the object has a refCount of zero, we reject it. This is to avoid - * possible segfaults or nondeterministic memory leaks (i.e. the user - * doesn't know if they should decrement the ref count on return or not). - */ - if (pathPtr->refCount == 0) { + /* + * Avoid possible segfaults or nondeterministic memory leaks where the + * reference count has been incorreclty managed. + */ Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0"); return NULL; } - /* - * Check if the filesystem has changed in some way since this object's - * internal representation was calculated. Before doing that, assure we - * have the most up-to-date copy of the master filesystem. This is - * accomplished by the FsGetFirstFilesystem() call. - */ - + /* Start with an up-to-date copy of the master filesystem. */ fsRecPtr = FsGetFirstFilesystem(); Claim(); + /* + * Ensure that pathPtr is a valid pathname. + */ if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) { + /* not a valid pathname */ Disclaim(); return NULL; } else if (retVal != NULL) { - /* TODO: Can this happen? */ + /* + * Found the filesystem in the internal representation of pathPtr. + */ Disclaim(); return retVal; } /* - * Call each of the "pathInFilesystem" functions in succession. A - * non-return value of -1 indicates the particular function has succeeded. + * Call each of the "pathInFilesystem" functions in succession until the + * corresponding filesystem is found. */ - for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) { ClientData clientData = NULL; if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) { continue; } if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, &clientData)!=-1) { - /* - * We assume the type of pathPtr hasn't been changed by the above - * call to the pathInFilesystemProc. - */ + /* This is the filesystem for pathPtr. Assume the type of pathPtr + * hasn't been changed by the above call to the + * pathInFilesystemProc, and cache this result in the internal + * representation of pathPtr. */ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); Disclaim(); return fsRecPtr->fsPtr; } @@ -4697,30 +4537,11 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSGetNativePath -- * - * This function is for use by the Win/Unix native filesystems, so that - * they can easily retrieve the native (char* or WCHAR*) representation - * of a path. Other filesystems will probably want to implement similar - * functions. They basically act as a safety net around - * Tcl_FSGetInternalRep. Normally your file-system functions will always - * be called with path objects already converted to the correct - * filesystem, but if for some reason they are called directly (i.e. by - * functions not in this file), then one cannot necessarily guarantee - * that the path object pointer is from the correct filesystem. - * - * Note: in the future it might be desirable to have separate versions - * of this function with different signatures, for example - * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since - * native paths are all string based, we use just one function. - * - * Results: - * NULL or a valid native path. - * - * Side effects: - * See Tcl_FSGetInternalRep. + * See Tcl_FSGetInternalRep. * *--------------------------------------------------------------------------- */ const void * @@ -4733,11 +4554,11 @@ /* *--------------------------------------------------------------------------- * * NativeFreeInternalRep -- * - * Free a native internal representation, which will be non-NULL. + * Free a native internal representation. * * Results: * None. * * Side effects: @@ -4748,27 +4569,28 @@ static void NativeFreeInternalRep( ClientData clientData) { - Tcl_Free(clientData); + ckfree(clientData); } /* *--------------------------------------------------------------------------- * * Tcl_FSFileSystemInfo -- + * Produce the type of a pathname and the type of its filesystem. * - * This function returns a list of two elements. The first element is the - * name of the filesystem (e.g. "native" or "vfs"), and the second is the - * particular type of the given path within that filesystem. * * Results: - * A list of two elements. + * A list where the first item is the name of the filesystem (e.g. + * "native" or "vfs"), and the second item is the type of the given + * pathname within that filesystem. * * Side effects: - * The object may be converted to a path type. + * The internal representation of pathPtr may be converted to a + * fsPathType. * *--------------------------------------------------------------------------- */ Tcl_Obj * @@ -4800,20 +4622,17 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSPathSeparator -- * - * This function returns the separator to be used for a given path. The - * object returned should have a refCount of zero + * Produces the separator for given pathname. * * Results: - * A Tcl object, with a refCount of zero. If the caller needs to retain a - * reference to the object, it should call Tcl_IncrRefCount, and should - * otherwise free the object. + * A Tcl object having a refCount of zero. * * Side effects: - * The path object may be converted to a path type. + * The internal representation of pathPtr may be converted to a fsPathType * *--------------------------------------------------------------------------- */ Tcl_Obj * @@ -4830,12 +4649,12 @@ if (fsPtr->filesystemSeparatorProc != NULL) { return fsPtr->filesystemSeparatorProc(pathPtr); } /* - * Allow filesystems not to provide a filesystemSeparatorProc if they wish - * to use the standard forward slash. + * Use the standard forward slash character if filesystem does not to + * provide a filesystemSeparatorProc. */ TclNewLiteralStringObj(resultObj, "/"); return resultObj; } @@ -4843,27 +4662,27 @@ /* *--------------------------------------------------------------------------- * * NativeFilesystemSeparator -- * - * This function is part of the native filesystem support, and returns - * the separator for the given path. + * This function, part of the native filesystem support, returns the + * separator for the given pathname. * * Results: - * String object containing the separator character. + * The separator character. * * Side effects: * None. * *--------------------------------------------------------------------------- */ static Tcl_Obj * NativeFilesystemSeparator( - Tcl_Obj *pathPtr) + TCL_UNUSED(Tcl_Obj *) /*pathPtr*/) { - const char *separator = NULL; /* lint */ + const char *separator = NULL; switch (tclPlatform) { case TCL_PLATFORM_UNIX: separator = "/"; break; Index: generic/tclIndexObj.c ================================================================== --- generic/tclIndexObj.c +++ generic/tclIndexObj.c @@ -20,11 +20,10 @@ */ static int GetIndexFromObjList(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr, const char *msg, int flags, int *indexPtr); -static int SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); static int PrefixAllObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -46,11 +45,11 @@ static const Tcl_ObjType indexType = { "index", /* name */ FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ UpdateStringOfIndex, /* updateStringProc */ - SetIndexFromAny /* setFromAnyProc */ + NULL /* setFromAnyProc */ }; /* * The definition of the internal representation of the "index" object; The * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a @@ -59,12 +58,12 @@ * Keep this structure declaration in sync with tclTestObj.c */ typedef struct { void *tablePtr; /* Pointer to the table of strings */ - size_t offset; /* Offset between table entries */ - size_t index; /* Selected index into table. */ + int offset; /* Offset between table entries */ + int index; /* Selected index into table. */ } IndexRep; /* * The following macros greatly simplify moving through a table... */ @@ -74,10 +73,79 @@ #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) +/* + *---------------------------------------------------------------------- + * + * Tcl_GetIndexFromObj -- + * + * This function looks up an object's value in a table of strings and + * returns the index of the matching string, if any. + * + * Results: + * If the value of objPtr is identical to or a unique abbreviation for + * one of the entries in tablePtr, then the return value is TCL_OK and the + * index of the matching entry is stored at *indexPtr. If there isn't a + * proper match, then TCL_ERROR is returned and an error message is left + * in interp's result (unless interp is NULL). The msg argument is used + * in the error message; for example, if msg has the value "option" then + * the error message will say something flag 'bad option "foo": must be + * ...' + * + * Side effects: + * The result of the lookup is cached as the internal rep of objPtr, so + * that repeated lookups can be done quickly. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_GetIndexFromObj +int +Tcl_GetIndexFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object containing the string to lookup. */ + const char *const*tablePtr, /* Array of strings to compare against the + * value of objPtr; last entry must be NULL + * and there must not be duplicate entries. */ + const char *msg, /* Identifying word to use in error + * messages. */ + int flags, /* 0 or TCL_EXACT */ + int *indexPtr) /* Place to store resulting integer index. */ +{ + if (!(flags & INDEX_TEMP_TABLE)) { + + /* + * See if there is a valid cached result from a previous lookup (doing the + * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in + * the common case where the result is cached). + */ + + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType); + + if (irPtr) { + IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; + + /* + * Here's hoping we don't get hit by unfortunate packing constraints + * on odd platforms like a Cray PVP... + */ + + if (indexRep->tablePtr == (void *) tablePtr + && indexRep->offset == sizeof(char *)) { + *indexPtr = indexRep->index; + return TCL_OK; + } + } + } + return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), + msg, flags, indexPtr); +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * GetIndexFromObjList -- * @@ -129,30 +197,30 @@ /* * Build a string table from the list. */ - tablePtr = Tcl_Alloc((objc + 1) * sizeof(char *)); + tablePtr = (const char **)ckalloc((objc + 1) * sizeof(char *)); for (t = 0; t < objc; t++) { if (objv[t] == objPtr) { /* * An exact match is always chosen, so we can stop here. */ - Tcl_Free((void *)tablePtr); + ckfree(tablePtr); *indexPtr = t; return TCL_OK; } - tablePtr[t] = TclGetString(objv[t]); + tablePtr[t] = Tcl_GetString(objv[t]); } tablePtr[objc] = NULL; result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr); - Tcl_Free((void *)tablePtr); + ckfree(tablePtr); return result; } /* @@ -188,11 +256,11 @@ const void *tablePtr, /* The first string in the table. The second * string will be at this address plus the * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ - size_t offset, /* The number of bytes between entries */ + int offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { @@ -203,21 +271,21 @@ Tcl_Obj *resultPtr; IndexRep *indexRep; const Tcl_ObjIntRep *irPtr; /* Protect against invalid values, like -1 or 0. */ - if (offset+1 <= sizeof(char *)) { - offset = sizeof(char *); + if (offset < (int)sizeof(char *)) { + offset = (int)sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. */ if (!(flags & INDEX_TEMP_TABLE)) { irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { - indexRep = irPtr->twoPtrValue.ptr1; + indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; } } @@ -237,11 +305,11 @@ * - An exact match (always preferred) * - A single abbreviation (allowed depending on flags) * - Several abbreviations (never allowed, but overridden by exact match) */ - for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL; + for (entryPtr = (const char* const*)tablePtr, idx = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { index = idx; goto done; @@ -277,15 +345,15 @@ */ if (!(flags & INDEX_TEMP_TABLE)) { irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { - indexRep = irPtr->twoPtrValue.ptr1; + indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; } else { Tcl_ObjIntRep ir; - indexRep = Tcl_Alloc(sizeof(IndexRep)); + indexRep = (IndexRep*)ckalloc(sizeof(IndexRep)); ir.twoPtrValue.ptr1 = indexRep; Tcl_StoreIntRep(objPtr, &indexType, &ir); } indexRep->tablePtr = (void *) tablePtr; indexRep->offset = offset; @@ -302,11 +370,11 @@ */ int count = 0; TclNewObj(resultPtr); - entryPtr = tablePtr; + entryPtr = (const char* const *)tablePtr; while ((*entryPtr != NULL) && !**entryPtr) { entryPtr = NEXT_ENTRY(entryPtr, offset); } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), @@ -335,43 +403,10 @@ } /* *---------------------------------------------------------------------- * - * SetIndexFromAny -- - * - * This function is called to convert a Tcl object to index internal - * form. However, this doesn't make sense (need to have a table of - * keywords in order to do the conversion) so the function always - * generates an error. - * - * Results: - * The return value is always TCL_ERROR, and an error message is left in - * interp's result if interp isn't NULL. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -SetIndexFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ -{ - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't convert value to index except via Tcl_GetIndexFromObj API", - -1)); - } - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * * UpdateStringOfIndex -- * * This function is called to convert a Tcl object from index internal * form to its string form. No abbreviation is ever generated. * @@ -386,12 +421,12 @@ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { - IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; - register const char *indexStr = EXPAND_OF(indexRep); + IndexRep *indexRep = (IndexRep *)TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; + const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* @@ -416,11 +451,11 @@ DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_ObjIntRep ir; - IndexRep *dupIndexRep = Tcl_Alloc(sizeof(IndexRep)); + IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, sizeof(IndexRep)); ir.twoPtrValue.ptr1 = dupIndexRep; @@ -446,11 +481,11 @@ static void FreeIndex( Tcl_Obj *objPtr) { - Tcl_Free(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); + ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- @@ -503,11 +538,11 @@ *---------------------------------------------------------------------- */ static int PrefixMatchObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int flags = 0, result, index; @@ -542,11 +577,11 @@ "missing value for -message", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; - message = TclGetString(objv[i]); + message = Tcl_GetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -error", -1)); @@ -627,17 +662,16 @@ *---------------------------------------------------------------------- */ static int PrefixAllObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, t; - size_t length, elemLength; + int tableObjc, result, t, length, elemLength; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "table string"); @@ -685,17 +719,16 @@ *---------------------------------------------------------------------- */ static int PrefixLongestObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, t; - size_t i, length, elemLength, resultLength; + int tableObjc, result, i, t, length, elemLength, resultLength; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "table string"); @@ -750,11 +783,11 @@ if (resultString[i] != elemString[i]) { /* * Adjust in case we stopped in the middle of a UTF char. */ - resultLength = Tcl_UtfPrev(&resultString[i+1], + resultLength = TclUtfPrev(&resultString[i+1], resultString) - resultString; break; } } } @@ -814,16 +847,38 @@ const char *message) /* Error message to print after the leading * objects in objv. The message may be * NULL. */ { Tcl_Obj *objPtr; - int i; - size_t len, elemLen; + int i, len, elemLen; char flags; Interp *iPtr = (Interp *) interp; const char *elementStr; + /* + * [incr Tcl] does something fairly horrific when generating error + * messages for its ensembles; it passes the whole set of ensemble + * arguments as a list in the first argument. This means that this code + * causes a problem in iTcl if it attempts to correctly quote all + * arguments, which would be the correct thing to do. We work around this + * nasty behaviour for now, and hope that we can remove it all in the + * future... + */ + +#ifndef AVOID_HACKS_FOR_ITCL + int isFirst = 1; /* Special flag used to inhibit the treating + * of the first word as a list element so the + * hacky way Itcl generates error messages for + * its ensembles will still work. [Bug + * 1066837] */ +# define MAY_QUOTE_WORD (!isFirst) +# define AFTER_FIRST_WORD (isFirst = 0) +#else /* !AVOID_HACKS_FOR_ITCL */ +# define MAY_QUOTE_WORD 1 +# define AFTER_FIRST_WORD (void) 0 +#endif /* AVOID_HACKS_FOR_ITCL */ + TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp)); Tcl_AppendToObj(objPtr, " or \"", -1); @@ -876,30 +931,32 @@ * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { - register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; + IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, len + 1); + if (MAY_QUOTE_WORD && len != elemLen) { + char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); TclStackFree(interp, quotedElementStr); } else { Tcl_AppendToObj(objPtr, elementStr, elemLen); } + + AFTER_FIRST_WORD; /* * Add a space if the word is not the last one (which has a * moderately complex condition here). */ @@ -923,11 +980,11 @@ * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { - register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; + IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). @@ -935,21 +992,23 @@ elementStr = TclGetStringFromObj(objv[i], &elemLen); flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, len + 1); + if (MAY_QUOTE_WORD && len != elemLen) { + char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); TclStackFree(interp, quotedElementStr); } else { Tcl_AppendToObj(objPtr, elementStr, elemLen); } } + + AFTER_FIRST_WORD; /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). */ @@ -969,10 +1028,12 @@ Tcl_AppendStringsToObj(objPtr, message, NULL); } Tcl_AppendStringsToObj(objPtr, "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); Tcl_SetObjResult(interp, objPtr); +#undef MAY_QUOTE_WORD +#undef AFTER_FIRST_WORD } /* *---------------------------------------------------------------------- * @@ -1010,28 +1071,28 @@ { Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ int nrem; /* Size of leftovers.*/ - register const Tcl_ArgvInfo *infoPtr; + const Tcl_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; - register char c; /* Second character of current arg (used for + char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ int srcIndex; /* Location from which to read next argument * from objv. */ int dstIndex; /* Used to keep track of current arguments * being processed, primarily for error * reporting. */ int objc; /* # arguments in objv still to process. */ - size_t length; /* Number of characters in current argument */ + int length; /* Number of characters in current argument */ if (remObjv != NULL) { /* * Then we should copy the name of the command (0th argument). The * upper bound on the number of elements is known, and (undocumented, @@ -1038,11 +1099,11 @@ * but historically true) there should be a NULL argument after the * last result. [Bug 3413857] */ nrem = 1; - leftovers = Tcl_Alloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); + leftovers = (Tcl_Obj **)ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); leftovers[0] = objv[0]; } else { nrem = 0; leftovers = NULL; } @@ -1124,11 +1185,11 @@ } if (Tcl_GetIntFromObj(interp, objv[srcIndex], (int *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, TclGetString(objv[srcIndex]))); + infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; objc--; break; @@ -1135,11 +1196,11 @@ case TCL_ARGV_STRING: if (objc == 0) { goto missingArg; } *((const char **) infoPtr->dstPtr) = - TclGetString(objv[srcIndex]); + Tcl_GetString(objv[srcIndex]); srcIndex++; objc--; break; case TCL_ARGV_REST: /* @@ -1157,11 +1218,11 @@ } if (Tcl_GetDoubleFromObj(interp, objv[srcIndex], (double *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected floating-point argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, TclGetString(objv[srcIndex]))); + infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; objc--; break; @@ -1222,11 +1283,11 @@ memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *)); nrem += objc; } leftovers[nrem] = NULL; *objcPtr = nrem++; - *remObjv = Tcl_Realloc(leftovers, nrem * sizeof(Tcl_Obj *)); + *remObjv = (Tcl_Obj **)ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* * Make sure to handle freeing any temporary space we've allocated on the * way to an error. @@ -1235,11 +1296,11 @@ missingArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { - Tcl_Free(leftovers); + ckfree(leftovers); } return TCL_ERROR; } /* @@ -1265,11 +1326,11 @@ * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { - register const Tcl_ArgvInfo *infoPtr; + const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; char tmp[TCL_DOUBLE_SPACE]; Tcl_Obj *msg; @@ -1279,17 +1340,17 @@ * everything line up. */ width = 4; for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { - size_t length; + int length; if (infoPtr->keyStr == NULL) { continue; } length = strlen(infoPtr->keyStr); - if (length > (size_t)width) { + if (length > width) { width = length; } } /* Index: generic/tclInt.decls ================================================================== --- generic/tclInt.decls +++ generic/tclInt.decls @@ -46,17 +46,16 @@ } declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { - size_t TclCopyAndCollapse(size_t count, const char *src, char *dst) + int TclCopyAndCollapse(int count, const char *src, char *dst) } -# Removed in 9.0: -#declare 8 { -# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, -# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) -#} +declare 8 {deprecated {}} { + int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, + Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +} # TclCreatePipeline unofficially exported for use by BLT. declare 9 { int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, @@ -78,11 +77,11 @@ #declare 13 { # int TclDoGlob(Tcl_Interp *interp, char *separators, # Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) #} declare 14 { - int TclDumpMemoryInfo(void *clientData, int flags) + int TclDumpMemoryInfo(ClientData clientData, int flags) } # Removed in 8.1: # declare 15 { # void TclExpandParseValue(ParseValue *pvPtr, int needed) # } @@ -106,18 +105,18 @@ # int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv) #} declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, - size_t *sizePtr, int *bracePtr) + int *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { - size_t TclFormatInt(char *buffer, Tcl_WideInt n) + int TclFormatInt(char *buffer, Tcl_WideInt n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) } # Removed in 8.1: @@ -150,15 +149,14 @@ } # Removed in 8.5: #declare 33 { # TclCmdProcType TclGetInterpProc(void) #} -# Removed in 9.0: -#declare 34 {deprecated {Use Tcl_GetIntForIndex}} { -# int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, -# int endValue, int *indexPtr) -#} +declare 34 {deprecated {Use Tcl_GetIntForIndex}} { + int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, + int endValue, int *indexPtr) +} # Removed in 8.4b2: #declare 35 { # Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, # int flags) #} @@ -183,11 +181,11 @@ } declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { - const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) + CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } # Removed in 8.5a2: #declare 43 { # int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) @@ -226,15 +224,15 @@ #declare 52 { # int TclInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 53 { - int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, + int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) } declare 54 { - int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, + int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 55 { Proc *TclIsProc(Command *cmdPtr) } @@ -266,11 +264,11 @@ } declare 62 { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 { - int TclObjInterpProc(void *clientData, Tcl_Interp *interp, + int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) @@ -289,11 +287,11 @@ # Replaced by Tcl_FSAccess in 8.4: #declare 68 { # int TclpAccess(const char *path, int mode) #} declare 69 { - void *TclpAlloc(size_t size) + void *TclpAlloc(unsigned int size) } #declare 70 { # int TclpCopyFile(const char *source, const char *dest) #} #declare 71 { @@ -308,20 +306,18 @@ #} declare 74 { void TclpFree(void *ptr) } declare 75 { - Tcl_WideUInt TclpGetClicks(void) + unsigned long TclpGetClicks(void) } declare 76 { - Tcl_WideUInt TclpGetSeconds(void) + unsigned long TclpGetSeconds(void) } - -# Removed in 9.0: -#declare 77 { -# void TclpGetTime(Tcl_Time *time) -#} +declare 77 {deprecated {}} { + void TclpGetTime(Tcl_Time *time) +} # Removed in 8.6: #declare 78 { # int TclpGetTimeZone(unsigned long time) #} # Replaced by Tcl_FSListVolumes in 8.4: @@ -332,11 +328,11 @@ #declare 80 { # Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, # char *modeString, int permissions) #} declare 81 { - void *TclpRealloc(void *ptr, size_t size) + void *TclpRealloc(void *ptr, unsigned int size) } #declare 82 { # int TclpRemoveDirectory(const char *path, int recursive, # Tcl_DString *errorPtr) #} @@ -357,15 +353,14 @@ # int flags, char **termPtr, ParseValue *pvPtr) # } # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } -# Removed in 9.0: -#declare 88 { -# char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, -# const char *name1, const char *name2, int flags) -#} +declare 88 {deprecated {}} { + char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, + const char *name1, const char *name2, int flags) +} declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) } # Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG): @@ -379,11 +374,11 @@ int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName) } declare 93 { - void TclProcDeleteProc(void *clientData) + void TclProcDeleteProc(ClientData clientData) } # Removed in 8.5: #declare 94 { # int TclProcInterpProc(void *clientData, Tcl_Interp *interp, # int argc, const char **argv) @@ -411,23 +406,22 @@ #declare 100 { # Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, # Tcl_Obj *objPtr, int flags) #} declare 101 { - const char *TclSetPreInitScript(const char *string) + CONST86 char *TclSetPreInitScript(const char *string) } declare 102 { void TclSetupEnv(Tcl_Interp *interp) } declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -# Removed in 9.0: -#declare 104 { -# int TclSockMinimumBuffersOld(int sock, int size) -#} +declare 104 {deprecated {}} { + int TclSockMinimumBuffersOld(int sock, int size) +} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) #} #declare 106 { @@ -456,39 +450,33 @@ declare 111 { void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } -# Removed in 9.0: -#declare 112 { -# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, -# Tcl_Obj *objPtr) -#} -# Removed in 9.0: -#declare 113 { -# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, -# void *clientData, Tcl_NamespaceDeleteProc *deleteProc) -#} -# Removed in 9.0: -#declare 114 { -# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) -#} -# Removed in 9.0: -#declare 115 { -# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, -# const char *pattern, int resetListFirst) -#} -# Removed in 9.0: -#declare 116 { -# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, -# Tcl_Namespace *contextNsPtr, int flags) -#} -# Removed in 9.0: -#declare 117 { -# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, -# Tcl_Namespace *contextNsPtr, int flags) -#} +declare 112 { + int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + Tcl_Obj *objPtr) +} +declare 113 { + Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name, + ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) +} +declare 114 { + void TclDeleteNamespace(Tcl_Namespace *nsPtr) +} +declare 115 { + int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + const char *pattern, int resetListFirst) +} +declare 116 { + Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, + Tcl_Namespace *contextNsPtr, int flags) +} +declare 117 { + Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, + Tcl_Namespace *contextNsPtr, int flags) +} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) } declare 119 { @@ -497,41 +485,35 @@ } declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } -# Removed in 9.0: -#declare 121 { -# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, -# const char *pattern) -#} -# Removed in 9.0: -#declare 122 { -# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -#} -# Removed in 9.0: -#declare 123 { -# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, -# Tcl_Obj *objPtr) -#} -# Removed in 9.0: -#declare 124 { -# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) -#} -# Removed in 9.0: -#declare 125 { -# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) -#} +declare 121 { + int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + const char *pattern) +} +declare 122 { + Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +} +declare 123 { + void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, + Tcl_Obj *objPtr) +} +declare 124 { + Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp) +} +declare 125 { + Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp) +} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } -# Removed in 9.0: -#declare 127 { -# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, -# const char *pattern, int allowOverwrite) -#} +declare 127 { + int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + const char *pattern, int allowOverwrite) +} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } declare 129 { int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, @@ -546,14 +528,13 @@ Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -# Removed in 9.0 -#declare 133 { -# struct tm *TclpGetDate(const time_t *time, int useGMT) -#} +declare 133 {deprecated {}} { + struct tm *TclpGetDate(const time_t *time, int useGMT) +} # Removed in 8.5 #declare 134 { # size_t TclpStrftime(char *s, size_t maxsize, const char *format, # const struct tm *t, int useGMT) #} @@ -581,11 +562,11 @@ declare 141 { const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, - CompileHookProc *hookProc, void *clientData) + CompileHookProc *hookProc, ClientData clientData) } declare 143 { int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr) } @@ -613,12 +594,12 @@ declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { - void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr, - size_t *endPtr) + void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, + int *endPtr) } declare 152 { void TclSetLibraryPath(Tcl_Obj *pathPtr) } declare 153 { @@ -640,18 +621,16 @@ int status) } declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -# REMOVED - use public Tcl_SetStartupScript() -#declare 158 { -# void TclSetStartupScriptFileName(const char *filename) -#} -# REMOVED - use public Tcl_GetStartupScript() -#declare 159 { -# const char *TclGetStartupScriptFileName(void) -#} +declare 158 {deprecated {use public Tcl_SetStartupScript()}} { + void TclSetStartupScriptFileName(const char *filename) +} +declare 159 {deprecated {use public Tcl_GetStartupScript()}} { + const char *TclGetStartupScriptFileName(void) +} #declare 160 { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, # GlobTypeData *types) #} @@ -660,11 +639,11 @@ declare 161 { int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr) } declare 162 { - void TclChannelEventScriptInvoker(void *clientData, int flags) + void TclChannelEventScriptInvoker(ClientData clientData, int flags) } # ALERT: The result of 'TclGetInstructionTable' is actually a # "const InstructionDesc*" but we do not want to describe this structure in # "tclInt.h". It is described in "tclCompile.h". Use a cast to the @@ -691,42 +670,39 @@ declare 166 { int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr) } -# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) -# REMOVED - use public Tcl_SetStartupScript() -#declare 167 { -# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -#} -# REMOVED - use public Tcl_GetStartupScript() -#declare 168 { -# Tcl_Obj *TclGetStartupScriptPath(void) -#} +declare 167 {deprecated {use public Tcl_SetStartupScript()}} { + void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +} +declare 168 {deprecated {use public Tcl_GetStartupScript()}} { + Tcl_Obj *TclGetStartupScriptPath(void) +} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) + int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, - size_t numChars, Command *cmdPtr, int result, int traceFlags, + int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 171 { int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, - size_t numChars, Command *cmdPtr, int result, int traceFlags, + int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 172 { int TclInThreadExit(void) } # added for 8.4.2 declare 173 { - int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen, - const Tcl_UniChar *pattern, size_t ptnLen, int flags) + int TclUniCharMatch(const Tcl_UniChar *string, int strLen, + const Tcl_UniChar *pattern, int ptnLen, int flags) } # added for 8.4.3 #declare 174 { @@ -745,17 +721,16 @@ } declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -# TIP 338 made these public - now declared in tcl.h -#declare 178 { -# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) -#} -#declare 179 { -# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) -#} +declare 178 { + void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +} +declare 179 { + Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr) +} # REMOVED # Allocate lists without copying arrays # declare 180 { # Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv) @@ -763,18 +738,16 @@ #declare 181 { # Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv, # const char *file, int line) #} -# Removed in 9.0 -#declare 182 { -# struct tm *TclpLocaltime(const time_t *clock) -#} -# Removed in 9.0 -#declare 183 { -# struct tm *TclpGmtime(const time_t *clock) -#} +declare 182 {deprecated {}} { + struct tm *TclpLocaltime(const time_t *clock) +} +declare 183 {deprecated {}} { + struct tm *TclpGmtime(const time_t *clock) +} # For the new "Thread Storage" subsystem. ### REMOVED on grounds it should never have been exposed. All these ### functions are now either static in tclThreadStorage.c or @@ -885,11 +858,11 @@ } declare 214 { void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) } declare 215 { - void *TclStackAlloc(Tcl_Interp *interp, size_t numBytes) + void *TclStackAlloc(Tcl_Interp *interp, int numBytes) } declare 216 { void TclStackFree(Tcl_Interp *interp, void *freePtr) } declare 217 { @@ -912,17 +885,17 @@ } declare 226 { int TclObjBeingDeleted(Tcl_Obj *objPtr) } declare 227 { - void TclSetNsPath(Namespace *nsPtr, size_t pathLength, + void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]) } # Used to be needed for TclOO-extension; unneeded now that TclOO is in the # core and NRE-enabled # declare 228 { -# int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj, +# int TclObjInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, # int skip, ProcErrorProc *errorProc) # } declare 229 { int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index) @@ -952,26 +925,23 @@ int *newPtr) } declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } - - -# TIP 337 made this one public -#declare 236 { -# void TclBackgroundException(Tcl_Interp *interp, int code) -#} +declare 236 {deprecated {use Tcl_BackgroundException}} { + void TclBackgroundException(Tcl_Interp *interp, int code) +} # TIP #285: Script cancellation support. declare 237 { int TclResetCancellation(Tcl_Interp *interp, int force) } # NRE functions for "rogue" extensions to exploit NRE; they will need to # include NRE.h too. declare 238 { - int TclNRInterpProc(void *clientData, Tcl_Interp *interp, + int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 239 { int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc) @@ -1000,12 +970,12 @@ } declare 245 { Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr) } declare 246 { - int TclInitRewriteEnsemble(Tcl_Interp *interp, size_t numRemoved, - size_t numInserted, Tcl_Obj *const *objv) + int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, + int numInserted, Tcl_Obj *const *objv) } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) } @@ -1024,11 +994,11 @@ } # Allow extensions for optimization declare 251 { int TclRegisterLiteral(void *envPtr, - const char *bytes, size_t length, int flags) + const char *bytes, int length, int flags) } # Exporting of the internal API to variables. declare 252 { @@ -1062,10 +1032,19 @@ # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } + +declare 259 { + unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + int *lengthPtr) +} + +declare 260 { + void TclUnusedStubEntry(void) +} ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. @@ -1076,24 +1055,21 @@ # Windows specific functions declare 0 win { void TclWinConvertError(DWORD errCode) } -# Removed in 9.0: -#declare 1 win { -# void TclWinConvertWSAError(DWORD errCode) -#} -# Removed in 9.0: -#declare 2 win { -# struct servent *TclWinGetServByName(const char *nm, -# const char *proto) -#} -# Removed in 9.0: -#declare 3 win { -# int TclWinGetSockOpt(SOCKET s, int level, int optname, -# char *optval, int *optlen) -#} +declare 1 win { + void TclWinConvertWSAError(DWORD errCode) +} +declare 2 win { + struct servent *TclWinGetServByName(const char *nm, + const char *proto) +} +declare 3 win { + int TclWinGetSockOpt(SOCKET s, int level, int optname, + char *optval, int *optlen) +} declare 4 win { HINSTANCE TclWinGetTclInstance(void) } # new for 8.4.20+/8.5.12+ Cygwin only declare 5 win { @@ -1101,30 +1077,27 @@ } # Removed in 8.1: # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -# Removed in 9.0: -#declare 6 win { -# unsigned short TclWinNToHS(unsigned short ns) -#} -# Removed in 9.0: -#declare 7 win { -# int TclWinSetSockOpt(SOCKET s, int level, int optname, -# const char *optval, int optlen) -#} +declare 6 win { + unsigned short TclWinNToHS(unsigned short ns) +} +declare 7 win { + int TclWinSetSockOpt(SOCKET s, int level, int optname, + const char *optval, int optlen) +} declare 8 win { - size_t TclpGetPid(Tcl_Pid pid) -} -# Removed in 9.0: -#declare 9 win { -# int TclWinGetPlatformId(void) -#} -# Removed in 9.0: -#declare 10 win { -# Tcl_DirEntry *TclpReaddir(TclDIR *dir) -#} + int TclpGetPid(Tcl_Pid pid) +} +declare 9 win { + int TclWinGetPlatformId(void) +} +# new for 8.4.20+/8.5.12+ Cygwin only +declare 10 win { + Tcl_DirEntry *TclpReaddir(TclDIR *dir) +} # Removed in 8.3.1 (for Win32s only): #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) #} @@ -1169,16 +1142,15 @@ } declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { - void TclWinAddProcess(HANDLE hProcess, size_t id) + void TclWinAddProcess(HANDLE hProcess, DWORD id) } -# Removed in 9.0: -#declare 21 win { -# char *TclpInetNtoa(struct in_addr addr) -#} +declare 21 win { + char *TclpInetNtoa(struct in_addr addr) +} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) #} @@ -1195,27 +1167,25 @@ } # replaced by generic TclGetPlatform #declare 25 win { # TclPlatformType *TclWinGetPlatform(void) #} -# Removed in 9.0: -#declare 26 win { -# void TclWinSetInterfaces(int wide) -#} +declare 26 win { + void TclWinSetInterfaces(int wide) +} # Added in Tcl 8.3.3 / 8.4 declare 27 win { void TclWinFlushDirtyChannels(void) } # Added in 8.4.2 -# Removed in 9.0: -#declare 28 win { -# void TclWinResetInterfaces(void) -#} +declare 28 win { + void TclWinResetInterfaces(void) +} ################################ # Unix specific functions # Pipe channel functions @@ -1236,14 +1206,13 @@ declare 4 unix { int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } -# Signature changed in 8.1: -# declare 5 unix { -# TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) -# } +declare 5 unix { + int TclUnixWaitForFile_(int fd, int mask, int timeout) +} declare 6 unix { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } declare 7 unix { TclFile TclpOpenFile(const char *fname, int mode) @@ -1258,26 +1227,24 @@ TclFile TclpCreateTempFile(const char *contents) } # Added in 8.4: -# Removed in 9.0: -#declare 10 unix { -# Tcl_DirEntry *TclpReaddir(TclDIR *dir) -#} -# Removed in 9.0: -#declare 11 unix { -# struct tm *TclpLocaltime_unix(const time_t *clock) -#} -# Removed in 9.0: -#declare 12 unix { -# struct tm *TclpGmtime_unix(const time_t *clock) -#} -# Removed in 9.0: -#declare 13 unix { -# char *TclpInetNtoa(struct in_addr addr) -#} +declare 10 unix { + Tcl_DirEntry *TclpReaddir(TclDIR *dir) +} +# Slots 11 and 12 are forwarders for functions that were promoted to +# generic Stubs +declare 11 unix { + struct tm *TclpLocaltime_unix(const time_t *clock) +} +declare 12 unix { + struct tm *TclpGmtime_unix(const time_t *clock) +} +declare 13 unix { + char *TclpInetNtoa(struct in_addr addr) +} # Added in 8.5: declare 14 unix { int TclUnixCopyFile(const char *src, const char *dst, @@ -1285,40 +1252,41 @@ } ################################ # Mac OS X specific functions -declare 15 macosx { +declare 15 {unix macosx} { int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr) } -declare 16 macosx { +declare 16 {unix macosx} { int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr) } -declare 17 macosx { +declare 17 {unix macosx} { int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr) } -declare 18 macosx { +declare 18 {unix macosx} { int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types) } -declare 19 macosx { +declare 19 {unix macosx} { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } +declare 22 {unix macosx} { + TclFile TclpCreateTempFile_(const char *contents) +} declare 29 {win unix} { int TclWinCPUID(int index, int *regs) } # Added in 8.6; core of TclpOpenTemporaryFile declare 30 {win unix} { int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) } - - # Local Variables: # mode: tcl # End: Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -22,10 +22,24 @@ /* * Some numerics configuration options. */ #undef ACCEPT_NAN + +/* + * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3. + * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them + * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+ + * releases. Perhaps Tcl 8.7 will add even better public interfaces + * supporting all the re-invocation mechanisms extensions like Itcl 3 + * need. As an absolute last resort, folks who must make Itcl 3 work + * unchanged with Tcl 8.7 can remove this line to regain the migration + * support. Tcl 9 will no longer offer even that option. + */ + +#define AVOID_HACKS_FOR_ITCL 1 + /* * Used to tag functions that are only to be visible within the module being * built and not outside it (where this is supported by the linker). * Also used in the platform-specific *Port.h files. @@ -36,10 +50,23 @@ # define MODULE_SCOPE extern "C" # else # define MODULE_SCOPE extern # endif #endif + +#ifndef JOIN +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +#endif + +#if defined(__cplusplus) +# define TCL_UNUSED(T) T +#elif defined(__GNUC__) && (__GNUC__ > 2) +# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused)) +#else +# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) +#endif /* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but @@ -50,11 +77,10 @@ #include "tclPort.h" #include #include -#include #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else # include #endif @@ -61,16 +87,16 @@ #ifdef NO_STRING_H #include "../compat/string.h" #else #include #endif -#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \ - || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC) -#include -#else +#if !defined(STDC_HEADERS) && !defined(__STDC__) && !defined(__C99__FUNC__) \ + && !defined(__cplusplus) && !defined(_MSC_VER) && !defined(__ICC) typedef int ptrdiff_t; #endif +#include +#include /* * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). @@ -197,10 +223,13 @@ * lookup is performed for upvar (or similar) purposes, with slightly * different rules: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers + * + * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag + * (Bug #835020) */ #define TCL_AVOID_RESOLVERS 0x40000 /* @@ -269,20 +298,20 @@ Tcl_HashTable *childTablePtr; /* Contains any child namespaces. Indexed by * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - size_t nsId; /* Unique id for the namespace. */ - Tcl_Interp *interp; /* The interpreter containing this + unsigned long nsId; /* Unique id for the namespace. */ + 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. */ - size_t activationCount; /* Number of "activations" or active call + int activationCount; /* Number of "activations" or active call * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ - size_t refCount; /* Count of references by namespaceName + unsigned int refCount; /* Count of references by namespaceName * objects. The namespace can't be freed until * refCount becomes zero. */ Tcl_HashTable cmdTable; /* Contains all the commands currently * registered in the namespace. Indexed by * strings; values have type (Command *). @@ -299,20 +328,20 @@ * pattern may include "string match" style * wildcard characters to specify multiple * commands; however, no namespace qualifiers * are allowed. NULL if no export patterns are * registered. */ - size_t numExportPatterns; /* Number of export patterns currently + int numExportPatterns; /* Number of export patterns currently * registered using "namespace export". */ - size_t maxExportPatterns; /* Number of export patterns for which space + int maxExportPatterns; /* Mumber of export patterns for which space * is currently allocated. */ - size_t cmdRefEpoch; /* Incremented if a newly added command + unsigned int 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. */ - size_t resolverEpoch; /* Incremented whenever (a) the name + unsigned int 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 * invalidates all byte codes compiled in the * namespace, causing the code to be @@ -335,11 +364,11 @@ * usual variable resolution mechanism in Tcl. * This procedure is invoked within * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ - size_t exportLookupEpoch; /* Incremented whenever a command is added to + unsigned int exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be * validated efficiently. */ Tcl_Ensemble *ensembles; /* List of structures that contain the details @@ -346,11 +375,11 @@ * of the ensembles that are implemented on * top of this namespace. */ Tcl_Obj *unknownHandlerPtr; /* A script fragment to be used when command * resolution in this namespace fails. TIP * 181. */ - size_t commandPathLength; /* The length of the explicit path. */ + int commandPathLength; /* The length of the explicit path. */ NamespacePathEntry *commandPathArray; /* The explicit path of the namespace as an * array. */ NamespacePathEntry *commandPathSourceList; /* Linked list of path entries that point to @@ -436,11 +465,11 @@ Tcl_Command token; /* The token for the command that provides * ensemble support for the namespace, or NULL * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - size_t epoch; /* The epoch at which this ensemble's table of + unsigned int 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 * number of entries as there are entries in * the subcommandTable hash. */ @@ -549,11 +578,11 @@ * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - size_t refCount; /* Used to ensure this structure is not + unsigned int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ } CommandTrace; @@ -612,21 +641,21 @@ Tcl_Obj *objPtr; /* The variable's object value. Used for * scalar variables and array elements. */ TclVarHashTable *tablePtr;/* For array variables, this points to * information about the hash table used to * implement the associative array. Points to - * Tcl_Alloc-ed data. */ + * ckalloc-ed data. */ struct Var *linkPtr; /* If this is a global variable being referred * to in a procedure, or a variable created by * "upvar", this field points to the * referenced variable's Var struct. */ } value; } Var; typedef struct VarInHash { Var var; - size_t refCount; /* Counts number of active uses of this + unsigned int refCount; /* Counts number of active uses of this * variable: 1 for the entry in the hash * table, 1 for each additional variable whose * linkPtr points here, 1 for each nested * trace active on variable, and 1 if the * variable is a namespace variable. This @@ -919,11 +948,11 @@ typedef struct CompiledLocal { struct CompiledLocal *nextPtr; /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - size_t nameLength; /* The number of bytes in local variable's name. + int nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ int frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ int flags; /* Flag bits for the local variable. Same as * the flags for the Var structure above, @@ -953,11 +982,11 @@ */ typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ - size_t refCount; /* Reference count: 1 if still present in + unsigned int refCount; /* Reference count: 1 if still present in * command table plus 1 for each call to the * procedure that is currently active. This * structure can be freed when refCount * becomes zero. */ struct Command *cmdPtr; /* Points to the Command structure for this @@ -1070,11 +1099,11 @@ * Will be grown to contain: pointers to the varnames (allocated at the end), * plus the init values for each variable (suitable to be memcopied on init) */ typedef struct LocalCache { - size_t refCount; + unsigned int refCount; int numVars; Tcl_Obj *varName0; } LocalCache; #define localName(framePtr, i) \ @@ -1225,11 +1254,11 @@ const char *pc; /* ... and instruction pointer. */ } tebc; } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - size_t len; /* ... and its length. */ + int len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by * TclArgumentBCEnter(). These will be removed * by TclArgumentBCRelease. */ @@ -1236,17 +1265,17 @@ } CmdFrame; typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ - size_t refCount; /* Number of times the word is on the + unsigned int refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - size_t pc; /* Instruction pointer of a command in + int pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ int 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 @@ -1323,11 +1352,11 @@ * directly (after casting) if NULL. */ void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - size_t length; /* Length of array. */ + int length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ } ExtraFrameInfo; @@ -1364,11 +1393,11 @@ /* * This is a convenience macro used to initialize a thread local storage ptr. */ #define TCL_TSD_INIT(keyPtr) \ - Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) + (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) /* *---------------------------------------------------------------- * Data structures related to bytecode compilation and execution. These are * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c. @@ -1412,11 +1441,11 @@ * The type of procedure called from the compilation hook point in * SetByteCodeFromAny. */ typedef int (CompileHookProc)(Tcl_Interp *interp, - struct CompileEnv *compEnvPtr, void *clientData); + struct CompileEnv *compEnvPtr, ClientData clientData); /* * The data structure for a (linked list of) execution stacks. */ @@ -1499,15 +1528,15 @@ struct LiteralEntry *nextPtr; /* Points to next entry in this hash bucket or * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ - size_t refCount; /* If in an interpreter's global literal + unsigned int refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to - * 0. If in a local literal table, TCL_AUTO_LENGTH. */ + * 0. If in a local literal table, (unsigned)-1. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce * shimmering. */ } LiteralEntry; @@ -1517,17 +1546,17 @@ * points to first entry in bucket's hash * chain, or NULL. */ LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - size_t numBuckets; /* Total number of buckets allocated at + unsigned int numBuckets; /* Total number of buckets allocated at * **buckets. */ - size_t numEntries; /* Total number of entries present in + unsigned int numEntries; /* Total number of entries present in * table. */ - size_t rebuildSize; /* Enlarge table when numEntries gets to be + unsigned int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - size_t mask; /* Mask value used in hashing function. */ + unsigned int mask; /* Mask value used in hashing function. */ } LiteralTable; /* * The following structure defines for each Tcl interpreter various * statistics-related information about the bytecode compiler and @@ -1641,16 +1670,16 @@ * already (this can happen if deleteProc * causes the command to be deleted or * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ - size_t refCount; /* 1 if in command hashtable plus 1 for each + unsigned int refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - size_t cmdEpoch; /* Incremented to invalidate any references + unsigned int cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL * if no compile proc exists for command. */ Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ @@ -1766,11 +1795,11 @@ typedef struct AllocCache { struct Cache *nextPtr; /* Linked list of cache entries. */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread. */ - size_t numObjects; /* Number of objects for thread. */ + int numObjects; /* Number of objects for thread. */ } AllocCache; /* *---------------------------------------------------------------- * This structure defines an interpreter, which is a collection of commands @@ -1780,35 +1809,45 @@ *---------------------------------------------------------------- */ typedef struct Interp { /* - * The first two fields were named "result" and "freeProc" in earlier - * versions of Tcl. They are no longer used within Tcl, and are no - * longer available to be accessed by extensions. However, they cannot - * be removed. Why? There is a deployed base of stub-enabled extensions - * that query the value of iPtr->stubTable. For them to continue to work, - * the location of the field "stubTable" within the Interp struct cannot - * change. The most robust way to assure that is to leave all fields up to - * that one undisturbed. + * Note: the first three fields must match exactly the fields in a + * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the + * other. + * + * The interpreter's result is held in both the string and the + * objResultPtr fields. These fields hold, respectively, the result's + * string or object value. The interpreter's result is always in the + * result field if that is non-empty, otherwise it is in objResultPtr. + * The two fields are kept consistent unless some C code sets + * interp->result directly. Programs should not access result and + * objResultPtr directly; instead, they should always get and set the + * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and + * Tcl_GetStringResult. See the SetResult man page for details. */ - const char *legacyResult; - void (*legacyFreeProc) (void); + char *result; /* If the last command returned a string + * result, this points to it. Should not be + * accessed directly; see comment above. */ + Tcl_FreeProc *freeProc; /* Zero means a string result is statically + * allocated. TCL_DYNAMIC means string result + * was allocated with ckalloc and should be + * freed with ckfree. Other values give + * address of procedure to invoke to free the + * string result. Tcl_Eval must free it before + * executing next command. */ int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. In - * ancient pre-8.1 versions of Tcl this was a - * pointer to the objResultPtr or a pointer to a - * buckets array in a hash table. Deployed stubs - * 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. - */ + /* Pointer to the exported Tcl stub table. On + * previous versions of Tcl this is a pointer + * to the objResultPtr or a pointer to a + * buckets array in a hash table. We therefore + * have to do some careful checking before we + * can use this. */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ Namespace *globalNsPtr; /* The interpreter's global namespace. */ @@ -1817,11 +1856,19 @@ * of hidden commands on a per-interp * basis. */ void *interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - void (*optimizer)(void *envPtr); + union { + void (*optimizer)(void *envPtr); + Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The + * unused space in interp was repurposed for + * pluggable bytecode optimizers. The core + * contains one optimizer, which can be + * selectively overridden by extensions. */ + } extra; + /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. */ @@ -1846,10 +1893,29 @@ CallFrame *rootFramePtr; /* Global frame pointer for this * interpreter. */ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ + /* + * Information used by Tcl_AppendResult to keep track of partial results. + * See Tcl_AppendResult code for details. + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + char *appendResult; /* Storage space for results generated by + * Tcl_AppendResult. Ckalloc-ed. NULL means + * not yet allocated. */ + int appendAvl; /* Total amount of space available at + * partialResult. */ + int appendUsed; /* Number of non-null bytes currently stored + * at partialResult. */ +#else + char *appendResultDontUse; + int appendAvlDontUse; + int appendUsedDontUse; +#endif + /* * Information about packages. Used only in tclPkg.c. */ Tcl_HashTable packageTable; /* Describes all of the packages loaded in or @@ -1862,22 +1928,23 @@ * NULL. */ /* * Miscellaneous information: */ - size_t cmdCount; /* Total number of times a command procedure + int cmdCount; /* Total number of times a command procedure * has been called for this interpreter. */ int evalFlags; /* Flags to control next call to Tcl_Eval. * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ + int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - size_t compileEpoch; /* Holds the current "compilation epoch" for + unsigned int 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 * redefined. */ Proc *compiledProcPtr; /* If a procedure is being compiled, a pointer @@ -1905,10 +1972,18 @@ * evaluation stack. */ Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ +#if TCL_MAJOR_VERSION < 9 +# if !defined(TCL_NO_DEPRECATED) + char resultSpace[TCL_DSTRING_STATIC_SIZE+1]; + /* Static space holding small results. */ +# else + char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1]; +# endif +#endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */ @@ -1947,11 +2022,11 @@ * check the limits. */ int exceeded; /* Which limits have been exceeded, described * as flag values the same as the 'active' * field. */ - size_t cmdCount; /* Limit for how many commands to execute in + int cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is * reached. */ int cmdGranularity; /* Mod factor used to determine how often to @@ -1983,13 +2058,13 @@ Tcl_Obj *const *sourceObjs; /* What arguments were actually input into the * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - size_t numRemovedObjs; /* How many arguments have been stripped off + int numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ - size_t numInsertedObjs; /* How many of the current arguments were + int numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; /* * TIP #219: Global info for the I/O system. @@ -2193,10 +2268,11 @@ #define TCL_ALLOW_EXCEPTIONS 0x04 #define TCL_EVAL_FILE 0x02 #define TCL_EVAL_SOURCE_IN_FRAME 0x10 #define TCL_EVAL_NORESOLVE 0x20 +#define TCL_EVAL_DISCARD_RESULT 0x40 /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: @@ -2301,11 +2377,11 @@ /* * A common panic alert when memory allocation fails. */ #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 %u bytes", (size)),1))) /* * The following enum values are used to specify the runtime platform setting * of the tclPlatform variable. */ @@ -2354,11 +2430,11 @@ * used to hold all element pointers. This is done to make append operations * faster. */ typedef struct List { - size_t refCount; + unsigned int refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was * derived from the list representation. May * be ignored if there is no string rep at @@ -2368,11 +2444,11 @@ } List; #define LIST_MAX \ (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *))) #define LIST_SIZE(numElems) \ - (sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) + (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) /* * Macro used to get the elements of a list object. */ @@ -2417,13 +2493,14 @@ * * WARNING: these macros eval their args more than once. */ #define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ - (((objPtr)->typePtr == &tclIntType \ - || (objPtr)->typePtr == &tclBooleanType) \ + (((objPtr)->typePtr == &tclIntType) \ ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ + : ((objPtr)->typePtr == &tclBooleanType) \ + ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType) \ @@ -2443,14 +2520,13 @@ && (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))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ - (((objPtr)->typePtr == &tclIntType \ - && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ - ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \ - ? (size_t)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \ + ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \ + && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \ + ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: @@ -2504,11 +2580,11 @@ * more efficiency in 'path' manipulation and usage, and cleaner filesystem * code internally. */ #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) -typedef void *(TclFSGetCwdProc2)(void *clientData); +typedef ClientData (TclFSGetCwdProc2)(ClientData clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); /* * The following types are used for getting and storing platform-specific file @@ -2585,11 +2661,11 @@ *---------------------------------------------------------------- * Data structures for process-global values. *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); /* * A ProcessGlobalValue struct exists for each internal value in Tcl that is * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of @@ -2597,13 +2673,13 @@ * control. Each ProcessGlobalValue struct should be a static variable in some * file. */ typedef struct ProcessGlobalValue { - size_t epoch; /* Epoch counter to detect changes in the + unsigned int epoch; /* Epoch counter to detect changes in the * master value. */ - size_t numBytes; /* Length of the master string. */ + unsigned int numBytes; /* Length of the master string. */ char *value; /* The master string value. */ Tcl_Encoding encoding; /* system encoding when master string was * initialized. */ TclInitProcessGlobalValueProc *proc; /* A procedure to initialize the master string @@ -2635,18 +2711,24 @@ * prefixes. */ #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 */ /* *---------------------------------------------------------------------- * Type values TclGetNumberFromObj *---------------------------------------------------------------------- */ #define TCL_NUMBER_INT 2 +#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED) +# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */ +# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */ +#endif #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 /* @@ -2668,11 +2750,11 @@ * Data for the time hooks, if any. */ MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr; MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; -MODULE_SCOPE void *tclTimeClientData; +MODULE_SCOPE ClientData tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. */ @@ -2803,22 +2885,18 @@ /* Procedure that unloads a loaded module */ }; /* Flags for conversion of doubles to digit strings */ -#define TCL_DD_SHORTEST 0x4 - /* Use the shortest possible string */ #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 * decimal point, suitable for F format */ - -#define TCL_DD_SHORTEN_FLAG 0x4 - /* Allow return of a shorter digit string - * if it converts losslessly */ +#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 */ @@ -2828,11 +2906,11 @@ * Procedures shared among Tcl modules but not used by the outside world: *---------------------------------------------------------------- */ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, - const unsigned char *bytes, size_t len); + const unsigned char *bytes, int len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, int loc); MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, @@ -2841,24 +2919,26 @@ Tcl_Obj *objv[], int objc, CmdFrame *cf); MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc); + void *codePtr, CmdFrame *cfPtr, int cmd, int pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); -MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); +MODULE_SCOPE double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, - size_t strLen, const unsigned char *pattern, - size_t ptnLen, int flags); -MODULE_SCOPE double TclCeil(const mp_int *a); + int strLen, const unsigned char *pattern, + int ptnLen, int flags); +MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); +MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, + const char *value); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; @@ -2869,27 +2949,27 @@ MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, int start, int *clNext); MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); -MODULE_SCOPE size_t TclConvertElement(const char *src, size_t length, +MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, int flags); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, - Tcl_ObjCmdProc *proc, void *clientData, + Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, - size_t *sizePtr, int *literalPtr); + int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, - size_t numBytes, int flags, int line, + int numBytes, int flags, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd; @@ -2897,13 +2977,13 @@ MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, - void *clientData); + ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, - void *clientData); + ClientData clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); @@ -2931,18 +3011,18 @@ MODULE_SCOPE void TclInitThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); -MODULE_SCOPE double TclFloor(const mp_int *a); +MODULE_SCOPE double TclFloor(const void *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, - void *clientData, + ClientData clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle); MODULE_SCOPE int * TclGetAsyncReadyPtr(void); @@ -2954,20 +3034,20 @@ MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, void **clientDataPtr, + Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, - size_t *sizePtr); + unsigned int *sizePtr); MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp, const char *targetName, const char *packageName); MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *, Tcl_WideInt *); @@ -2976,24 +3056,22 @@ Tcl_GlobTypeData *types); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); -MODULE_SCOPE int TclInfoExistsCmd(void *dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoCoroutineCmd(void *dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); -MODULE_SCOPE int TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoVarsCmd(void *dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); -MODULE_SCOPE void TclInitBignumFromWideInt(mp_int *, Tcl_WideInt); -MODULE_SCOPE void TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); MODULE_SCOPE void TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp); MODULE_SCOPE void TclInitEncodingSubsystem(void); @@ -3000,13 +3078,12 @@ MODULE_SCOPE void TclInitIOSubsystem(void); MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); -MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); -MODULE_SCOPE int TclIsSpaceProc(int byte); +MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); @@ -3025,11 +3102,11 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, const EnsembleImplMap map[]); -MODULE_SCOPE int TclMaxListLength(const char *bytes, size_t numBytes, +MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes, const char **endPtr); 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); @@ -3043,26 +3120,26 @@ int objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE int TclParseBackslash(const char *src, - size_t numBytes, size_t *readPtr, char *dst); -MODULE_SCOPE int TclParseHex(const char *src, size_t numBytes, + int numBytes, int *readPtr, char *dst); +MODULE_SCOPE int TclParseHex(const char *src, int numBytes, int *resultPtr); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, - size_t numBytes, const char **endPtrPtr, int flags); + int numBytes, const char **endPtrPtr, int flags); MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, - size_t numBytes, Tcl_Parse *parsePtr); -MODULE_SCOPE size_t TclParseAllWhiteSpace(const char *src, size_t numBytes); + int numBytes, Tcl_Parse *parsePtr); +MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, - size_t len); + int len); MODULE_SCOPE int TclpDeleteFile(const void *path); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizePipes(void); MODULE_SCOPE void TclpFinalizeSockets(void); @@ -3069,15 +3146,15 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, struct addrinfo **addrlist, const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, void *clientData, - size_t stackSize, int flags); -MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); + Tcl_ThreadCreateProc *proc, ClientData clientData, + int stackSize, int flags); +MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - size_t *lengthPtr, Tcl_Encoding *encodingPtr); + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); MODULE_SCOPE void TclpMasterLock(void); @@ -3093,11 +3170,11 @@ MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target); MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -MODULE_SCOPE void *TclpGetNativeCwd(void *clientData); +MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr); MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj, @@ -3117,77 +3194,79 @@ MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex); MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, - size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, + int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); -MODULE_SCOPE size_t TclScanElement(const char *string, size_t length, +MODULE_SCOPE int TclScanElement(const char *string, int length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, - mp_int *bignumValue); + void *bignumValue); MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, - Tcl_Obj *const *objv, int objc, size_t subIdx, + Tcl_Obj *const *objv, int objc, int subIdx, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, - size_t numBytes); + int numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, - int checkEq, int nocase, size_t reqlength); + int checkEq, int nocase, int reqlength); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, int *reqlength); -MODULE_SCOPE int TclStringMatch(const char *str, size_t strLen, +MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, - size_t numBytes, int flags, int line, + int numBytes, int flags, int line, struct CompileEnv *envPtr); MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, - size_t numBytes, int flags, Tcl_Parse *parsePtr, + int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr, int line, int *clNextOuter, const char *outerScript); -MODULE_SCOPE size_t TclTrim(const char *bytes, size_t numBytes, - const char *trim, size_t numTrim, size_t *trimRight); -MODULE_SCOPE size_t TclTrimLeft(const char *bytes, size_t numBytes, - const char *trim, size_t numTrim); -MODULE_SCOPE size_t TclTrimRight(const char *bytes, size_t numBytes, - const char *trim, size_t numTrim); +MODULE_SCOPE int TclTrim(const char *bytes, int numBytes, + const char *trim, int numTrim, int *trimRight); +MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, + const char *trim, int numTrim); +MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, + const char *trim, int numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); MODULE_SCOPE void TclRegisterCommandTypeName( Tcl_ObjCmdProc *implementationProc, const char *nameStr); -#if (TCL_UTF_MAX > 4) && (defined(__CYGWIN__) || defined(_WIN32)) -MODULE_SCOPE int TclUtfToWChar(const char *src, WCHAR *chPtr); -MODULE_SCOPE char * TclWCharToUtfDString(const WCHAR *uniStr, - int uniLength, Tcl_DString *dsPtr); -MODULE_SCOPE WCHAR * TclUtfToWCharDString(const char *src, - int length, Tcl_DString *dsPtr); -#else -# define TclUtfToWChar TclUtfToUniChar -# define TclWCharToUtfDString Tcl_UniCharToUtfDString -# define TclUtfToWCharDString Tcl_UtfToUniCharDString -#endif MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); -MODULE_SCOPE size_t TclUtfCount(int ch); -MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData); +MODULE_SCOPE int TclUtfCount(int ch); +#if TCL_UTF_MAX > 3 +# define TclUtfToUCS4 Tcl_UtfToUniChar +# define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1) +# define TclUCS4Complete Tcl_UtfCharComplete +# define TclChar16Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \ + ? ((length) >= 3) : Tcl_UtfCharComplete((src), (length))) +#else + MODULE_SCOPE int TclUtfToUCS4(const char *src, int *ucs4Ptr); + MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *src, int *ucs4Ptr); +# define TclUCS4Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \ + ? ((length) >= 4) : Tcl_UtfCharComplete((src), (length))) +# define TclChar16Complete Tcl_UtfCharComplete +#endif +MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); @@ -3199,10 +3278,17 @@ #endif MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); +/* TclWideMUInt -- wide integer used for measurement calculations: */ +#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400)) +# define TclWideMUInt Tcl_WideUInt +#else +/* older MSVS may not allow conversions between unsigned __int64 and double) */ +# define TclWideMUInt Tcl_WideInt +#endif #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else @@ -3220,308 +3306,323 @@ MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, - const char *msg, size_t length); + const char *msg, int length); /* Tip 430 */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); +/* + * Many parsing tasks need a common definition of whitespace. + * Use this routine and macro to achieve that and place + * optimization (fragile on changes) in one place. + */ + +MODULE_SCOPE int TclIsSpaceProc(int byte); +# define TclIsSpaceProcM(byte) \ + (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) + /* *---------------------------------------------------------------- * Command procedures in the generic core: *---------------------------------------------------------------- */ -MODULE_SCOPE int Tcl_AfterObjCmd(void *clientData, +MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_AppendObjCmd(void *clientData, +MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ApplyObjCmd(void *clientData, +MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_BreakObjCmd(void *clientData, +MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CatchObjCmd(void *clientData, +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CdObjCmd(void *clientData, +#endif +MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclChanCreateObjCmd(void *clientData, +MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPostEventObjCmd(void *clientData, +MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPopObjCmd(void *clientData, +MODULE_SCOPE int TclChanPopObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPushObjCmd(void *clientData, +MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE int TclClockOldscanObjCmd( void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CloseObjCmd(void *clientData, +MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ConcatObjCmd(void *clientData, +MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ContinueObjCmd(void *clientData, +MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, - void *clientData); + ClientData clientData); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( - void *clientData, Tcl_Interp *interp, + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int index, int pathc, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]); -MODULE_SCOPE int Tcl_DisassembleObjCmd(void *clientData, +MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* Assemble command function */ -MODULE_SCOPE int Tcl_AssembleObjCmd(void *clientData, +MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNRAssembleObjCmd(void *clientData, +MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_EofObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ErrorObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_EvalObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExecObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExitObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExprObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FblockedObjCmd(void *clientData, +MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FconfigureObjCmd( - void *clientData, Tcl_Interp *interp, + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FcopyObjCmd(void *dummy, +MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_FileEventObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FlushObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForeachObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FormatObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GetsObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobalObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IfObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IncrObjCmd(void *clientData, +MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_InterpObjCmd(void *clientData, +MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_JoinObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LappendObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LassignObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LindexObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LinsertObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LlengthObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ListObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LmapObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LoadObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LpopObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrangeObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LremoveObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrepeatObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreplaceObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreverseObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsearchObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsetObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsortObjCmd(void *clientData, +MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LremoveObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclNamespaceEnsembleCmd(void *dummy, +MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_OpenObjCmd(void *clientData, +MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PackageObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PidObjCmd(void *clientData, +MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_PutsObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PwdObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReadObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegexpObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegsubObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RenameObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RepresentationCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReturnObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ScanObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SeekObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SetObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SplitObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SocketObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SourceObjCmd(void *clientData, +MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_SubstObjCmd(void *clientData, +MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SwitchObjCmd(void *clientData, +MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TellObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp, +MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TimeObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TimeRateObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TraceObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TryObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnloadObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnsetObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpdateObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UplevelObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpvarObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VariableObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VwaitObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_WhileObjCmd(void *clientData, +MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------- @@ -3849,107 +3950,107 @@ struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInvertOpCmd(void *clientData, +MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNotOpCmd(void *clientData, +MODULE_SCOPE int TclNotOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAddOpCmd(void *clientData, +MODULE_SCOPE int TclAddOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMulOpCmd(void *clientData, +MODULE_SCOPE int TclMulOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAndOpCmd(void *clientData, +MODULE_SCOPE int TclAndOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclOrOpCmd(void *clientData, +MODULE_SCOPE int TclOrOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclXorOpCmd(void *clientData, +MODULE_SCOPE int TclXorOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclPowOpCmd(void *clientData, +MODULE_SCOPE int TclPowOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLshiftOpCmd(void *clientData, +MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclRshiftOpCmd(void *clientData, +MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclModOpCmd(void *clientData, +MODULE_SCOPE int TclModOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNeqOpCmd(void *clientData, +MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStrneqOpCmd(void *clientData, +MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInOpCmd(void *clientData, +MODULE_SCOPE int TclInOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNiOpCmd(void *clientData, +MODULE_SCOPE int TclNiOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMinusOpCmd(void *clientData, +MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclDivOpCmd(void *clientData, +MODULE_SCOPE int TclDivOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3993,18 +4094,18 @@ * candidates for public interface. */ MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); -MODULE_SCOPE size_t TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, - size_t start); -MODULE_SCOPE size_t TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, - size_t last); +MODULE_SCOPE Tcl_Obj * TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, + int start); +MODULE_SCOPE Tcl_Obj * TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, + int last); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t count, int flags); + int count, int flags); MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t first, size_t count, Tcl_Obj *insertPtr, + int first, int count, Tcl_Obj *insertPtr, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); /* Flag values for the [string] ensemble functions. */ @@ -4059,11 +4160,10 @@ /* * So tclObj.c and tclDictObj.c can share these implementations. */ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); -MODULE_SCOPE void TclFreeObj(Tcl_Obj *objPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); @@ -4115,16 +4215,16 @@ * Utility routines for encoding index values as integers. Used by both * some of the command compilers and by [lsort] and [lsearch]. */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t before, size_t after, int *indexPtr); -MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); + int before, int after, int *indexPtr); +MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END ((size_t)-2) -#define TCL_INDEX_START ((size_t)0) +#define TCL_INDEX_END (-2) +#define TCL_INDEX_START (0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. @@ -4149,11 +4249,10 @@ * DTrace object allocation probe macros. */ #ifdef USE_DTRACE #ifndef _TCLDTRACE_H -typedef const char *TclDTraceStr; #include "tclDTrace.h" #endif #define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr) #define TCL_DTRACE_OBJ_FREE(objPtr) TCL_OBJ_FREE(objPtr) #else /* USE_DTRACE */ @@ -4188,23 +4287,23 @@ TCL_DTRACE_OBJ_CREATE(objPtr) /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) with - * 'length == TCL_AUTO_LENGTH'. + * 'length == -1'. * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. */ # 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); \ + ckfree((objPtr)->bytes); \ } \ - (objPtr)->length = TCL_AUTO_LENGTH; \ + (objPtr)->length = -1; \ TclFreeObjStorage(objPtr); \ TclIncrObjsFreed(); \ } else { \ TclFreeObj(objPtr); \ } \ @@ -4222,14 +4321,14 @@ * allocates and frees a single Tcl_Obj so that tools like Purify can better * track memory leaks. */ # define TclAllocObjStorageEx(interp, objPtr) \ - (objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj)) + (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)) # define TclFreeObjStorageEx(interp, objPtr) \ - Tcl_Free(objPtr) + ckfree(objPtr) #undef USE_THREAD_ALLOC #undef USE_TCLALLOC #elif TCL_THREADS && defined(USE_THREAD_ALLOC) @@ -4265,11 +4364,11 @@ ((cachePtr = ((Interp *)(interp))->allocCache), \ (cachePtr->numObjects == 0))) { \ (objPtr) = TclThreadAllocObj(); \ } else { \ (objPtr) = cachePtr->firstObjPtr; \ - cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \ + cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \ --cachePtr->numObjects; \ } \ } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ @@ -4353,11 +4452,11 @@ * copy of the "len" bytes starting at "bytePtr". This code works even if the * byte array contains NULLs as long as the length is correct. Because "len" * is referenced multiple times, it should be as simple an expression as * possible. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len); + * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len); * * This macro should only be called on an unshared objPtr where * objPtr->typePtr->freeIntRepProc == NULL *---------------------------------------------------------------- */ @@ -4365,11 +4464,11 @@ #define TclInitStringRep(objPtr, bytePtr, len) \ if ((len) == 0) { \ (objPtr)->bytes = &tclEmptyString; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = Tcl_Alloc((len) + 1); \ + (objPtr)->bytes = (char *) ckalloc((len) + 1); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ } @@ -4386,42 +4485,14 @@ */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) -#if 0 - static inline char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { - char *response = Tcl_GetString(objPtr); - *(lenPtr) = objPtr->length; - return response; - } - static inline Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { - Tcl_UniChar *response = Tcl_GetUnicodeFromObj(objPtr, NULL); - *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1); - return response; - } - static inline unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { - unsigned char *response = Tcl_GetByteArrayFromObj(objPtr, NULL); - if (response) { - *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1); - } - return response; - } -#else #define TclGetStringFromObj(objPtr, lenPtr) \ - (((objPtr)->bytes \ - ? NULL : Tcl_GetString((objPtr)), \ - *(lenPtr) = (objPtr)->length, (objPtr)->bytes)) -#define TclGetUnicodeFromObj(objPtr, lenPtr) \ - (Tcl_GetUnicodeFromObj((objPtr), NULL), \ - *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \ - Tcl_GetUnicodeFromObj((objPtr), NULL)) -#define TclGetByteArrayFromObj(objPtr, lenPtr) \ - (Tcl_GetByteArrayFromObj((objPtr), NULL) ? \ - (*(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \ - (unsigned char *)(((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1) + 2)) : NULL) -#endif + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + : Tcl_GetStringFromObj((objPtr), (lenPtr))) /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal * representation. Does not actually reset the rep's bytes. The ANSI C @@ -4449,15 +4520,30 @@ */ #define TclInvalidateStringRep(objPtr) \ if ((objPtr)->bytes != NULL) { \ if ((objPtr)->bytes != &tclEmptyString) { \ - Tcl_Free((objPtr)->bytes); \ + ckfree((objPtr)->bytes); \ } \ (objPtr)->bytes = NULL; \ } +/* + * These form part of the native filesystem support. They are needed here + * because we have a few native filesystem functions (which are the same for + * win/unix) in this file. + */ + +#ifdef __cplusplus +extern "C" { +#endif +MODULE_SCOPE const char *const tclpFileAttrStrings[]; +MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; +#ifdef __cplusplus +} +#endif + /* *---------------------------------------------------------------- * Macro used by the Tcl core to test whether an object has a * string representation (or is a 'pure' internal value). * The ANSI C "prototype" for this macro is: @@ -4478,20 +4564,20 @@ *---------------------------------------------------------------- */ #define TclUnpackBignum(objPtr, bignum) \ do { \ - register Tcl_Obj *bignumObj = (objPtr); \ - register int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ } else { \ - (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1; \ + (bignum).dp = (mp_digit *)bignumObj->internalRep.twoPtrValue.ptr1; \ (bignum).sign = bignumPayload >> 30; \ - (bignum).alloc = (bignumPayload >> 15) & 0x7fff; \ - (bignum).used = bignumPayload & 0x7fff; \ + (bignum).alloc = (bignumPayload >> 15) & 0x7FFF; \ + (bignum).used = bignumPayload & 0x7FFF; \ } \ } while (0) /* *---------------------------------------------------------------- @@ -4538,24 +4624,24 @@ oldPtr = NULL; \ } \ if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ - newPtr = (Tcl_Token *) Tcl_AttemptRealloc((char *) oldPtr, \ - (allocated * sizeof(Tcl_Token))); \ + newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \ + allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ - newPtr = (Tcl_Token *) Tcl_Realloc((char *) oldPtr, \ - (allocated * sizeof(Tcl_Token))); \ + newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \ + allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - ((used) * sizeof(Tcl_Token))); \ + (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ } while (0) @@ -4574,38 +4660,50 @@ * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ +#if TCL_UTF_MAX > 3 +#define TclUtfToUniChar(str, chPtr) \ + (((UCHAR(*(str))) < 0x80) ? \ + ((*(chPtr) = UCHAR(*(str))), 1) \ + : Tcl_UtfToUniChar(str, chPtr)) +#else #define TclUtfToUniChar(str, chPtr) \ ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ - : Tcl_UtfToUniChar(str, chPtr)) + : Tcl_UtfToChar16(str, chPtr)) +#endif /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- * -sensitive points where it pays to avoid a function call in the common case * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: * * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes, - * size_t numBytes); + * int numBytes); *---------------------------------------------------------------- */ #define TclNumUtfChars(numChars, bytes, numBytes) \ do { \ - size_t _count, _i = (numBytes); \ + int _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ while (_i && (*_str < 0xC0)) { _i--; _str++; } \ _count = (numBytes) - _i; \ if (_i) { \ _count += Tcl_NumUtfChars((bytes) + _count, _i); \ } \ (numChars) = _count; \ } while (0); + +#define TclUtfPrev(src, start) \ + (((src) < (start) + 2) ? (start) : \ + ((unsigned char) *((src) - 1)) < 0x80 ? (src) - 1 : \ + Tcl_UtfPrev(src, start)) /* *---------------------------------------------------------------- * Macro that encapsulates the logic that determines when it is safe to * interpret a string as a byte array directly. In summary, the object must be @@ -4736,24 +4834,24 @@ * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); - * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len); + * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len); * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral); * *---------------------------------------------------------------- */ #ifndef TCL_MEM_DEBUG -#define TclNewIntObj(objPtr, i) \ +#define TclNewIntObj(objPtr, w) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ (objPtr)->refCount = 0; \ (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ (objPtr)->typePtr = &tclIntType; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewDoubleObj(objPtr, d) \ @@ -4791,11 +4889,11 @@ /* * The sLiteral argument *must* be a string literal; the incantation with * sizeof(sLiteral "") will fail to compile otherwise. */ #define TclNewLiteralStringObj(objPtr, sLiteral) \ - TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1) + TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) /* *---------------------------------------------------------------- * Convenience macros for DStrings. * The ANSI C "prototypes" for these macros are: @@ -4804,11 +4902,11 @@ * const char *sLiteral); * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); */ #define TclDStringAppendLiteral(dsPtr, sLiteral) \ - Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1) + Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) #define TclDStringClear(dsPtr) \ Tcl_DStringSetLength((dsPtr), 0) /* *---------------------------------------------------------------- @@ -4829,10 +4927,18 @@ # else # define TclIsNaN(d) (isnan(d)) # endif #endif +/* + * Macro to use to find the offset of a field in astructure. + * Computes number of bytes from beginning of structure to a given field. + */ + +#ifndef TCL_NO_DEPRECATED +# define TclOffset(type, field) ((int) offsetof(type, field)) +#endif /* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */ #ifndef offsetof # define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field)) #endif @@ -4853,11 +4959,11 @@ * the internal stubs, but the core can use the macro instead. */ #define TclCleanupCommandMacro(cmdPtr) \ if ((cmdPtr)->refCount-- <= 1) { \ - Tcl_Free(cmdPtr);\ + ckfree(cmdPtr);\ } /* *---------------------------------------------------------------- * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number @@ -4916,27 +5022,27 @@ #define TclSmallAllocEx(interp, nbytes, memPtr) \ do { \ Tcl_Obj *_objPtr; \ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ TclIncrObjsAllocated(); \ - TclAllocObjStorageEx((interp), _objPtr); \ - memPtr = (void *)_objPtr; \ + TclAllocObjStorageEx((interp), (_objPtr)); \ + *(void **)&memPtr = (void *) (_objPtr); \ } while (0) #define TclSmallFreeEx(interp, memPtr) \ do { \ - TclFreeObjStorageEx((interp), (Tcl_Obj *)memPtr); \ + TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ TclIncrObjsFreed(); \ } while (0) #else /* TCL_MEM_DEBUG */ #define TclSmallAllocEx(interp, nbytes, memPtr) \ do { \ Tcl_Obj *_objPtr; \ TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ TclNewObj(_objPtr); \ - memPtr = (void *)_objPtr; \ + *(void **)&memPtr = (void *) _objPtr; \ } while (0) #define TclSmallFreeEx(interp, memPtr) \ do { \ Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr; \ @@ -4945,25 +5051,10 @@ _objPtr->refCount = 1; \ TclDecrRefCount(_objPtr); \ } while (0) #endif /* TCL_MEM_DEBUG */ -/* - * Macros to convert size_t to wide-int (and wide-int object) considering - * platform-related negative value ((size_t)-1), if wide-int and size_t - * have different dimensions (e. g. 32-bit platform). - */ - -#if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX) -# define TclWideIntFromSize(value) (((Tcl_WideInt)(((size_t)(value))+1))-1) -# define TclNewWideIntObjFromSize(value) \ - Tcl_NewWideIntObj(TclWideIntFromSize(value)) -#else -# define TclWideIntFromSize(value) ((Tcl_WideInt)(value)) -# define TclNewWideIntObjFromSize Tcl_NewWideIntObj -#endif - /* * Support for Clang Static Analyzer */ #if defined(PURIFY) && defined(__clang__) @@ -4996,11 +5087,11 @@ * available. */ typedef struct NRE_callback { Tcl_NRPostProc *procPtr; - void *data[4]; + ClientData data[4]; struct NRE_callback *nextPtr; } NRE_callback; #define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) @@ -5011,14 +5102,14 @@ #define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ do { \ NRE_callback *_callbackPtr; \ TCLNR_ALLOC((interp), (_callbackPtr)); \ _callbackPtr->procPtr = (postProcPtr); \ - _callbackPtr->data[0] = (void *)(data0); \ - _callbackPtr->data[1] = (void *)(data1); \ - _callbackPtr->data[2] = (void *)(data2); \ - _callbackPtr->data[3] = (void *)(data3); \ + _callbackPtr->data[0] = (ClientData)(data0); \ + _callbackPtr->data[1] = (ClientData)(data1); \ + _callbackPtr->data[2] = (ClientData)(data2); \ + _callbackPtr->data[3] = (ClientData)(data3); \ _callbackPtr->nextPtr = TOP_CB(interp); \ TOP_CB(interp) = _callbackPtr; \ } while (0) #if NRE_USE_SMALL_ALLOC @@ -5025,12 +5116,12 @@ #define TCLNR_ALLOC(interp, ptr) \ TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr)) #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ - (ptr = (Tcl_Alloc(sizeof(NRE_callback)))) -#define TCLNR_FREE(interp, ptr) Tcl_Free(ptr) + (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) +#define TCLNR_FREE(interp, ptr) ckfree(ptr) #endif #if NRE_ENABLE_ASSERTS #define NRE_ASSERT(expr) assert((expr)) #else @@ -5037,16 +5128,15 @@ #define NRE_ASSERT(expr) #endif #include "tclIntDecls.h" #include "tclIntPlatDecls.h" -#include "tclTomMathDecls.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(size) TclpAlloc(size) +#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size)) +#define Tcl_Free(ptr) TclpFree(ptr) #endif #endif /* _TCLINT */ /* Index: generic/tclIntDecls.h ================================================================== --- generic/tclIntDecls.h +++ generic/tclIntDecls.h @@ -25,10 +25,27 @@ # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif +#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) +# define tclGetIntForIndex tcl_GetIntForIndex +/* Those macro's are especially for Itcl 3.4 compatibility */ +# define tclCreateNamespace tcl_CreateNamespace +# define tclDeleteNamespace tcl_DeleteNamespace +# define tclAppendExportList tcl_AppendExportList +# define tclExport tcl_Export +# define tclImport tcl_Import +# define tclForgetImport tcl_ForgetImport +# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace +# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace +# define tclFindNamespace tcl_FindNamespace +# define tclFindCommand tcl_FindCommand +# define tclGetCommandFromObj tcl_GetCommandFromObj +# define tclGetCommandFullName tcl_GetCommandFullName +#endif /* !defined(TCL_NO_DEPRECATED) */ + /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tclInt.decls script. */ @@ -53,13 +70,17 @@ EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 6 */ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ -EXTERN size_t TclCopyAndCollapse(size_t count, const char *src, +EXTERN int TclCopyAndCollapse(int count, const char *src, char *dst); -/* Slot 8 is reserved */ +/* 8 */ +TCL_DEPRECATED("") +int TclCopyChannelOld(Tcl_Interp *interp, + Tcl_Channel inChan, Tcl_Channel outChan, + int toRead, Tcl_Obj *cmdPtr); /* 9 */ EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); @@ -73,11 +94,11 @@ /* 12 */ EXTERN void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ -EXTERN int TclDumpMemoryInfo(void *clientData, int flags); +EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); /* Slot 15 is reserved */ /* 16 */ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); /* Slot 17 is reserved */ /* Slot 18 is reserved */ @@ -86,16 +107,16 @@ /* Slot 21 is reserved */ /* 22 */ EXTERN int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, - const char **nextPtr, size_t *sizePtr, + const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN size_t TclFormatInt(char *buffer, Tcl_WideInt n); +EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* 28 */ @@ -106,11 +127,14 @@ EXTERN const char * TclGetExtension(const char *name); /* 32 */ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ -/* Slot 34 is reserved */ +/* 34 */ +TCL_DEPRECATED("Use Tcl_GetIntForIndex") +int TclGetIntForIndex(Tcl_Interp *interp, + Tcl_Obj *objPtr, int endValue, int *indexPtr); /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* 37 */ EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName); @@ -127,11 +151,11 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ -EXTERN const char * TclpGetUserHome(const char *name, +EXTERN CONST86 char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ EXTERN int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); @@ -147,15 +171,15 @@ CallFrame *framePtr, Namespace *nsPtr); /* 51 */ EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ -EXTERN int TclInvokeObjectCommand(void *clientData, +EXTERN int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 54 */ -EXTERN int TclInvokeStringCommand(void *clientData, +EXTERN int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ EXTERN Proc * TclIsProc(Command *cmdPtr); /* Slot 56 is reserved */ @@ -171,11 +195,11 @@ /* 61 */ EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ -EXTERN int TclObjInterpProc(void *clientData, +EXTERN int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); @@ -182,34 +206,40 @@ /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -EXTERN void * TclpAlloc(size_t size); +EXTERN void * TclpAlloc(unsigned int size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ EXTERN void TclpFree(void *ptr); /* 75 */ -EXTERN Tcl_WideUInt TclpGetClicks(void); +EXTERN unsigned long TclpGetClicks(void); /* 76 */ -EXTERN Tcl_WideUInt TclpGetSeconds(void); -/* Slot 77 is reserved */ +EXTERN unsigned long TclpGetSeconds(void); +/* 77 */ +TCL_DEPRECATED("") +void TclpGetTime(Tcl_Time *time); /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -EXTERN void * TclpRealloc(void *ptr, size_t size); +EXTERN void * TclpRealloc(void *ptr, unsigned int size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -/* Slot 88 is reserved */ +/* 88 */ +TCL_DEPRECATED("") +char * TclPrecTraceProc(ClientData clientData, + Tcl_Interp *interp, const char *name1, + const char *name2, int flags); /* 89 */ EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* Slot 90 is reserved */ /* 91 */ @@ -218,11 +248,11 @@ EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 93 */ -EXTERN void TclProcDeleteProc(void *clientData); +EXTERN void TclProcDeleteProc(ClientData clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ EXTERN int TclRenameCommand(Tcl_Interp *interp, const char *oldName, const char *newName); @@ -232,17 +262,19 @@ /* 98 */ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ -EXTERN const char * TclSetPreInitScript(const char *string); +EXTERN CONST86 char * TclSetPreInitScript(const char *string); /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* Slot 104 is reserved */ +/* 104 */ +TCL_DEPRECATED("") +int TclSockMinimumBuffersOld(int sock, int size); /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ /* 108 */ EXTERN void TclTeardownNamespace(Namespace *nsPtr); @@ -254,16 +286,29 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); -/* Slot 112 is reserved */ -/* Slot 113 is reserved */ -/* Slot 114 is reserved */ -/* Slot 115 is reserved */ -/* Slot 116 is reserved */ -/* Slot 117 is reserved */ +/* 112 */ +EXTERN int TclAppendExportList(Tcl_Interp *interp, + Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); +/* 113 */ +EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp, + const char *name, ClientData clientData, + Tcl_NamespaceDeleteProc *deleteProc); +/* 114 */ +EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr); +/* 115 */ +EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + const char *pattern, int resetListFirst); +/* 116 */ +EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, + Tcl_Namespace *contextNsPtr, int flags); +/* 117 */ +EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp, + const char *name, + Tcl_Namespace *contextNsPtr, int flags); /* 118 */ EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 119 */ EXTERN int Tcl_GetNamespaceResolvers( @@ -271,19 +316,29 @@ Tcl_ResolverInfo *resInfo); /* 120 */ EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); -/* Slot 121 is reserved */ -/* Slot 122 is reserved */ -/* Slot 123 is reserved */ -/* Slot 124 is reserved */ -/* Slot 125 is reserved */ +/* 121 */ +EXTERN int TclForgetImport(Tcl_Interp *interp, + Tcl_Namespace *nsPtr, const char *pattern); +/* 122 */ +EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr); +/* 123 */ +EXTERN void TclGetCommandFullName(Tcl_Interp *interp, + Tcl_Command command, Tcl_Obj *objPtr); +/* 124 */ +EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp); +/* 125 */ +EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp); /* 126 */ EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); -/* Slot 127 is reserved */ +/* 127 */ +EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, + const char *pattern, int allowOverwrite); /* 128 */ EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ EXTERN int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, @@ -297,11 +352,13 @@ Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* Slot 133 is reserved */ +/* 133 */ +TCL_DEPRECATED("") +struct tm * TclpGetDate(const time_t *time, int useGMT); /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ @@ -311,11 +368,11 @@ /* 141 */ EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, - void *clientData); + ClientData clientData); /* 143 */ EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 144 */ EXTERN void TclHideLiteral(Tcl_Interp *interp, @@ -331,12 +388,12 @@ /* 149 */ EXTERN void TclHandleRelease(TclHandle handle); /* 150 */ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ -EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, - size_t *startPtr, size_t *endPtr); +EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index, + int *startPtr, int *endPtr); /* 152 */ EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ EXTERN Tcl_Obj * TclGetLibraryPath(void); /* Slot 154 is reserved */ @@ -345,18 +402,22 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, int status); /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); -/* Slot 158 is reserved */ -/* Slot 159 is reserved */ +/* 158 */ +TCL_DEPRECATED("use public Tcl_SetStartupScript()") +void TclSetStartupScriptFileName(const char *filename); +/* 159 */ +TCL_DEPRECATED("use public Tcl_GetStartupScript()") +const char * TclGetStartupScriptFileName(void); /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ -EXTERN void TclChannelEventScriptInvoker(void *clientData, +EXTERN void TclChannelEventScriptInvoker(ClientData clientData, int flags); /* 163 */ EXTERN const void * TclGetInstructionTable(void); /* 164 */ EXTERN void TclExpandCodeArray(void *envPtr); @@ -364,31 +425,35 @@ EXTERN void TclpSetInitialEncodings(void); /* 166 */ EXTERN int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); -/* Slot 167 is reserved */ -/* Slot 168 is reserved */ +/* 167 */ +TCL_DEPRECATED("use public Tcl_SetStartupScript()") +void TclSetStartupScriptPath(Tcl_Obj *pathPtr); +/* 168 */ +TCL_DEPRECATED("use public Tcl_GetStartupScript()") +Tcl_Obj * TclGetStartupScriptPath(void); /* 169 */ EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, - size_t n); + unsigned long n); /* 170 */ EXTERN int TclCheckInterpTraces(Tcl_Interp *interp, - const char *command, size_t numChars, + const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, - const char *command, size_t numChars, + const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 172 */ EXTERN int TclInThreadExit(void); /* 173 */ EXTERN int TclUniCharMatch(const Tcl_UniChar *string, - size_t strLen, const Tcl_UniChar *pattern, - size_t ptnLen, int flags); + int strLen, const Tcl_UniChar *pattern, + int ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, @@ -397,16 +462,23 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); /* 177 */ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); -/* Slot 178 is reserved */ -/* Slot 179 is reserved */ +/* 178 */ +EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr, + const char *encodingName); +/* 179 */ +EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr); /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* Slot 182 is reserved */ -/* Slot 183 is reserved */ +/* 182 */ +TCL_DEPRECATED("") +struct tm * TclpLocaltime(const time_t *clock); +/* 183 */ +TCL_DEPRECATED("") +struct tm * TclpGmtime(const time_t *clock); /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ @@ -455,11 +527,11 @@ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); /* 214 */ EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); /* 215 */ -EXTERN void * TclStackAlloc(Tcl_Interp *interp, size_t numBytes); +EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); /* 216 */ EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ EXTERN int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, @@ -479,11 +551,11 @@ Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 226 */ EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ -EXTERN void TclSetNsPath(Namespace *nsPtr, size_t pathLength, +EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); @@ -505,16 +577,19 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* Slot 236 is reserved */ +/* 236 */ +TCL_DEPRECATED("use Tcl_BackgroundException") +void TclBackgroundException(Tcl_Interp *interp, int code); /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ -EXTERN int TclNRInterpProc(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +EXTERN int TclNRInterpProc(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 240 */ @@ -533,11 +608,11 @@ EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); /* 245 */ EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); /* 246 */ EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp, - size_t numRemoved, size_t numInserted, + int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble); /* 248 */ @@ -550,11 +625,11 @@ /* 250 */ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes, - size_t length, int flags); + int length, int flags); /* 252 */ EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 253 */ @@ -581,10 +656,15 @@ Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); +/* 259 */ +EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, int *lengthPtr); +/* 260 */ +EXTERN void TclUnusedStubEntry(void); typedef struct TclIntStubs { int magic; void *hooks; @@ -593,46 +673,46 @@ void (*reserved2)(void); void (*tclAllocateFreeObjects) (void); /* 3 */ void (*reserved4)(void); int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ - size_t (*tclCopyAndCollapse) (size_t count, const char *src, char *dst); /* 7 */ - void (*reserved8)(void); + int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ + TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */ void (*reserved13)(void); - int (*tclDumpMemoryInfo) (void *clientData, int flags); /* 14 */ + int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */ void (*reserved15)(void); void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */ void (*reserved17)(void); void (*reserved18)(void); void (*reserved19)(void); void (*reserved20)(void); void (*reserved21)(void); - int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 22 */ + int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ - size_t (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ + int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ void (*reserved26)(void); void (*reserved27)(void); Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */ void (*reserved29)(void); void (*reserved30)(void); const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); - void (*reserved34)(void); + TCL_DEPRECATED_API("Use Tcl_GetIntForIndex") int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */ void (*reserved35)(void); void (*reserved36)(void); int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ - const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ + CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ void (*reserved43)(void); int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); @@ -639,141 +719,141 @@ void (*reserved48)(void); void (*reserved49)(void); void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); - int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ - int (*tclInvokeStringCommand) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ + int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ + int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); void (*reserved57)(void); Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */ void (*reserved59)(void); int (*tclNeedSpace) (const char *start, const char *end); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */ int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */ - int (*tclObjInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ + int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */ void (*reserved65)(void); void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); - void * (*tclpAlloc) (size_t size); /* 69 */ + void * (*tclpAlloc) (unsigned int size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); void (*tclpFree) (void *ptr); /* 74 */ - Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */ - Tcl_WideUInt (*tclpGetSeconds) (void); /* 76 */ - void (*reserved77)(void); + unsigned long (*tclpGetClicks) (void); /* 75 */ + unsigned long (*tclpGetSeconds) (void); /* 76 */ + TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */ void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); - void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */ + void * (*tclpRealloc) (void *ptr, unsigned int size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); - void (*reserved88)(void); + TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */ - void (*tclProcDeleteProc) (void *clientData); /* 93 */ + void (*tclProcDeleteProc) (ClientData clientData); /* 93 */ void (*reserved94)(void); void (*reserved95)(void); int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */ void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */ int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); - const char * (*tclSetPreInitScript) (const char *string); /* 101 */ + CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ - void (*reserved104)(void); + TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */ int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ - void (*reserved112)(void); - void (*reserved113)(void); - void (*reserved114)(void); - void (*reserved115)(void); - void (*reserved116)(void); - void (*reserved117)(void); + int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ + Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ + void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ + int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ + Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ + Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ - void (*reserved121)(void); - void (*reserved122)(void); - void (*reserved123)(void); - void (*reserved124)(void); - void (*reserved125)(void); + int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ + Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ + void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ + Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */ + Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */ void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ - void (*reserved127)(void); + int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - void (*reserved133)(void); + TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); void (*reserved137)(void); const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ void (*reserved139)(void); void (*reserved140)(void); const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ - int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */ + int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ TclHandle (*tclHandleCreate) (void *ptr); /* 146 */ void (*tclHandleFree) (TclHandle handle); /* 147 */ TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */ void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ - void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr); /* 151 */ + void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */ void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ - void (*reserved158)(void); - void (*reserved159)(void); + TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ + TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */ void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ - void (*tclChannelEventScriptInvoker) (void *clientData, int flags); /* 162 */ + void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ const void * (*tclGetInstructionTable) (void); /* 163 */ void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ - void (*reserved167)(void); - void (*reserved168)(void); - int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ - int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ - int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ + TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ + TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ + int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ + int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ + int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ - int (*tclUniCharMatch) (const Tcl_UniChar *string, size_t strLen, const Tcl_UniChar *pattern, size_t ptnLen, int flags); /* 173 */ + int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */ void (*reserved174)(void); int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*reserved178)(void); - void (*reserved179)(void); + void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ + Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */ void (*reserved180)(void); void (*reserved181)(void); - void (*reserved182)(void); - void (*reserved183)(void); + TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ + TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); void (*reserved187)(void); void (*reserved188)(void); @@ -801,11 +881,11 @@ void (*reserved210)(void); void (*reserved211)(void); void (*tclpFindExecutable) (const char *argv0); /* 212 */ Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */ void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */ - void * (*tclStackAlloc) (Tcl_Interp *interp, size_t numBytes); /* 215 */ + void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */ void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */ int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */ void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */ void (*reserved219)(void); void (*reserved220)(void); @@ -813,42 +893,44 @@ void (*reserved222)(void); void (*reserved223)(void); TclPlatformType * (*tclGetPlatform) (void); /* 224 */ Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */ int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */ - void (*tclSetNsPath) (Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]); /* 227 */ + void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */ void (*reserved228)(void); int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */ int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */ void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ - void (*reserved236)(void); + TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ - int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ + int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */ int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */ - int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 246 */ + int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */ void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */ int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ - int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */ + int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ + unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *lengthPtr); /* 259 */ + void (*tclUnusedStubEntry) (void); /* 260 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus @@ -871,11 +953,12 @@ (tclIntStubsPtr->tclCleanupChildren) /* 5 */ #define TclCleanupCommand \ (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ -/* Slot 8 is reserved */ +#define TclCopyChannelOld \ + (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ (tclIntStubsPtr->tclCreateProc) /* 10 */ #define TclDeleteCompiledLocalVars \ @@ -910,11 +993,12 @@ #define TclGetExtension \ (tclIntStubsPtr->tclGetExtension) /* 31 */ #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ -/* Slot 34 is reserved */ +#define TclGetIntForIndex \ + (tclIntStubsPtr->tclGetIntForIndex) /* 34 */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ #define TclGetLoadedPackages \ (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */ #define TclGetNamespaceForQualName \ @@ -977,11 +1061,12 @@ (tclIntStubsPtr->tclpFree) /* 74 */ #define TclpGetClicks \ (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ -/* Slot 77 is reserved */ +#define TclpGetTime \ + (tclIntStubsPtr->tclpGetTime) /* 77 */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ #define TclpRealloc \ (tclIntStubsPtr->tclpRealloc) /* 81 */ @@ -989,11 +1074,12 @@ /* Slot 83 is reserved */ /* Slot 84 is reserved */ /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -/* Slot 88 is reserved */ +#define TclPrecTraceProc \ + (tclIntStubsPtr->tclPrecTraceProc) /* 88 */ #define TclPreventAliasLoop \ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */ /* Slot 90 is reserved */ #define TclProcCleanupProc \ (tclIntStubsPtr->tclProcCleanupProc) /* 91 */ @@ -1015,11 +1101,12 @@ (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ #define TclSetupEnv \ (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -/* Slot 104 is reserved */ +#define TclSockMinimumBuffersOld \ + (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ #define TclTeardownNamespace \ (tclIntStubsPtr->tclTeardownNamespace) /* 108 */ @@ -1027,30 +1114,42 @@ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */ #define TclSockMinimumBuffers \ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ -/* Slot 112 is reserved */ -/* Slot 113 is reserved */ -/* Slot 114 is reserved */ -/* Slot 115 is reserved */ -/* Slot 116 is reserved */ -/* Slot 117 is reserved */ +#define TclAppendExportList \ + (tclIntStubsPtr->tclAppendExportList) /* 112 */ +#define TclCreateNamespace \ + (tclIntStubsPtr->tclCreateNamespace) /* 113 */ +#define TclDeleteNamespace \ + (tclIntStubsPtr->tclDeleteNamespace) /* 114 */ +#define TclExport \ + (tclIntStubsPtr->tclExport) /* 115 */ +#define TclFindCommand \ + (tclIntStubsPtr->tclFindCommand) /* 116 */ +#define TclFindNamespace \ + (tclIntStubsPtr->tclFindNamespace) /* 117 */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ -/* Slot 121 is reserved */ -/* Slot 122 is reserved */ -/* Slot 123 is reserved */ -/* Slot 124 is reserved */ -/* Slot 125 is reserved */ +#define TclForgetImport \ + (tclIntStubsPtr->tclForgetImport) /* 121 */ +#define TclGetCommandFromObj \ + (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */ +#define TclGetCommandFullName \ + (tclIntStubsPtr->tclGetCommandFullName) /* 123 */ +#define TclGetCurrentNamespace_ \ + (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */ +#define TclGetGlobalNamespace_ \ + (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ -/* Slot 127 is reserved */ +#define TclImport \ + (tclIntStubsPtr->tclImport) /* 127 */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ (tclIntStubsPtr->tcl_PushCallFrame) /* 129 */ #define Tcl_RemoveInterpResolvers \ @@ -1057,11 +1156,12 @@ (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */ #define Tcl_SetNamespaceResolvers \ (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -/* Slot 133 is reserved */ +#define TclpGetDate \ + (tclIntStubsPtr->tclpGetDate) /* 133 */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ #define TclGetEnv \ @@ -1098,12 +1198,14 @@ /* Slot 155 is reserved */ #define TclRegError \ (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ -/* Slot 158 is reserved */ -/* Slot 159 is reserved */ +#define TclSetStartupScriptFileName \ + (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ +#define TclGetStartupScriptFileName \ + (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ #define TclChannelEventScriptInvoker \ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */ @@ -1113,12 +1215,14 @@ (tclIntStubsPtr->tclExpandCodeArray) /* 164 */ #define TclpSetInitialEncodings \ (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ -/* Slot 167 is reserved */ -/* Slot 168 is reserved */ +#define TclSetStartupScriptPath \ + (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ +#define TclGetStartupScriptPath \ + (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ (tclIntStubsPtr->tclCheckInterpTraces) /* 170 */ #define TclCheckExecutionTraces \ @@ -1132,16 +1236,20 @@ (tclIntStubsPtr->tclCallVarTraces) /* 175 */ #define TclCleanupVar \ (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -/* Slot 178 is reserved */ -/* Slot 179 is reserved */ +#define TclSetStartupScript \ + (tclIntStubsPtr->tclSetStartupScript) /* 178 */ +#define TclGetStartupScript \ + (tclIntStubsPtr->tclGetStartupScript) /* 179 */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* Slot 182 is reserved */ -/* Slot 183 is reserved */ +#define TclpLocaltime \ + (tclIntStubsPtr->tclpLocaltime) /* 182 */ +#define TclpGmtime \ + (tclIntStubsPtr->tclpGmtime) /* 183 */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ /* Slot 187 is reserved */ /* Slot 188 is reserved */ @@ -1218,11 +1326,12 @@ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #define TclVarHashCreateVar \ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -/* Slot 236 is reserved */ +#define TclBackgroundException \ + (tclIntStubsPtr->tclBackgroundException) /* 236 */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ (tclIntStubsPtr->tclNRInterpProc) /* 238 */ #define TclNRInterpProcCore \ @@ -1263,20 +1372,45 @@ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ +#define TclGetBytesFromObj \ + (tclIntStubsPtr->tclGetBytesFromObj) /* 259 */ +#define TclUnusedStubEntry \ + (tclIntStubsPtr->tclUnusedStubEntry) /* 260 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ -#if defined(USE_TCL_STUBS) -#undef Tcl_StaticPackage -#define Tcl_StaticPackage \ - (tclIntStubsPtr->tclStaticPackage) -#endif /* defined(USE_TCL_STUBS) */ - #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT + +#if defined(USE_TCL_STUBS) +# undef TclGetStartupScriptFileName +# undef TclSetStartupScriptFileName +# undef TclGetStartupScriptPath +# undef TclSetStartupScriptPath +# undef TclBackgroundException +# undef TclSetStartupScript +# undef TclGetStartupScript +# undef TclGetIntForIndex +# undef TclCreateNamespace +# undef TclDeleteNamespace +# undef TclAppendExportList +# undef TclExport +# undef TclImport +# undef TclForgetImport +# undef TclGetCurrentNamespace_ +# undef TclGetGlobalNamespace_ +# undef TclFindNamespace +# undef TclFindCommand +# undef TclGetCommandFromObj +# undef TclGetCommandFullName +# undef TclCopyChannelOld +# undef TclSockMinimumBuffersOld +# undef Tcl_StaticPackage +# define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage) +#endif #endif /* _TCLINTDECLS */ Index: generic/tclIntPlatDecls.h ================================================================== --- generic/tclIntPlatDecls.h +++ generic/tclIntPlatDecls.h @@ -55,35 +55,56 @@ /* 4 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); -/* Slot 5 is reserved */ +/* 5 */ +EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* Slot 10 is reserved */ -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ -/* Slot 13 is reserved */ +/* 10 */ +EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); +/* 11 */ +EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); +/* 12 */ +EXTERN struct tm * TclpGmtime_unix(const time_t *clock); +/* 13 */ +EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); -/* Slot 15 is reserved */ -/* Slot 16 is reserved */ -/* Slot 17 is reserved */ -/* Slot 18 is reserved */ -/* Slot 19 is reserved */ +/* 15 */ +EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, + Tcl_Obj **attributePtrPtr); +/* 16 */ +EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, + Tcl_Obj *attributePtr); +/* 17 */ +EXTERN int TclMacOSXCopyFileAttributes(const char *src, + const char *dst, + const Tcl_StatBuf *statBufPtr); +/* 18 */ +EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, + const char *pathName, const char *fileName, + Tcl_StatBuf *statBufPtr, + Tcl_GlobTypeData *types); +/* 19 */ +EXTERN void TclMacOSXNotifierAddRunLoopMode( + const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* Slot 22 is reserved */ +/* 22 */ +EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ @@ -96,23 +117,33 @@ Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); -/* Slot 1 is reserved */ -/* Slot 2 is reserved */ -/* Slot 3 is reserved */ +/* 1 */ +EXTERN void TclWinConvertWSAError(DWORD errCode); +/* 2 */ +EXTERN struct servent * TclWinGetServByName(const char *nm, + const char *proto); +/* 3 */ +EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, + char *optval, int *optlen); /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); -/* Slot 6 is reserved */ -/* Slot 7 is reserved */ +/* 6 */ +EXTERN unsigned short TclWinNToHS(unsigned short ns); +/* 7 */ +EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, + const char *optval, int optlen); /* 8 */ -EXTERN size_t TclpGetPid(Tcl_Pid pid); -/* Slot 9 is reserved */ -/* Slot 10 is reserved */ +EXTERN int TclpGetPid(Tcl_Pid pid); +/* 9 */ +EXTERN int TclWinGetPlatformId(void); +/* 10 */ +EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 12 */ EXTERN int TclpCloseFile(TclFile file); @@ -136,22 +167,25 @@ /* 18 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ -EXTERN void TclWinAddProcess(HANDLE hProcess, size_t id); -/* Slot 21 is reserved */ +EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); +/* 21 */ +EXTERN char * TclpInetNtoa(struct in_addr addr); /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ -/* Slot 26 is reserved */ +/* 26 */ +EXTERN void TclWinSetInterfaces(int wide); /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); -/* Slot 28 is reserved */ +/* 28 */ +EXTERN void TclWinResetInterfaces(void); /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, @@ -172,23 +206,28 @@ /* 4 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); -/* Slot 5 is reserved */ +/* 5 */ +EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout); /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* Slot 10 is reserved */ -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ -/* Slot 13 is reserved */ +/* 10 */ +EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); +/* 11 */ +EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); +/* 12 */ +EXTERN struct tm * TclpGmtime_unix(const time_t *clock); +/* 13 */ +EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 15 */ @@ -211,11 +250,12 @@ /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* Slot 22 is reserved */ +/* 22 */ +EXTERN TclFile TclpCreateTempFile_(const char *contents); /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ @@ -236,28 +276,28 @@ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ - void (*reserved5)(void); + int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - void (*reserved10)(void); - void (*reserved11)(void); - void (*reserved12)(void); - void (*reserved13)(void); + Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ + struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ + struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ + char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ - void (*reserved15)(void); - void (*reserved16)(void); - void (*reserved17)(void); - void (*reserved18)(void); - void (*reserved19)(void); + int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ + int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ + int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ + int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ + void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ void (*reserved20)(void); void (*reserved21)(void); - void (*reserved22)(void); + TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); void (*reserved24)(void); void (*reserved25)(void); void (*reserved26)(void); void (*reserved27)(void); @@ -265,65 +305,65 @@ int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ - void (*reserved1)(void); - void (*reserved2)(void); - void (*reserved3)(void); + void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ + struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ + int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ - void (*reserved6)(void); - void (*reserved7)(void); - size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ - void (*reserved9)(void); - void (*reserved10)(void); + unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ + int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ + int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ + int (*tclWinGetPlatformId) (void); /* 9 */ + Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ - void (*tclWinAddProcess) (HANDLE hProcess, size_t id); /* 20 */ - void (*reserved21)(void); + void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ + char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); - void (*reserved26)(void); + void (*tclWinSetInterfaces) (int wide); /* 26 */ void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*reserved28)(void); + void (*tclWinResetInterfaces) (void); /* 28 */ int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ - void (*reserved5)(void); + int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - void (*reserved10)(void); - void (*reserved11)(void); - void (*reserved12)(void); - void (*reserved13)(void); + Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ + struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ + struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ + char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ void (*reserved20)(void); void (*reserved21)(void); - void (*reserved22)(void); + TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */ void (*reserved23)(void); void (*reserved24)(void); void (*reserved25)(void); void (*reserved26)(void); void (*reserved27)(void); @@ -354,33 +394,44 @@ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ -/* Slot 5 is reserved */ +#define TclUnixWaitForFile_ \ + (tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -/* Slot 10 is reserved */ -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ -/* Slot 13 is reserved */ +#define TclpReaddir \ + (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +#define TclpLocaltime_unix \ + (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ +#define TclpGmtime_unix \ + (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ -/* Slot 15 is reserved */ -/* Slot 16 is reserved */ -/* Slot 17 is reserved */ -/* Slot 18 is reserved */ -/* Slot 19 is reserved */ +#define TclMacOSXGetFileAttribute \ + (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ +#define TclMacOSXSetFileAttribute \ + (tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */ +#define TclMacOSXCopyFileAttributes \ + (tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */ +#define TclMacOSXMatchType \ + (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ +#define TclMacOSXNotifierAddRunLoopMode \ + (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* Slot 22 is reserved */ +#define TclpCreateTempFile_ \ + (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ @@ -391,23 +442,30 @@ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -/* Slot 1 is reserved */ -/* Slot 2 is reserved */ -/* Slot 3 is reserved */ +#define TclWinConvertWSAError \ + (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ +#define TclWinGetServByName \ + (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ +#define TclWinGetSockOpt \ + (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -/* Slot 6 is reserved */ -/* Slot 7 is reserved */ +#define TclWinNToHS \ + (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ +#define TclWinSetSockOpt \ + (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ -/* Slot 9 is reserved */ -/* Slot 10 is reserved */ +#define TclWinGetPlatformId \ + (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +#define TclpReaddir \ + (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 12 */ #define TclpCreateCommandChannel \ @@ -424,21 +482,24 @@ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -/* Slot 21 is reserved */ +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ -/* Slot 26 is reserved */ +#define TclWinSetInterfaces \ + (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -/* Slot 28 is reserved */ +#define TclWinResetInterfaces \ + (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* WIN */ @@ -451,23 +512,28 @@ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ -/* Slot 5 is reserved */ +#define TclUnixWaitForFile_ \ + (tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -/* Slot 10 is reserved */ -/* Slot 11 is reserved */ -/* Slot 12 is reserved */ -/* Slot 13 is reserved */ +#define TclpReaddir \ + (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +#define TclpLocaltime_unix \ + (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ +#define TclpGmtime_unix \ + (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ #define TclMacOSXSetFileAttribute \ @@ -478,11 +544,12 @@ (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* Slot 22 is reserved */ +#define TclpCreateTempFile_ \ + (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ /* Slot 26 is reserved */ /* Slot 27 is reserved */ @@ -497,13 +564,45 @@ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#undef TclpLocaltime_unix +#undef TclpGmtime_unix +#undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError +#undef TclpInetNtoa +#define TclpInetNtoa inet_ntoa + +#undef TclpCreateTempFile_ +#undef TclUnixWaitForFile_ +#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */ +#undef TclMacOSXGetFileAttribute /* 15 */ +#undef TclMacOSXSetFileAttribute /* 16 */ +#undef TclMacOSXCopyFileAttributes /* 17 */ +#undef TclMacOSXMatchType /* 18 */ +#undef TclMacOSXNotifierAddRunLoopMode /* 19 */ +#endif -#if !defined(_WIN32) +#if defined(_WIN32) +# undef TclWinNToHS +# undef TclWinGetServByName +# undef TclWinGetSockOpt +# undef TclWinSetSockOpt +# undef TclWinGetPlatformId +# undef TclWinResetInterfaces +# undef TclWinSetInterfaces +# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +# define TclWinNToHS ntohs +# define TclWinGetServByName getservbyname +# define TclWinGetSockOpt getsockopt +# define TclWinSetSockOpt setsockopt +# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */ +# define TclWinResetInterfaces() /* nop */ +# define TclWinSetInterfaces(dummy) /* nop */ +# endif /* TCL_NO_DEPRECATED */ +#else # undef TclpGetPid -# define TclpGetPid(pid) ((size_t) (pid)) +# define TclpGetPid(pid) ((unsigned long) (pid)) #endif #endif /* _TCLINTPLATDECLS */ Index: generic/tclInterp.c ================================================================== --- generic/tclInterp.c +++ generic/tclInterp.c @@ -23,18 +23,18 @@ /* Forward declaration */ struct Target; /* - * Alias: + * struct Alias: * * Stores information about an alias. Is stored in the slave interpreter and * used by the source command to find the target command in the master when * the source command is invoked. */ -typedef struct { +typedef struct Alias { Tcl_Obj *token; /* Token for the alias command in the slave * interp. This used to be the command name in * the slave when the alias was first * created. */ Tcl_Interp *targetInterp; /* Interp in which target command will be @@ -64,18 +64,18 @@ * prefix. */ } Alias; /* * - * Slave: + * struct Slave: * * Used by the "interp" command to record and find information about slave * interpreters. Maps from a command name in the master to information about a * slave interpreter, e.g. what aliases are defined in it. */ -typedef struct { +typedef struct Slave { Tcl_Interp *masterInterp; /* Master interpreter for this slave. */ Tcl_HashEntry *slaveEntryPtr; /* Hash entry in masters slave table for this * slave interpreter. Used to find this * record, and used when deleting the slave @@ -110,11 +110,11 @@ struct Target *prevPtr; /* Previous in list of target records, or NULL * if at the start of the list of targets. */ } Target; /* - * Master: + * struct Master: * * This record is used for two purposes: First, slaveTable (a hashtable) maps * from names of commands to slave interpreters. This hashtable is used to * store information about slave interpreters of this interpreter, to map over * all slaves, etc. The second purpose is to store information about all @@ -125,11 +125,11 @@ * denotes whether the interpreter is safe or not. Safe interpreters have * restricted functionality, can only create safe slave interpreters and can * only load safe extensions. */ -typedef struct { +typedef struct Master { Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps * from command names to Slave records. */ Target *targetsPtr; /* The head of a doubly-linked list of all the * target records which denote aliases from * slaves or sibling interpreters that direct @@ -142,11 +142,11 @@ /* * The following structure keeps track of all the Master and Slave information * on a per-interp basis. */ -typedef struct { +typedef struct InterpInfo { Master master; /* Keeps track of all interps for which this * interp is the Master. */ Slave slave; /* Information necessary for this interp to * function as a slave. */ } InterpInfo; @@ -156,11 +156,11 @@ * stored in hashes indexed by a two-word key. Note that the type of the * 'type' field in the key is not int; this is to make sure that things are * likely to work properly on 64-bit architectures. */ -typedef struct { +typedef struct ScriptLimitCallback { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the * user-defined part of the callback. */ int type; /* What kind of callback is this. */ @@ -169,11 +169,11 @@ * callback record, or NULL if the entry has * already been deleted from that hash * table. */ } ScriptLimitCallback; -typedef struct { +typedef struct ScriptLimitCallbackKey { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ long type; /* The type of callback that this is. */ } ScriptLimitCallbackKey; @@ -220,19 +220,16 @@ static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp); -static int AliasNRCmd(ClientData dummy, - Tcl_Interp *currentInterp, int objc, - Tcl_Obj *const objv[]); -static void AliasObjCmdDeleteProc(ClientData clientData); +static Tcl_ObjCmdProc AliasNRCmd; +static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static void InterpInfoDeleteProc(ClientData clientData, - Tcl_Interp *interp); +static Tcl_InterpDeleteProc InterpInfoDeleteProc; static int SlaveBgerror(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, Tcl_Obj *const objv[]); static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe); @@ -252,11 +249,11 @@ Tcl_Interp *slaveInterp, const char *namespaceName, int objc, Tcl_Obj *const objv[]); static int SlaveMarkTrusted(Tcl_Interp *interp, Tcl_Interp *slaveInterp); -static void SlaveObjCmdDeleteProc(ClientData clientData); +static Tcl_CmdDeleteProc SlaveObjCmdDeleteProc; static int SlaveRecursionLimit(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, Tcl_Obj *const objv[]); static int SlaveCommandLimitCmd(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int consumedObjc, @@ -334,11 +331,11 @@ int Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { PkgName pkgName = {NULL, "Tcl"}; - PkgName **names = TclInitPkgFiles(interp); + PkgName **names = (PkgName **)TclInitPkgFiles(interp); int result = TCL_ERROR; pkgName.nextPtr = *names; *names = &pkgName; if (tclPreInitScript != NULL) { @@ -483,11 +480,11 @@ { InterpInfo *interpInfoPtr; Master *masterPtr; Slave *slavePtr; - interpInfoPtr = Tcl_Alloc(sizeof(InterpInfo)); + interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo)); ((Interp *) interp)->interpInfo = interpInfoPtr; masterPtr = &interpInfoPtr->master; Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS); masterPtr->targetsPtr = NULL; @@ -523,11 +520,11 @@ *--------------------------------------------------------------------------- */ static void InterpInfoDeleteProc( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp) /* Interp being deleted. All commands for * slave interps should already be deleted. */ { InterpInfo *interpInfoPtr; Slave *slavePtr; @@ -580,11 +577,11 @@ if (slavePtr->aliasTable.numEntries != 0) { Tcl_Panic("InterpInfoDeleteProc: still exist aliases"); } Tcl_DeleteHashTable(&slavePtr->aliasTable); - Tcl_Free(interpInfoPtr); + ckfree(interpInfoPtr); } /* *---------------------------------------------------------------------- * @@ -599,24 +596,24 @@ * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ + int Tcl_InterpObjCmd( - ClientData clientData, /* Unused. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv); } static int NRInterpCmd( - ClientData clientData, /* Unused. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *slaveInterp; @@ -784,11 +781,11 @@ */ slavePtr = NULL; last = 0; for (i = 2; i < objc; i++) { - if ((last == 0) && (TclGetString(objv[i])[0] == '-')) { + if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) { if (Tcl_GetIndexFromObj(interp, objv[i], createOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_SAFE) { @@ -997,10 +994,11 @@ return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv); case LIMIT_TYPE_TIME: return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv); } } + break; case OPT_MARKTRUSTED: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } @@ -1032,11 +1030,11 @@ } iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; resultPtr = Tcl_NewObj(); hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { - string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr); + string = (char *)Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(string, -1)); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; @@ -1098,20 +1096,20 @@ iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" in path \"%s\" not found", - aliasName, TclGetString(objv[2]))); + aliasName, Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } - aliasPtr = Tcl_GetHashValue(hPtr); + aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "target interpreter for alias \"%s\" in path \"%s\" is " - "not my descendant", aliasName, TclGetString(objv[2]))); + "not my descendant", aliasName, Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "TARGETSHROUDED", NULL); return TCL_ERROR; } return TCL_OK; @@ -1186,11 +1184,11 @@ Tcl_Obj *slaveObjPtr, *targetObjPtr; Tcl_Obj **objv; int i; int result; - objv = TclStackAlloc(slaveInterp, sizeof(Tcl_Obj *) * argc); + objv = (Tcl_Obj **)TclStackAlloc(slaveInterp, sizeof(Tcl_Obj *) * argc); for (i = 0; i < argc; i++) { objv[i] = Tcl_NewStringObj(argv[i], -1); Tcl_IncrRefCount(objv[i]); } @@ -1292,11 +1290,11 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", aliasName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } - aliasPtr = Tcl_GetHashValue(hPtr); + aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; if (targetInterpPtr != NULL) { *targetInterpPtr = aliasPtr->targetInterp; @@ -1307,11 +1305,11 @@ if (argcPtr != NULL) { *argcPtr = objc - 1; } if (argvPtr != NULL) { *argvPtr = (const char **) - Tcl_Alloc(sizeof(const char *) * (objc - 1)); + ckalloc(sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { (*argvPtr)[i - 1] = TclGetString(objv[i]); } } return TCL_OK; @@ -1354,11 +1352,11 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", aliasName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } - aliasPtr = Tcl_GetHashValue(hPtr); + aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; if (targetInterpPtr != NULL) { *targetInterpPtr = aliasPtr->targetInterp; @@ -1423,11 +1421,11 @@ * OK, we are dealing with an alias, so traverse the chain of aliases. If * we encounter the alias we are defining (or renaming to) any in the * chain then we have a loop. */ - aliasPtr = cmdPtr->objClientData; + aliasPtr = (Alias *)cmdPtr->objClientData; nextAliasPtr = aliasPtr; while (1) { Tcl_Obj *cmdNamePtr; /* @@ -1472,14 +1470,12 @@ if (aliasCmdPtr->objProc != TclAliasObjCmd && aliasCmdPtr->objProc != TclLocalAliasObjCmd) { return TCL_OK; } - nextAliasPtr = aliasCmdPtr->objClientData; + nextAliasPtr = (Alias *)aliasCmdPtr->objClientData; } - - /* NOTREACHED */ } /* *---------------------------------------------------------------------- * @@ -1515,11 +1511,11 @@ Slave *slavePtr; Master *masterPtr; Tcl_Obj **prefv; int isNew, i; - aliasPtr = Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); + aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); aliasPtr->token = namePtr; Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = masterInterp; aliasPtr->objc = objc + 1; @@ -1566,11 +1562,11 @@ cmdPtr->clientData = NULL; cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd); - Tcl_Free(aliasPtr); + ckfree(aliasPtr); /* * The result was already set by TclPreventAliasLoop. */ @@ -1623,11 +1619,11 @@ * interp alias {} foo {} bar # Create an alias "foo" * rename foo zop # Now rename the alias * interp alias {} foo {} zop # Now recreate "foo"... */ - targetPtr = Tcl_Alloc(sizeof(Target)); + targetPtr = (Target *)ckalloc(sizeof(Target)); targetPtr->slaveCmd = aliasPtr->slaveCmd; targetPtr->slaveInterp = slaveInterp; masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master; targetPtr->nextPtr = masterPtr->targetsPtr; @@ -1684,11 +1680,11 @@ "alias \"%s\" not found", TclGetString(namePtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", TclGetString(namePtr), NULL); return TCL_ERROR; } - aliasPtr = Tcl_GetHashValue(hPtr); + aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd); return TCL_OK; } /* @@ -1725,15 +1721,15 @@ * the original name (with which it was created) to find the alias to * describe it. */ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; - hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr)); + hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr)); if (hPtr == NULL) { return TCL_OK; } - aliasPtr = Tcl_GetHashValue(hPtr); + aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr); Tcl_SetObjResult(interp, prefixPtr); return TCL_OK; } @@ -1766,11 +1762,11 @@ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch); for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) { - aliasPtr = Tcl_GetHashValue(entryPtr); + aliasPtr = (Alias *)Tcl_GetHashValue(entryPtr); Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } @@ -1807,11 +1803,11 @@ ClientData clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { - Alias *aliasPtr = clientData; + Alias *aliasPtr = (Alias *)clientData; int prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *listPtr; List *listRep; int flags = TCL_EVAL_INVOKE; @@ -1829,12 +1825,12 @@ listRep = ListRepPtr(listPtr); listRep->elemCount = cmdc; cmdv = &listRep->elements; prefv = &aliasPtr->objPtr; - memcpy(cmdv, prefv, (prefc * sizeof(Tcl_Obj *))); - memcpy(cmdv+prefc, objv+1, ((objc-1) * sizeof(Tcl_Obj *))); + memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *)); + memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *)); for (i=0; itargetInterp; int result, prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *tPtr = (Interp *) targetInterp; @@ -1875,11 +1871,11 @@ prefv = &aliasPtr->objPtr; cmdc = prefc + objc - 1; if (cmdc <= ALIAS_CMDV_PREALLOC) { cmdv = cmdArr; } else { - cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); + cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); } memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *)); memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *)); @@ -1947,11 +1943,11 @@ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 - Alias *aliasPtr = clientData; + Alias *aliasPtr = (Alias *)clientData; int result, prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *iPtr = (Interp *) interp; int isRootEnsemble; @@ -1965,11 +1961,11 @@ prefv = &aliasPtr->objPtr; cmdc = prefc + objc - 1; if (cmdc <= ALIAS_CMDV_PREALLOC) { cmdv = cmdArr; } else { - cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); + cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); } memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *)); memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *)); @@ -2028,11 +2024,11 @@ static void AliasObjCmdDeleteProc( ClientData clientData) /* The alias record for this alias. */ { - Alias *aliasPtr = clientData; + Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; int i; Tcl_Obj **objv; Tcl_DecrRefCount(aliasPtr->token); @@ -2057,12 +2053,12 @@ } if (targetPtr->nextPtr != NULL) { targetPtr->nextPtr->prevPtr = targetPtr->prevPtr; } - Tcl_Free(targetPtr); - Tcl_Free(aliasPtr); + ckfree(targetPtr); + ckfree(aliasPtr); } /* *---------------------------------------------------------------------- * @@ -2204,11 +2200,11 @@ masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master; hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { - slavePtr = Tcl_GetHashValue(hPtr); + slavePtr = (Slave *)Tcl_GetHashValue(hPtr); iPtr = (Interp *) slavePtr->slaveInterp; if (iPtr == NULL) { continue; } @@ -2269,11 +2265,11 @@ iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo; if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){ return TCL_ERROR; } Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp), - Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable, + Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->master.slaveTable, iiPtr->slave.slaveEntryPtr), -1)); return TCL_OK; } /* @@ -2317,11 +2313,11 @@ TclGetString(objv[i])); if (hPtr == NULL) { searchInterp = NULL; break; } - slavePtr = Tcl_GetHashValue(hPtr); + slavePtr = (Slave *)Tcl_GetHashValue(hPtr); searchInterp = slavePtr->slaveInterp; if (searchInterp == NULL) { break; } } @@ -2543,11 +2539,11 @@ ClientData clientData, /* Slave interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Interp *slaveInterp = clientData; + Tcl_Interp *slaveInterp = (Tcl_Interp *)clientData; int index; static const char *const options[] = { "alias", "aliases", "bgerror", "debug", "eval", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", @@ -2705,10 +2701,11 @@ return SlaveCommandLimitCmd(interp, slaveInterp, 3, objc,objv); case LIMIT_TYPE_TIME: return SlaveTimeLimitCmd(interp, slaveInterp, 3, objc, objv); } } + break; case OPT_MARKTRUSTED: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } @@ -2746,11 +2743,11 @@ static void SlaveObjCmdDeleteProc( ClientData clientData) /* The SlaveRecord for the command. */ { Slave *slavePtr; /* Interim storage for Slave record. */ - Tcl_Interp *slaveInterp = clientData; + Tcl_Interp *slaveInterp = (Tcl_Interp *)clientData; /* And for a slave interp. */ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; /* @@ -3086,11 +3083,11 @@ if (hTblPtr != NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { Tcl_ListObjAppendElement(NULL, listObjPtr, - Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1)); + Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), -1)); } } Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } @@ -3289,11 +3286,11 @@ /* * No env array in a safe slave. */ - Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); /* * Remove unsafe parts of tcl_platform */ @@ -3305,13 +3302,13 @@ /* * Unset path informations variables (the only one remaining is [info * nameofexecutable]) */ - Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY); - Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); - Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); /* * Remove the standard channels from the interpreter; safe interpreters do * not ordinarily have access to stdin, stdout and stderr. * @@ -3360,11 +3357,11 @@ int Tcl_LimitExceeded( Tcl_Interp *interp) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; return iPtr->limit.exceeded != 0; } /* @@ -3391,14 +3388,14 @@ int Tcl_LimitReady( Tcl_Interp *interp) { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; if (iPtr->limit.active != 0) { - register int ticker = ++iPtr->limit.granularityTicker; + int ticker = ++iPtr->limit.granularityTicker; if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || (ticker % iPtr->limit.cmdGranularity == 0))) { return 1; @@ -3438,11 +3435,11 @@ int Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; - register int ticker = iPtr->limit.granularityTicker; + int ticker = iPtr->limit.granularityTicker; if (Tcl_InterpDeleted(interp)) { return TCL_OK; } @@ -3558,11 +3555,11 @@ if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - Tcl_Free(handlerPtr); + ckfree(handlerPtr); } } } /* @@ -3595,18 +3592,18 @@ /* * Convert everything into a real deletion callback. */ if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) { - deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree; + deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free; } /* * Allocate a handler record. */ - handlerPtr = Tcl_Alloc(sizeof(LimitHandler)); + handlerPtr = (LimitHandler *)ckalloc(sizeof(LimitHandler)); handlerPtr->flags = 0; handlerPtr->handlerProc = handlerProc; handlerPtr->clientData = clientData; handlerPtr->deleteProc = deleteProc; handlerPtr->prevPtr = NULL; @@ -3721,11 +3718,11 @@ if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - Tcl_Free(handlerPtr); + ckfree(handlerPtr); } return; } } @@ -3781,11 +3778,11 @@ if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - Tcl_Free(handlerPtr); + ckfree(handlerPtr); } } /* * Delete all time-limit handlers. @@ -3814,11 +3811,11 @@ if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - Tcl_Free(handlerPtr); + ckfree(handlerPtr); } } /* * Delete the timer callback that is used to trap limits that occur in @@ -4059,12 +4056,12 @@ static void TimeLimitCallback( ClientData clientData) { - Tcl_Interp *interp = clientData; - Interp *iPtr = clientData; + Tcl_Interp *interp = (Tcl_Interp *)clientData; + Interp *iPtr = (Interp *)clientData; int code; Tcl_Preserve(interp); iPtr->limit.timeEvent = NULL; @@ -4203,17 +4200,17 @@ static void DeleteScriptLimitCallback( ClientData clientData) { - ScriptLimitCallback *limitCBPtr = clientData; + ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData; Tcl_DecrRefCount(limitCBPtr->scriptObj); if (limitCBPtr->entryPtr != NULL) { Tcl_DeleteHashEntry(limitCBPtr->entryPtr); } - Tcl_Free(limitCBPtr); + ckfree(limitCBPtr); } /* *---------------------------------------------------------------------- * @@ -4233,13 +4230,13 @@ */ static void CallScriptLimitCallback( ClientData clientData, - Tcl_Interp *interp) /* Interpreter which failed the limit */ + TCL_UNUSED(Tcl_Interp *)) { - ScriptLimitCallback *limitCBPtr = clientData; + ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData; int code; if (Tcl_InterpDeleted(limitCBPtr->interp)) { return; } @@ -4303,17 +4300,17 @@ } hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key, &isNew); if (!isNew) { - limitCBPtr = Tcl_GetHashValue(hashPtr); + limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hashPtr); limitCBPtr->entryPtr = NULL; Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback, limitCBPtr); } - limitCBPtr = Tcl_Alloc(sizeof(ScriptLimitCallback)); + limitCBPtr = (ScriptLimitCallback *)ckalloc(sizeof(ScriptLimitCallback)); limitCBPtr->interp = interp; limitCBPtr->scriptObj = scriptObj; limitCBPtr->entryPtr = hashPtr; limitCBPtr->type = type; Tcl_IncrRefCount(scriptObj); @@ -4498,11 +4495,11 @@ TclNewObj(dictPtr); key.interp = slaveInterp; key.type = TCL_LIMIT_COMMANDS; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = Tcl_GetHashValue(hPtr); + limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; @@ -4540,11 +4537,11 @@ case OPT_CMD: key.interp = slaveInterp; key.type = TCL_LIMIT_COMMANDS; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = Tcl_GetHashValue(hPtr); + limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_SetObjResult(interp, limitCBPtr->scriptObj); } } break; @@ -4562,12 +4559,11 @@ return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i; - size_t scriptLen = 0, limitLen = 0; + int i, scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; for (i=consumedObjc ; ilimit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = Tcl_GetHashValue(hPtr); + limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; @@ -4735,11 +4731,11 @@ case OPT_CMD: key.interp = slaveInterp; key.type = TCL_LIMIT_TIME; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = Tcl_GetHashValue(hPtr); + limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_SetObjResult(interp, limitCBPtr->scriptObj); } } break; @@ -4768,12 +4764,11 @@ return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i; - size_t scriptLen = 0, milliLen = 0, secLen = 0; + int i, scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; Tcl_Time limitMoment; int tmp; Index: generic/tclLink.c ================================================================== --- generic/tclLink.c +++ generic/tclLink.c @@ -14,31 +14,31 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" #include /* * For each linked variable there is a data structure of the following type, * which describes the link and is the clientData for the trace set on the Tcl * variable. */ -typedef struct { +typedef struct Link { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the * actual variable may be aliased at that time * via upvar. */ void *addr; /* Location of C variable. */ - size_t bytes; /* Size of C variable array. This is 0 when + int bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ - size_t numElems; /* Number of elements in C variable array. + int numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { char c; unsigned char uc; @@ -162,18 +162,18 @@ Namespace *dummy; const char *name; int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, - TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); + TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable '%s' is already linked", varName)); return TCL_ERROR; } - linkPtr = Tcl_Alloc(sizeof(Link)); + linkPtr = (Link *)ckalloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->nsPtr = NULL; linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; @@ -243,11 +243,11 @@ * varName. If NULL then the necessary space * will be allocated and returned as the * interpreter result. */ int type, /* Type of C variable: TCL_LINK_INT, etc. Also * may have TCL_LINK_READ_ONLY OR'ed in. */ - size_t size) /* Size of C variable array, >1 if array */ + int size) /* Size of C variable array, >1 if array */ { Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; @@ -257,12 +257,20 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong array size given", -1)); return TCL_ERROR; } - linkPtr = Tcl_Alloc(sizeof(Link)); + linkPtr = (Link *)ckalloc(sizeof(Link)); linkPtr->type = type & ~TCL_LINK_READ_ONLY; +#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \ + || defined(_WIN32) || defined(__CYGWIN__)) + if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) { + linkPtr->type = TCL_LINK_LONG; + } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) { + linkPtr->type = TCL_LINK_ULONG; + } +#endif linkPtr->numElems = size; if (type & TCL_LINK_READ_ONLY) { linkPtr->flags = LINK_READ_ONLY; } else { linkPtr->flags = 0; @@ -317,11 +325,11 @@ * If no address is given create one and use as address the * not needed linkPtr->lastValue */ if (addr == NULL) { - linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes); + linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_LAST; addr = (char *) &linkPtr->lastValue.cPtr; } break; case TCL_LINK_CHARS: @@ -338,11 +346,11 @@ /* * Allocate C variable space in case no address is given */ if (addr == NULL) { - linkPtr->addr = Tcl_Alloc(linkPtr->bytes); + linkPtr->addr = ckalloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_ADDR; } else { linkPtr->addr = addr; } @@ -349,11 +357,11 @@ /* * If necessary create space for last used value. */ if (size > 1) { - linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes); + linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_LAST; } /* * Initialize allocated space. @@ -525,21 +533,21 @@ if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) { if (type == TCL_NUMBER_INT) { *widePtr = *((const Tcl_WideInt *) clientData); return (*widePtr < 0); } else if (type == TCL_NUMBER_BIG) { - mp_int *numPtr = clientData; + mp_int *numPtr = (mp_int *)clientData; Tcl_WideUInt value = 0; union { Tcl_WideUInt value; unsigned char bytes[sizeof(Tcl_WideUInt)]; } scratch; - unsigned long numBytes = sizeof(Tcl_WideUInt); + size_t numBytes; unsigned char *bytes = scratch.bytes; - if (numPtr->sign || (MP_OKAY != mp_to_unsigned_bin_n(numPtr, - bytes, &numBytes))) { + if (numPtr->sign || (MP_OKAY != mp_to_ubin(numPtr, + bytes, sizeof(Tcl_WideUInt), &numBytes))) { /* * If the sign bit is set (a negative value) or if the value * can't possibly fit in the bits of an unsigned wide, there's * no point in doing further conversion. */ @@ -618,27 +626,27 @@ * Mark an object as holding a weird double. */ static int SetInvalidRealFromAny( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) { - size_t length; - const char *str, *endPtr; + const char *str; + const char *endPtr; - str = TclGetStringFromObj(objPtr, &length); - if ((length == 1) && (str[0] == '.')) { + str = TclGetString(objPtr); + if ((objPtr->length == 1) && (str[0] == '.')) { objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = 0.0; return TCL_OK; } - if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr, + if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr, TCL_PARSE_DECIMAL_ONLY) == TCL_OK) { /* - * If number is followed by [eE][+-]?, then it is an invalid double, - * but it could be the start of a valid double. + * If number is followed by [eE][+-]?, then it is an invalid + * double, but it could be the start of a valid double. */ if (*endPtr == 'e' || *endPtr == 'E') { ++endPtr; if (*endPtr == '+' || *endPtr == '-') { @@ -657,40 +665,39 @@ } return TCL_ERROR; } /* - * This function checks for integer representations, which are valid when - * linking with C variables, but which are invalid in other contexts in Tcl. - * Handled are "+", "-", "", "0x", "0b", "0d" and "0o" (upper- and - * lower-case). See bug [39f6304c2e]. + * This function checks for integer representations, which are valid + * when linking with C variables, but which are invalid in other + * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o" + * (upperand lowercase). See bug [39f6304c2e]. */ static int GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { - size_t length; - const char *str = TclGetStringFromObj(objPtr, &length); + const char *str = TclGetString(objPtr); - if ((length == 0) || - ((length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) { + if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0') + && strchr("xXbBoOdD", str[1]))) { *intPtr = 0; return TCL_OK; - } else if ((length == 1) && strchr("+-", str[0])) { + } else if ((objPtr->length == 1) && strchr("+-", str[0])) { *intPtr = (str[0] == '+'); return TCL_OK; } return TCL_ERROR; } /* - * This function checks for double representations, which are valid when - * linking with C variables, but which are invalid in other contexts in Tcl. - * Handled are "+", "-", "", ".", "0x", "0b" and "0o" (upper- and lower-case) - * and sequences like "1e-". See bug [39f6304c2e]. + * This function checks for double representations, which are valid + * when linking with C variables, but which are invalid in other + * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o" + * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e]. */ static int GetInvalidDoubleFromObj( Tcl_Obj *objPtr, @@ -736,17 +743,20 @@ static char * LinkTraceProc( ClientData clientData, /* Contains information about the link. */ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ - const char *name1, /* First part of variable name. */ - const char *name2, /* Second part of variable name. */ + TCL_UNUSED(const char *) /*name1*/, + TCL_UNUSED(const char *) /*name2*/, + /* Links can only be made to global variables, + * so we can find them with need to resolve + * caller-supplied name in caller context. */ int flags) /* Miscellaneous additional information. */ { - Link *linkPtr = clientData; + Link *linkPtr = (Link *)clientData; int changed; - size_t valueLength = 0; + int valueLength; const char *value; char **pp; Tcl_Obj *valueObj; int valueInt; Tcl_WideInt valueWide; @@ -766,11 +776,11 @@ Tcl_DecrRefCount(linkPtr->varName); LinkFree(linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - Tcl_TraceVar2(interp, TclGetString(linkPtr->varName), NULL, + Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); } return NULL; } @@ -884,19 +894,20 @@ * Special cases. */ switch (linkPtr->type) { case TCL_LINK_STRING: - value = TclGetStringFromObj(valueObj, &valueLength); + value = TclGetString(valueObj); + valueLength = valueObj->length + 1; pp = (char **) linkPtr->addr; - *pp = Tcl_Realloc(*pp, ++valueLength); + *pp = (char *)ckrealloc(*pp, valueLength); memcpy(*pp, value, valueLength); return NULL; case TCL_LINK_CHARS: - value = (char *) TclGetStringFromObj(valueObj, &valueLength); + value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength); valueLength++; /* include end of string char */ if (valueLength > linkPtr->bytes) { return (char *) "wrong size of char* value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { @@ -907,11 +918,11 @@ LinkedVar(char) = linkPtr->lastValue.c; } return NULL; case TCL_LINK_BINARY: - value = (char *) TclGetByteArrayFromObj(valueObj, &valueLength); + value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength); if (valueLength != linkPtr->bytes) { return (char *) "wrong size of binary value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength); @@ -935,11 +946,11 @@ * If we're working with an array of numbers, extract the Tcl list. */ if (linkPtr->flags & LINK_ALLOC_LAST) { if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR - || (size_t)objc != linkPtr->numElems) { + || objc != linkPtr->numElems) { return (char *) "wrong dimension"; } } switch (linkPtr->type) { @@ -1175,21 +1186,21 @@ case TCL_LINK_ULONG: if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetUWide(objv[i], &valueUWide) - || !InRange(0, valueUWide, ULONG_MAX)) { + || (valueUWide > ULONG_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable array must have unsigned long value"; } linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide; } } else { if (GetUWide(valueObj, &valueUWide) - || !InRange(0, valueUWide, ULONG_MAX)) { + || (valueUWide > ULONG_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have unsigned long value"; } LinkedVar(unsigned long) = linkPtr->lastValue.ul = @@ -1275,181 +1286,181 @@ ObjValue( Link *linkPtr) /* Structure describing linked variable. */ { char *p; Tcl_Obj *resultObj, **objv; - size_t i; + int i; switch (linkPtr->type) { case TCL_LINK_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewIntObj(linkPtr->lastValue.iPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.i = LinkedVar(int); return Tcl_NewIntObj(linkPtr->lastValue.i); case TCL_LINK_WIDE_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.wPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.w = LinkedVar(Tcl_WideInt); return Tcl_NewWideIntObj(linkPtr->lastValue.w); case TCL_LINK_DOUBLE: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.d = LinkedVar(double); return Tcl_NewDoubleObj(linkPtr->lastValue.d); case TCL_LINK_BOOLEAN: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.i = LinkedVar(int); return Tcl_NewBooleanObj(linkPtr->lastValue.i); case TCL_LINK_CHAR: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewIntObj(linkPtr->lastValue.cPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.c = LinkedVar(char); return Tcl_NewIntObj(linkPtr->lastValue.c); case TCL_LINK_UCHAR: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ucPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.uc = LinkedVar(unsigned char); return Tcl_NewIntObj(linkPtr->lastValue.uc); case TCL_LINK_SHORT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewIntObj(linkPtr->lastValue.sPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.s = LinkedVar(short); return Tcl_NewIntObj(linkPtr->lastValue.s); case TCL_LINK_USHORT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewIntObj(linkPtr->lastValue.usPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.us = LinkedVar(unsigned short); return Tcl_NewIntObj(linkPtr->lastValue.us); case TCL_LINK_UINT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.uiPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.ui = LinkedVar(unsigned int); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui); #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) case TCL_LINK_LONG: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.lPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.l = LinkedVar(long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l); case TCL_LINK_ULONG: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.ulPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.ul = LinkedVar(unsigned long); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul); #endif case TCL_LINK_FLOAT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.f = LinkedVar(float); return Tcl_NewDoubleObj(linkPtr->lastValue.f); case TCL_LINK_WIDE_UINT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uwPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); + ckfree(objv); return resultObj; } linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw); @@ -1513,20 +1524,20 @@ { if (linkPtr->nsPtr) { TclNsDecrRefCount(linkPtr->nsPtr); } if (linkPtr->flags & LINK_ALLOC_ADDR) { - Tcl_Free(linkPtr->addr); + ckfree(linkPtr->addr); } if (linkPtr->flags & LINK_ALLOC_LAST) { - Tcl_Free(linkPtr->lastValue.aryPtr); + ckfree(linkPtr->lastValue.aryPtr); } - Tcl_Free(linkPtr); + ckfree((char *) linkPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -60,11 +60,11 @@ #define ListGetIntRep(objPtr, listRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclListType); \ - (listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) #define ListResetIntRep(objPtr, listRepPtr) \ TclFetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr) @@ -75,26 +75,24 @@ /* *---------------------------------------------------------------------- * * NewListIntRep -- * - * Creates a 'List' structure with space for 'objc' elements. 'objc' must - * be > 0. If 'objv' is not NULL, The list is initialized with first - * 'objc' values in that array. Otherwise the list is initialized to have - * 0 elements, with space to add 'objc' more. Flag value 'p' indicates + * Creates a list internal rep with space for objc elements. objc + * must be > 0. If objv!=NULL, initializes with the first objc values + * in that array. If objv==NULL, initalize list internal rep to have + * 0 elements, with space to add objc more. Flag value "p" indicates * how to behave on failure. * - * Value - * - * A new 'List' structure with refCount 0. If some failure - * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic' - * is called if it is not. - * - * Effect - * - * The refCount of each value in 'objv' is incremented as it is added - * to the list. + * Results: + * A new List struct with refCount 0 is returned. If some failure + * prevents this then if p=0, NULL is returned and otherwise the + * routine panics. + * + * Side effects: + * The ref counts of the elements in objv are incremented since the + * resulting list now refers to them. * *---------------------------------------------------------------------- */ static List * @@ -122,14 +120,14 @@ LIST_MAX); } return NULL; } - listRepPtr = Tcl_AttemptAlloc(LIST_SIZE(objc)); + listRepPtr = (List *)attemptckalloc(LIST_SIZE(objc)); if (listRepPtr == NULL) { if (p) { - Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", + Tcl_Panic("list creation failed: unable to alloc %u bytes", LIST_SIZE(objc)); } return NULL; } @@ -154,13 +152,25 @@ } /* *---------------------------------------------------------------------- * - * AttemptNewList -- + * AttemptNewList -- * - * Like NewListIntRep, but additionally sets an error message on failure. + * Creates a list internal rep with space for objc elements. objc + * must be > 0. If objv!=NULL, initializes with the first objc values + * in that array. If objv==NULL, initalize list internal rep to have + * 0 elements, with space to add objc more. + * + * Results: + * A new List struct with refCount 0 is returned. If some failure + * prevents this then NULL is returned, and an error message is left + * in the interp result, unless interp is NULL. + * + * Side effects: + * The ref counts of the elements in objv are incremented since the + * resulting list now refers to them. * *---------------------------------------------------------------------- */ static List * @@ -176,11 +186,11 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", + "list creation failed: unable to alloc %u bytes", LIST_SIZE(objc))); } Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return listRepPtr; @@ -189,24 +199,27 @@ /* *---------------------------------------------------------------------- * * Tcl_NewListObj -- * - * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is - * defined, 'Tcl_DbNewListObj' is called instead. - * - * Value - * - * A new list 'Tcl_Obj' to which is appended values from 'objv', or if - * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no - * elements. The string representation of the new 'Tcl_Obj' is set to - * NULL. The refCount of the list is 0. - * - * Effect - * - * The refCount of each elements in 'objv' is incremented as it is added - * to the list. + * This function is normally called when not debugging: i.e., when + * TCL_MEM_DEBUG is not defined. It creates a new list object from an + * (objc,objv) array: that is, each of the objc elements of the array + * referenced by objv is inserted as an element into a new Tcl object. + * + * When TCL_MEM_DEBUG is defined, this function just returns the result + * of calling the debugging version Tcl_DbNewListObj. + * + * Results: + * A new list object is returned that is initialized from the object + * pointers in objv. If objc is less than or equal to zero, an empty + * object is returned. The new object's string representation is left + * NULL. The resulting new list object has ref count 0. + * + * Side effects: + * The ref counts of the elements in objv are incremented since the + * resulting list now refers to them. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG @@ -253,18 +266,32 @@ #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * - * Tcl_DbNewListObj -- - * - * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the - * file name and line number from its caller. This simplifies debugging - * since the [memory active] command will report the correct file - * name and line number when reporting objects that haven't been freed. - * - * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead. + * Tcl_DbNewListObj -- + * + * This function is normally called when debugging: i.e., when + * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same + * as the Tcl_NewListObj function above except that it calls + * Tcl_DbCkalloc directly with the file name and line number from its + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. + * + * When TCL_MEM_DEBUG is not defined, this function just returns the + * result of calling Tcl_NewListObj. + * + * Results: + * A new list object is returned that is initialized from the object + * pointers in objv. If objc is less than or equal to zero, an empty + * object is returned. The new object's string representation is left + * NULL. The new list object has ref count 0. + * + * Side effects: + * The ref counts of the elements in objv are incremented since the + * resulting list now refers to them. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG @@ -307,14 +334,12 @@ Tcl_Obj * Tcl_DbNewListObj( int objc, /* Count of objects referenced by objv. */ Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewListObj(objc, objv); } #endif /* TCL_MEM_DEBUG */ @@ -321,12 +346,23 @@ /* *---------------------------------------------------------------------- * * Tcl_SetListObj -- * - * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of - * creating a new one. + * Modify an object to be a list containing each of the objc elements of + * the object array referenced by objv. + * + * Results: + * None. + * + * Side effects: + * The object is made a list object and is initialized from the object + * pointers in objv. If objc is less than or equal to zero, an empty + * object is returned. The new object's string representation is left + * NULL. The ref counts of the elements in objv are incremented since the + * list now refers to them. The object's old string and internal + * representations are freed and its type is set NULL. * *---------------------------------------------------------------------- */ void @@ -365,24 +401,22 @@ /* *---------------------------------------------------------------------- * * TclListObjCopy -- * - * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This - * provides for the C level a counterpart of the [lrange $list 0 end] - * command, while using internals details to be as efficient as possible. - * - * Value - * - * The address of the new 'Tcl_Obj' which shares its internal - * representation with 'listPtr', and whose refCount is 0. If 'listPtr' - * is not actually a list, the value is NULL, and an error message is left - * in 'interp' if it is not NULL. - * - * Effect - * - * 'listPtr' is converted to a list if it isn't one already. + * Makes a "pure list" copy of a list value. This provides for the C + * level a counterpart of the [lrange $list 0 end] command, while using + * internals details to be as efficient as possible. + * + * Results: + * Normally returns a pointer to a new Tcl_Obj, that contains the same + * list value as *listPtr does. The returned Tcl_Obj has a refCount of + * zero. If *listPtr does not hold a list, NULL is returned, and if + * interp is non-NULL, an error message is recorded there. + * + * Side effects: + * None. * *---------------------------------------------------------------------- */ Tcl_Obj * @@ -491,57 +525,53 @@ /* *---------------------------------------------------------------------- * * Tcl_ListObjGetElements -- * - * Retreive the elements in a list 'Tcl_Obj'. - * - * Value - * - * TCL_OK - * - * A count of list elements is stored, 'objcPtr', And a pointer to the - * array of elements in the list is stored in 'objvPtr'. - * - * The elements accessible via 'objvPtr' should be treated as readonly - * and the refCount for each object is _not_ incremented; the caller - * must do that if it holds on to a reference. Furthermore, the - * pointer and length returned by this function may change as soon as - * any function is called on the list object. Be careful about - * retaining the pointer in a local data structure. - * - * TCL_ERROR - * - * 'listPtr' is not a valid list. An error message is left in the - * interpreter's result if 'interp' is not NULL. - * - * Effect - * - * 'listPtr' is converted to a list object if it isn't one already. + * This function returns an (objc,objv) array of the elements in a list + * object. + * + * Results: + * The return value is normally TCL_OK; in this case *objcPtr is set to + * the count of list elements and *objvPtr is set to a pointer to an + * array of (*objcPtr) pointers to each list element. If listPtr does not + * refer to a list object and the object can not be converted to one, + * TCL_ERROR is returned and an error message will be left in the + * interpreter's result if interp is not NULL. + * + * The objects referenced by the returned array should be treated as + * readonly and their ref counts are _not_ incremented; the caller must + * do that if it holds on to a reference. Furthermore, the pointer and + * length returned by this function may change as soon as any function is + * called on the list object; be careful about retaining the pointer in a + * local data structure. + * + * Side effects: + * The possible conversion of the object referenced by listPtr + * to a list object. * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object for which an element array is + Tcl_Obj *listPtr, /* List object for which an element array is * to be returned. */ int *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { - register List *listRepPtr; + List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result; - size_t length; + int result, length; - (void) TclGetStringFromObj(listPtr, &length); + (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { *objcPtr = 0; *objvPtr = NULL; return TCL_OK; } @@ -559,39 +589,32 @@ /* *---------------------------------------------------------------------- * * Tcl_ListObjAppendList -- * - * Appends the elements of elemListPtr to those of listPtr. - * - * Value - * - * TCL_OK - * - * Success. - * - * TCL_ERROR - * - * 'listPtr' or 'elemListPtr' are not valid lists. An error - * message is left in the interpreter's result if 'interp' is not NULL. - * - * Effect - * - * The reference count of each element of 'elemListPtr' as it is added to - * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType' - * if they are not already. Appending the new elements may cause the - * array of element pointers in 'listObj' to grow. If any objects are - * appended to 'listPtr'. Any preexisting string representation of - * 'listPtr' is invalidated. + * This function appends the elements in the list value referenced by + * elemListPtr to the list value referenced by listPtr. + * + * Results: + * The return value is normally TCL_OK. If listPtr or elemListPtr do not + * refer to list values, TCL_ERROR is returned and an error message is + * left in the interpreter's result if interp is not NULL. + * + * Side effects: + * The reference counts of the elements in elemListPtr are incremented + * since the list now refers to them. listPtr and elemListPtr are + * converted, if necessary, to list objects. Also, appending the new + * elements may cause listObj's array of element pointers to grow. + * listPtr's old string representation, if any, is invalidated. * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object to append elements to. */ + Tcl_Obj *listPtr, /* List object to append elements to. */ Tcl_Obj *elemListPtr) /* List obj with elements to append. */ { int objc; Tcl_Obj **objv; @@ -618,31 +641,28 @@ /* *---------------------------------------------------------------------- * * Tcl_ListObjAppendElement -- * - * Like 'Tcl_ListObjAppendList', but Appends a single value to a list. - * - * Value - * - * TCL_OK - * - * 'objPtr' is appended to the elements of 'listPtr'. - * - * TCL_ERROR - * - * listPtr does not refer to a list object and the object can not be - * converted to one. An error message will be left in the - * interpreter's result if interp is not NULL. - * - * Effect - * - * If 'listPtr' is not already of type 'tclListType', it is converted. - * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'. - * Appending the new element may cause the the array of element pointers - * in 'listObj' to grow. Any preexisting string representation of - * 'listPtr' is invalidated. + * This function is a special purpose version of Tcl_ListObjAppendList: + * it appends a single object referenced by objPtr to the list object + * referenced by listPtr. If listPtr is not already a list object, an + * attempt will be made to convert it to one. + * + * Results: + * The return value is normally TCL_OK; in this case objPtr is added to + * the end of listPtr's list. If listPtr does not refer to a list object + * and the object can not be converted to one, TCL_ERROR is returned and + * an error message will be left in the interpreter's result if interp is + * not NULL. + * + * Side effects: + * The ref count of objPtr is incremented since the list now refers to + * it. listPtr will be converted, if necessary, to a list object. Also, + * appending the new element may cause listObj's array of element + * pointers to grow. listPtr's old string representation, if any, is + * invalidated. * *---------------------------------------------------------------------- */ int @@ -649,23 +669,22 @@ Tcl_ListObjAppendElement( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { - register List *listRepPtr, *newPtr = NULL; + List *listRepPtr, *newPtr = NULL; int numElems, numRequired, needGrow, isShared, attempt; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement"); } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result; - size_t length; + int result, length; - (void) TclGetStringFromObj(listPtr, &length); + (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { Tcl_SetListObj(listPtr, 1, &objPtr); return TCL_OK; } result = SetListFromAny(interp, listPtr); @@ -695,22 +714,22 @@ * Need to grow + unshared intrep => try to realloc */ attempt = 2 * numRequired; if (attempt <= LIST_MAX) { - newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } - newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; - newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; listRepPtr->maxElemCount = attempt; needGrow = 0; @@ -764,11 +783,11 @@ /* * Old intrep to be freed, re-use refCounts. */ memcpy(dst, src, numElems * sizeof(Tcl_Obj *)); - Tcl_Free(listRepPtr); + ckfree(listRepPtr); } listRepPtr = newPtr; } ListResetIntRep(listPtr, listRepPtr); listRepPtr->refCount++; @@ -797,50 +816,45 @@ /* *---------------------------------------------------------------------- * * Tcl_ListObjIndex -- * - * Retrieve a pointer to the element of 'listPtr' at 'index'. The index - * of the first element is 0. - * - * Value - * - * TCL_OK - * - * A pointer to the element at 'index' is stored in 'objPtrPtr'. If - * 'index' is out of range, NULL is stored in 'objPtrPtr'. This - * object should be treated as readonly and its 'refCount' is _not_ - * incremented. The caller must do that if it holds on to the - * reference. - * - * TCL_ERROR - * - * 'listPtr' is not a valid list. An an error message is left in the - * interpreter's result if 'interp' is not NULL. - * - * Effect - * - * If 'listPtr' is not already of type 'tclListType', it is converted. + * This function returns a pointer to the index'th object from the list + * referenced by listPtr. The first element has index 0. If index is + * negative or greater than or equal to the number of elements in the + * list, a NULL is returned. If listPtr is not a list object, an attempt + * will be made to convert it to a list. + * + * Results: + * The return value is normally TCL_OK; in this case objPtrPtr is set to + * the Tcl_Obj pointer for the index'th list element or NULL if index is + * out of range. This object should be treated as readonly and its ref + * count is _not_ incremented; the caller must do that if it holds on to + * the reference. If listPtr does not refer to a list and can't be + * converted to one, TCL_ERROR is returned and an error message is left + * in the interpreter's result if interp is not NULL. + * + * Side effects: + * listPtr will be converted, if necessary, to a list object. * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object to index into. */ - register int index, /* Index of element to return. */ + Tcl_Obj *listPtr, /* List object to index into. */ + int index, /* Index of element to return. */ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { - register List *listRepPtr; + List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result; - size_t length; + int result, length; - (void) TclGetStringFromObj(listPtr, &length); + (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { *objPtrPtr = NULL; return TCL_OK; } result = SetListFromAny(interp, listPtr); @@ -862,42 +876,40 @@ /* *---------------------------------------------------------------------- * * Tcl_ListObjLength -- * - * Retrieve the number of elements in a list. - * - * Value - * - * TCL_OK - * - * A count of list elements is stored at the address provided by - * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is - * converted. - * - * TCL_ERROR - * - * 'listPtr' is not a valid list. An error message will be left in - * the interpreter's result if 'interp' is not NULL. + * This function returns the number of elements in a list object. If the + * object is not already a list object, an attempt will be made to + * convert it to one. + * + * Results: + * The return value is normally TCL_OK; in this case *intPtr will be set + * to the integer count of list elements. If listPtr does not refer to a + * list object and the object can not be converted to one, TCL_ERROR is + * returned and an error message will be left in the interpreter's result + * if interp is not NULL. + * + * Side effects: + * The possible conversion of the argument object to a list object. * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr, /* List object whose #elements to return. */ - register int *intPtr) /* The resulting int is stored here. */ + Tcl_Obj *listPtr, /* List object whose #elements to return. */ + int *intPtr) /* The resulting int is stored here. */ { - register List *listRepPtr; + List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result; - size_t length; + int result, length; - (void) TclGetStringFromObj(listPtr, &length); + (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { *intPtr = 0; return TCL_OK; } result = SetListFromAny(interp, listPtr); @@ -914,40 +926,39 @@ /* *---------------------------------------------------------------------- * * Tcl_ListObjReplace -- * - * Replace values in a list. - * - * If 'first' is zero or negative, it refers to the first element. If - * 'first' outside the range of elements in the list, no elements are - * deleted. - * - * If 'count' is zero or negative no elements are deleted, and any new - * elements are inserted at the beginning of the list. - * - * Value - * - * TCL_OK - * - * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr' - * starting at 'first'. If 'objc' 0, no new elements are added. - * - * TCL_ERROR - * - * 'listPtr' is not a valid list. An error message is left in the - * interpreter's result if 'interp' is not NULL. - * - * Effect - * - * If 'listPtr' is not of type 'tclListType', it is converted if possible. - * - * The 'refCount' of each element appended to the list is incremented. - * Similarly, the 'refCount' for each replaced element is decremented. - * - * If 'listPtr' is modified, any previous string representation is - * invalidated. + * This function replaces zero or more elements of the list referenced by + * listPtr with the objects from an (objc,objv) array. The objc elements + * of the array referenced by objv replace the count elements in listPtr + * starting at first. + * + * If the argument first is zero or negative, it refers to the first + * element. If first is greater than or equal to the number of elements + * in the list, then no elements are deleted; the new elements are + * appended to the list. Count gives the number of elements to replace. + * If count is zero or negative then no elements are deleted; the new + * elements are simply inserted before first. + * + * The argument objv refers to an array of objc pointers to the new + * elements to be added to listPtr in place of those that were deleted. + * If objv is NULL, no new elements are added. If listPtr is not a list + * object, an attempt will be made to convert it to one. + * + * Results: + * The return value is normally TCL_OK. If listPtr does not refer to a + * list object and can not be converted to one, TCL_ERROR is returned and + * an error message will be left in the interpreter's result if interp is + * not NULL. + * + * Side effects: + * The ref counts of the objc elements in objv are incremented since the + * resulting list now refers to them. Similarly, the ref counts for + * replaced objects are decremented. listPtr is converted, if necessary, + * to a list object. listPtr's old string representation, if any, is + * freed. * *---------------------------------------------------------------------- */ int @@ -959,22 +970,22 @@ int objc, /* Number of objects to insert. */ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; - register Tcl_Obj **elemPtrs; + Tcl_Obj **elemPtrs; int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - size_t length; + int length; - (void) TclGetStringFromObj(listPtr, &length); + (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { if (objc == 0) { return TCL_OK; } Tcl_SetListObj(listPtr, objc, NULL); @@ -1032,22 +1043,22 @@ if (needGrow && !isShared) { /* Try to use realloc */ List *newPtr = NULL; int attempt = 2 * numRequired; if (attempt <= LIST_MAX) { - newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } - newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; - newPtr = Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; ListResetIntRep(listPtr, listRepPtr); elemPtrs = &listRepPtr->elements; @@ -1078,11 +1089,11 @@ numAfterLast = numElems - start; shift = objc - count; /* numNewElems - numDeleted */ if ((numAfterLast > 0) && (shift != 0)) { Tcl_Obj **src = elemPtrs + start; - memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*)); + memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*)); } } else { /* * Cannot use the current List struct; it is shared, too small, or * both. Allocate a new struct and insert elements into it. @@ -1109,11 +1120,15 @@ if (listRepPtr == NULL) { listRepPtr = AttemptNewList(interp, numRequired, NULL); if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { /* See bug 3598580 */ +#if TCL_MAJOR_VERSION > 8 Tcl_DecrRefCount(objv[i]); +#else + objv[i]->refCount--; +#endif } return TCL_ERROR; } } } @@ -1170,11 +1185,11 @@ if (numAfterLast > 0) { memcpy(elemPtrs + first + objc, oldPtrs + start, (size_t) numAfterLast * sizeof(Tcl_Obj *)); } - Tcl_Free(oldListRepPtr); + ckfree(oldListRepPtr); } } /* * Insert the new elements into elemPtrs before "first". @@ -1207,23 +1222,26 @@ /* *---------------------------------------------------------------------- * * TclLindexList -- * - * Implements the 'lindex' command when objc==3. - * - * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures - * the argument format into required form while taking care to manage - * shimmering so as to tend to keep the most useful intreps - * and/or avoid the most expensive conversions. - * - * Value - * - * A pointer to the specified element, with its 'refCount' incremented, or - * NULL if an error occurred. - * - * Notes + * This procedure handles the 'lindex' command when objc==3. + * + * Results: + * Returns a pointer to the object extracted, or NULL if an error + * occurred. The returned object already includes one reference count for + * the pointer returned. + * + * Side effects: + * None. + * + * Notes: + * This procedure is implemented entirely as a wrapper around + * TclLindexFlat. All it does is reconfigure the argument format into the + * form required by TclLindexFlat, while taking care to manage shimmering + * in such a way that we tend to keep the most useful intreps and/or + * avoid the most expensive conversions. * *---------------------------------------------------------------------- */ Tcl_Obj * @@ -1231,11 +1249,11 @@ Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* List being unpacked. */ Tcl_Obj *argPtr) /* Index or index list. */ { - size_t index; /* Index into the list. */ + int index; /* Index into the list. */ Tcl_Obj *indexListCopy; List *listRepPtr; /* * Determine whether argPtr designates a list or a single index. We have @@ -1243,11 +1261,11 @@ * shimmering; see TIP#22 and TIP#33 for the details. */ ListGetIntRep(argPtr, listRepPtr); if ((listRepPtr == NULL) - && TclGetIntForIndexM(NULL , argPtr, TCL_INDEX_START, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, &index) == TCL_OK) { /* * argPtr designates a single index. */ return TclLindexFlat(interp, listPtr, 1, &argPtr); @@ -1286,24 +1304,29 @@ } /* *---------------------------------------------------------------------- * - * TclLindexFlat -- - * - * The core of the 'lindex' command, with all index - * arguments presented as a flat list. - * - * Value - * - * A pointer to the object extracted, with its 'refCount' incremented, or - * NULL if an error occurred. Thus, the calling code will usually do - * something like: - * - * Tcl_SetObjResult(interp, result); - * Tcl_DecrRefCount(result); - * + * TclLindexFlat -- + * + * This procedure is the core of the 'lindex' command, with all index + * arguments presented as a flat list. + * + * Results: + * Returns a pointer to the object extracted, or NULL if an error + * occurred. The returned object already includes one reference count for + * the pointer returned. + * + * Side effects: + * None. + * + * Notes: + * The reference count of the returned object includes one reference + * corresponding to the pointer returned. Thus, the calling code will + * usually do something like: + * Tcl_SetObjResult(interp, result); + * Tcl_DecrRefCount(result); * *---------------------------------------------------------------------- */ Tcl_Obj * @@ -1317,12 +1340,11 @@ int i; Tcl_IncrRefCount(listPtr); for (i=0 ; i= (size_t)listLen) { + if (index<0 || index>=listLen) { /* * Index is out of range. Break out of loop with empty result. * First check remaining indices for validity */ while (++i < indexCount) { - if (TclGetIntForIndexM(interp, indexArray[i], TCL_INDEX_NONE, &index) + if (TclGetIntForIndexM(interp, indexArray[i], INT_MAX - 1, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; } } @@ -1376,21 +1398,28 @@ /* *---------------------------------------------------------------------- * * TclLsetList -- * - * The core of [lset] when objc == 4. Objv[2] may be either a + * Core of the 'lset' command when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * It also handles 'lpop' when given a NULL value. * - * Implemented entirely as a wrapper around 'TclLindexFlat', as described - * for 'TclLindexList'. + * Results: + * Returns the new value of the list variable, or NULL if there was an + * error. The returned object includes one reference count for the + * pointer returned. * - * Value + * Side effects: + * None. * - * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if - * there was an error. + * Notes: + * This procedure is implemented entirely as a wrapper around + * TclLsetFlat. All it does is reconfigure the argument format into the + * form required by TclLsetFlat, while taking care to manage shimmering + * in such a way that we tend to keep the most useful intreps and/or + * avoid the most expensive conversions. * *---------------------------------------------------------------------- */ Tcl_Obj * @@ -1401,11 +1430,11 @@ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */ { int indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ - size_t index; /* Current index in the list - discarded. */ + int index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; List *listRepPtr; /* * Determine whether the index arg designates a list or a single index. @@ -1413,11 +1442,11 @@ * shimmering; see TIP #22 and #23 for details. */ ListGetIntRep(indexArgPtr, listRepPtr); if (listRepPtr == NULL - && TclGetIntForIndexM(NULL, indexArgPtr, TCL_INDEX_START, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) { /* * indexArgPtr designates a single index. */ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); @@ -1451,43 +1480,40 @@ * TclLsetFlat -- * * Core engine of the 'lset' command. * It also handles 'lpop' when given a NULL value. * - * Value - * - * The resulting list - * - * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not - * duplicated, its 'refCount' is incremented. The reference count of - * an unduplicated object is therefore 2 (one for the returned pointer - * and one for the variable that holds it). The reference count of a - * duplicate object is 1, reflecting that result is the only active - * reference. The caller is expected to store the result in the - * variable and decrement its reference count. (INST_STORE_* does - * exactly this.) - * - * NULL - * - * An error occurred. If 'listPtr' was duplicated, the reference - * count on the duplicate is decremented so that it is 0, causing any - * memory allocated by this function to be freed. - * - * - * Effect - * - * On entry, the reference count of 'listPtr' does not reflect any - * references held on the stack. The first action of this function is to - * determine whether 'listPtr' is shared and to create a duplicate - * unshared copy if it is. The reference count of the duplicate is - * incremented. At this point, the reference count is 1 in either case so - * that the object is considered unshared. - * - * The unshared list is altered directly to produce the result. - * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string + * Results: + * Returns the new value of the list variable, or NULL if an error + * occurred. The returned object includes one reference count for the + * pointer returned. + * + * Side effects: + * On entry, the reference count of the variable value does not reflect + * any references held on the stack. The first action of this function is + * to determine whether the object is shared, and to duplicate it if it + * is. The reference count of the duplicate is incremented. At this + * point, the reference count will be 1 for either case, so that the + * object will appear to be unshared. + * + * If an error occurs, and the object has been duplicated, the reference + * count on the duplicate is decremented so that it is now 0: this + * dismisses any memory that was allocated by this function. + * + * If no error occurs, the reference count of the original object is + * incremented if the object has not been duplicated, and nothing is done + * to a reference count of the duplicate. Now the reference count of an + * unduplicated object is 2 (the returned pointer, plus the one stored in + * the variable). The reference count of a duplicate object is 1, + * reflecting that the returned pointer is the only active reference. The + * caller is expected to store the returned value back in the variable + * and decrement its reference count. (INST_STORE_* does exactly this.) + * + * Surgery is performed on the unshared list value to produce the result. + * TclLsetFlat maintains a linked list of Tcl_Obj's whose string * representations must be spoilt by threading via 'ptr2' of the - * two-pointer internal representation. On entry to 'TclLsetFlat', the + * two-pointer internal representation. On entry to TclLsetFlat, the * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any * Tcl_Obj that has been modified is set to NULL. * *---------------------------------------------------------------------- */ @@ -1499,12 +1525,11 @@ int indexCount, /* Number of index args. */ Tcl_Obj *const indexArray[], /* Index args. */ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */ { - size_t index; - int result, len; + int index, result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; Tcl_ObjIntRep *irPtr; /* * If there are no indices, simply return the new value. (Without @@ -1573,19 +1598,18 @@ indexArray++; break; } indexArray++; - if (index > (size_t)elemCount - || (valuePtr == NULL && index >= (size_t)elemCount)) { + if (index < 0 || index > elemCount + || (valuePtr == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("list index out of range", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", - valuePtr == NULL ? "LPOP" : "LSET", - "BADINDEX", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" out of range", Tcl_GetString(indexArray[-1]))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" + "OUTOFRANGE", NULL); } result = TCL_ERROR; break; } @@ -1596,11 +1620,11 @@ * modify it. */ if (--indexCount) { parentList = subListPtr; - if (index == (size_t)elemCount) { + if (index == elemCount) { subListPtr = Tcl_NewObj(); } else { subListPtr = elemPtrs[index]; } if (Tcl_IsShared(subListPtr)) { @@ -1614,11 +1638,11 @@ * Tcl_Obj's. Dealing with the shared intrep case can cause * subListPtr to become shared again, so detect that case and make * and store another copy. */ - if (index == (size_t)elemCount) { + if (index == elemCount) { Tcl_ListObjAppendElement(NULL, parentList, subListPtr); } else { TclListObjSetElement(NULL, parentList, index, subListPtr); } if (Tcl_IsShared(subListPtr)) { @@ -1660,12 +1684,12 @@ /* * Clear away our intrep surgery mess. */ irPtr = TclFetchIntRep(objPtr, &tclListType); - listRepPtr = irPtr->twoPtrValue.ptr1; - chainPtr = irPtr->twoPtrValue.ptr2; + listRepPtr = (List *)irPtr->twoPtrValue.ptr1; + chainPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2; if (result == TCL_OK) { /* * We're going to store valuePtr, so spoil string reps of all @@ -1703,11 +1727,11 @@ len = -1; TclListObjLength(NULL, subListPtr, &len); if (valuePtr == NULL) { Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL); - } else if (index == (size_t)len) { + } else if (index == len) { Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); TclInvalidateStringRep(subListPtr); } @@ -1718,42 +1742,30 @@ /* *---------------------------------------------------------------------- * * TclListObjSetElement -- * - * Set a single element of a list to a specified value. + * Set a single element of a list to a specified value + * + * Results: + * The return value is normally TCL_OK. If listPtr does not refer to a + * list object and cannot be converted to one, TCL_ERROR is returned and + * an error message will be left in the interpreter result if interp is + * not NULL. Similarly, if index designates an element outside the range + * [0..listLength-1], where listLength is the count of elements in the + * list object designated by listPtr, TCL_ERROR is returned and an error + * message is left in the interpreter result. + * + * Side effects: + * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts + * to convert it to a list with a non-shared internal rep. Decrements the + * ref count of the object at the specified index within the list, + * replaces with the object designated by valuePtr, and increments the + * ref count of the replacement object. * * It is the caller's responsibility to invalidate the string - * representation of the 'listPtr'. - * - * Value - * - * TCL_OK - * - * Success. - * - * TCL_ERROR - * - * 'listPtr' does not refer to a list object and cannot be converted - * to one. An error message will be left in the interpreter result if - * interp is not NULL. - * - * TCL_ERROR - * - * An index designates an element outside the range [0..listLength-1], - * where 'listLength' is the count of elements in the list object - * designated by 'listPtr'. An error message is left in the - * interpreter result. - * - * Effect - * - * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If - * 'listPtr' is not already of type 'tclListType', it is converted and the - * internal representation is unshared. The 'refCount' of the element at - * 'index' is decremented and replaced in the list with the 'valuePtr', - * whose 'refCount' in turn is incremented. - * + * representation of the object. * *---------------------------------------------------------------------- */ int @@ -1779,20 +1791,19 @@ Tcl_Panic("%s called with shared object", "TclListObjSetElement"); } ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result; - size_t length; + int result, length; - (void) TclGetStringFromObj(listPtr, &length); + (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("list index out of range", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", - "BADINDEX", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%d\" out of range", index)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", + "OUTOFRANGE", NULL); } return TCL_ERROR; } result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { @@ -1807,14 +1818,14 @@ * Ensure that the index is in bounds. */ if (index<0 || index>=elemCount) { if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("list index out of range", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%d\" out of range", index)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", + "OUTOFRANGE", NULL); } return TCL_ERROR; } /* @@ -1884,15 +1895,17 @@ /* *---------------------------------------------------------------------- * * FreeListInternalRep -- * - * Deallocate the storage associated with the internal representation of a - * a list object. + * Deallocate the storage associated with a list object's internal + * representation. + * + * Results: + * None. * - * Effect - * + * Side effects: * Frees listPtr's List* internal representation, if no longer shared. * May decrement the ref counts of element objects, which may free them. * *---------------------------------------------------------------------- */ @@ -1911,25 +1924,27 @@ int i, numElems = listRepPtr->elemCount; for (i = 0; i < numElems; i++) { Tcl_DecrRefCount(elemPtrs[i]); } - Tcl_Free(listRepPtr); + ckfree(listRepPtr); } } /* *---------------------------------------------------------------------- * * DupListInternalRep -- * - * Initialize the internal representation of a list 'Tcl_Obj' to share the + * Initialize the internal representation of a list Tcl_Obj to share the * internal representation of an existing list object. * - * Effect + * Results: + * None. * - * The 'refCount' of the List internal rep is incremented. + * Side effects: + * The reference count of the List internal rep is incremented. * *---------------------------------------------------------------------- */ static void @@ -1947,24 +1962,20 @@ /* *---------------------------------------------------------------------- * * SetListFromAny -- * - * Convert any object to a list. - * - * Value - * - * TCL_OK - * - * Success. The internal representation of 'objPtr' is set, and the type - * of 'objPtr' is 'tclListType'. - * - * TCL_ERROR - * - * An error occured during conversion. An error message is left in the - * interpreter's result if 'interp' is not NULL. - * + * Attempt to generate a list internal form for the Tcl object "objPtr". + * + * Results: + * The return value is TCL_OK or TCL_ERROR. If an error occurs during + * conversion, an error message is left in the interpreter's result + * unless "interp" is NULL. + * + * Side effects: + * If no error occurs, a list is stored as "objPtr"s internal + * representation. * *---------------------------------------------------------------------- */ static int @@ -2016,12 +2027,11 @@ Tcl_IncrRefCount(keyPtr); Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } } else { - int estCount; - size_t length; + int estCount, length; const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length); /* * Allocate enough space to hold a (Tcl_Obj *) for each * (possible) list element. @@ -2041,20 +2051,19 @@ */ while (nextElem < limit) { const char *elemStart; char *check; - size_t elemSize; - int literal; + int elemSize, literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { fail: while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); } - Tcl_Free(listRepPtr); + ckfree(listRepPtr); return TCL_ERROR; } if (elemStart == limit) { break; } @@ -2095,20 +2104,22 @@ /* *---------------------------------------------------------------------- * * UpdateStringOfList -- * - * Update the string representation for a list object. - * - * Any previously-exising string representation is not invalidated, so - * storage is lost if this has not been taken care of. - * - * Effect - * - * The string representation of 'listPtr' is set to the resulting string. - * This string will be empty if the list has no elements. It is assumed - * that the list internal representation is not NULL. + * Update the string representation for a list object. Note: This + * function does not invalidate an existing old string rep so storage + * will be lost if this has not already been done. + * + * Results: + * None. + * + * Side effects: + * The object's string is set to a valid string that results from the + * list-to-string conversion. This string will be empty if the list has + * no elements. The list internal representation should not be NULL and + * we assume it is not NULL. * *---------------------------------------------------------------------- */ static void @@ -2115,12 +2126,11 @@ UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { # define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int numElems, i; - size_t length, bytesNeeded = 0; + int numElems, i, length, bytesNeeded = 0; const char *elem, *start; char *dst; Tcl_Obj **elemPtrs; List *listRepPtr; @@ -2156,17 +2166,23 @@ } else { /* * We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = Tcl_Alloc(numElems); + flagPtr = (char *)ckalloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); + if (bytesNeeded < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + } + if (bytesNeeded > INT_MAX - numElems + 1) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems - 1; /* * Pass 2: copy into string rep buffer. @@ -2183,11 +2199,11 @@ /* Set the string length to what was actually written, the safe choice */ (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start); if (flagPtr != localFlags) { - Tcl_Free(flagPtr); + ckfree(flagPtr); } } /* * Local Variables: Index: generic/tclLiteral.c ================================================================== --- generic/tclLiteral.c +++ generic/tclLiteral.c @@ -29,11 +29,11 @@ */ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static size_t HashString(const char *string, size_t length); +static unsigned HashString(const char *string, int length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif static void RebuildLiteralTable(LiteralTable *tablePtr); @@ -56,11 +56,11 @@ *---------------------------------------------------------------------- */ void TclInitLiteralTable( - register LiteralTable *tablePtr) + LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable", @@ -112,10 +112,12 @@ * search from the bucket chain we last found an entry. */ #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable((Interp *) interp); +#else + (void)interp; #endif /*TCL_COMPILE_DEBUG*/ /* * We used to call TclReleaseLiteral for each literal in the table, which * is rather inefficient as it causes one lookup-by-hash for each @@ -129,21 +131,21 @@ entryPtr = tablePtr->buckets[i]; while (entryPtr != NULL) { objPtr = entryPtr->objPtr; TclDecrRefCount(objPtr); nextPtr = entryPtr->nextPtr; - Tcl_Free(entryPtr); + ckfree(entryPtr); entryPtr = nextPtr; } } /* * Free up the table's bucket array if it was dynamically allocated. */ if (tablePtr->buckets != tablePtr->staticBuckets) { - Tcl_Free(tablePtr->buckets); + ckfree(tablePtr->buckets); } } /* *---------------------------------------------------------------------- @@ -174,28 +176,28 @@ Tcl_Obj * TclCreateLiteral( Interp *iPtr, const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - size_t length, /* Number of bytes in the string. */ - size_t hash, /* The string's hash. If -1, it will be + int length, /* Number of bytes in the string. */ + unsigned hash, /* The string's hash. If -1, it will be * computed here. */ int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr) { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; - size_t globalHash; + unsigned int globalHash; Tcl_Obj *objPtr; /* * Is it in the interpreter's global literal table? */ - if (hash == TCL_AUTO_LENGTH) { + if (hash == (unsigned) -1) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL; globalPtr = globalPtr->nextPtr) { @@ -206,12 +208,12 @@ * is not guaranteed so we need to be careful anyway. * * https://stackoverflow.com/q/54337750/301832 */ - size_t objLength; - char *objBytes = TclGetStringFromObj(objPtr, &objLength); + int objLength; + const char *objBytes = TclGetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) || ((objBytes[0] == bytes[0]) && (memcmp(objBytes, bytes, length) == 0)))) { /* @@ -223,22 +225,22 @@ } if (globalPtrPtr) { *globalPtrPtr = globalPtr; } if (flags & LITERAL_ON_HEAP) { - Tcl_Free((void *)bytes); + ckfree(bytes); } - if (globalPtr->refCount != TCL_AUTO_LENGTH) { + if (globalPtr->refCount != (unsigned) -1) { globalPtr->refCount++; } return objPtr; } } } if (!newPtr) { if ((flags & LITERAL_ON_HEAP)) { - Tcl_Free((void *)bytes); + ckfree(bytes); } return NULL; } /* @@ -270,15 +272,15 @@ * Yes, add it to the global literal table. */ #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", - "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); + "TclRegisterLiteral", (length>60? 60 : length), bytes); } #endif - globalPtr = Tcl_Alloc(sizeof(LiteralEntry)); + globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); globalPtr->refCount = 1; globalPtr->nsPtr = nsPtr; globalPtr->nextPtr = globalTablePtr->buckets[globalHash]; @@ -310,11 +312,11 @@ } } } if (!found) { Tcl_Panic("%s: literal \"%.*s\" wasn't global", - "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); + "TclRegisterLiteral", (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ #ifdef TCL_COMPILE_STATS @@ -347,14 +349,14 @@ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ - size_t index) /* Index of the desired literal, as returned + unsigned int index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { - if (index >= (size_t) envPtr->literalArrayNext) { + if (index >= (unsigned int) envPtr->literalArrayNext) { return NULL; } return envPtr->literalArrayPtr[index].objPtr; } @@ -387,32 +389,33 @@ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ - register const char *bytes, /* Points to string for which to find or + const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - size_t length, /* Number of bytes in the string. If -1, the + int length, /* Number of bytes in the string. If < 0, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to * this function. If LITERAL_CMD_NAME then * the literal should not be shared accross * namespaces. */ { - CompileEnv *envPtr = ePtr; + CompileEnv *envPtr = (CompileEnv *)ePtr; Interp *iPtr = envPtr->iPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; - size_t hash, localHash, objIndex; - int new; + unsigned hash; + unsigned int localHash; + int objIndex, isNew; Namespace *nsPtr; - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); /* @@ -426,11 +429,11 @@ objPtr = localPtr->objPtr; if ((objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) && (memcmp(objPtr->bytes, bytes, length) == 0)))) { if ((flags & LITERAL_ON_HEAP)) { - Tcl_Free((void *)bytes); + ckfree(bytes); } objIndex = (localPtr - envPtr->literalArrayPtr); #ifdef TCL_COMPILE_DEBUG TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ @@ -459,18 +462,18 @@ /* * Is it in the interpreter's global literal table? If not, create it. */ globalPtr = NULL; - objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags, + objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &isNew, nsPtr, flags, &globalPtr); objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && (globalPtr->refCount + 1 < 2)) { - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", - "TclRegisterLiteral", (length>60? 60 : (int)length), bytes, + if (globalPtr != NULL && globalPtr->refCount + 1 < 2) { + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ return objIndex; @@ -496,19 +499,19 @@ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal + Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; - register LiteralEntry *entryPtr; + LiteralEntry *entryPtr; const char *bytes; - size_t globalHash, length; + int length, globalHash; bytes = TclGetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { @@ -542,18 +545,19 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register CompileEnv *envPtr,/* Points to CompileEnv whose literal array + CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - size_t localHash, length; + unsigned int localHash; + int length; const char *bytes; Tcl_Obj *newObjPtr; lPtr = &envPtr->literalArrayPtr[index]; @@ -605,18 +609,18 @@ *---------------------------------------------------------------------- */ int TclAddLiteralObj( - register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { - register LiteralEntry *lPtr; + LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { ExpandLocalLiteralArray(envPtr); } @@ -624,11 +628,11 @@ envPtr->literalArrayNext++; lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = TCL_AUTO_LENGTH; /* i.e., unused */ + lPtr->refCount = (unsigned) -1; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { *litPtrPtr = lPtr; } @@ -654,16 +658,16 @@ *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( - register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { - register LiteralTable *localTablePtr = &envPtr->localLitTable; + LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; int objIndex; objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); @@ -686,12 +690,12 @@ #ifdef TCL_COMPILE_DEBUG TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int found; - size_t length, i; + int length, found; + size_t i; found = 0; for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ; localPtr=localPtr->nextPtr) { @@ -702,11 +706,11 @@ } if (!found) { bytes = TclGetStringFromObj(objPtr, &length); Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", - "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes); + "AddLocalLiteralEntry", (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ return objIndex; @@ -732,11 +736,11 @@ *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( - register CompileEnv *envPtr)/* Points to the CompileEnv whose object array + CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. @@ -754,18 +758,18 @@ Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded", currElems); } if (envPtr->mallocedLiteralArray) { - newArrayPtr = Tcl_Realloc(currArrayPtr, newSize); + newArrayPtr = (LiteralEntry *)ckrealloc(currArrayPtr, newSize); } else { /* - * envPtr->literalArrayPtr isn't a Tcl_Alloc'd pointer, so we must - * code a Tcl_Realloc equivalent for ourselves. + * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must + * code a ckrealloc equivalent for ourselves. */ - newArrayPtr = Tcl_Alloc(newSize); + newArrayPtr = (LiteralEntry *)ckalloc(newSize); memcpy(newArrayPtr, currArrayPtr, currBytes); envPtr->mallocedLiteralArray = 1; } /* @@ -814,27 +818,28 @@ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - register Tcl_Obj *objPtr) /* Points to a literal object that was + Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; - register LiteralEntry *entryPtr, *prevPtr; + LiteralEntry *entryPtr, *prevPtr; const char *bytes; - size_t length, index; + int length; + unsigned int index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; bytes = TclGetStringFromObj(objPtr, &length); - index = HashString(bytes, length) & globalTablePtr->mask; + index = (HashString(bytes, length) & globalTablePtr->mask); /* * Check to see if the object is in the global literal table and remove * this reference. The object may not be in the table if it is a hidden * local literal. @@ -847,17 +852,17 @@ * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ - if ((entryPtr->refCount != TCL_AUTO_LENGTH) && (entryPtr->refCount-- <= 1)) { + if ((entryPtr->refCount != (unsigned)-1) && (entryPtr->refCount-- <= 1)) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { prevPtr->nextPtr = entryPtr->nextPtr; } - Tcl_Free(entryPtr); + ckfree(entryPtr); globalTablePtr->numEntries--; TclDecrRefCount(objPtr); #ifdef TCL_COMPILE_STATS @@ -891,16 +896,16 @@ * None. * *---------------------------------------------------------------------- */ -static size_t +static unsigned HashString( - register const char *string, /* String for which to compute hash value. */ - size_t length) /* Number of bytes in the string. */ + const char *string, /* String for which to compute hash value. */ + int length) /* Number of bytes in the string. */ { - register size_t result = 0; + unsigned int result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose @@ -957,19 +962,20 @@ *---------------------------------------------------------------------- */ static void RebuildLiteralTable( - register LiteralTable *tablePtr) + LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; - register LiteralEntry **oldChainPtr, **newChainPtr; - register LiteralEntry *entryPtr; + LiteralEntry **oldChainPtr, **newChainPtr; + LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - size_t oldSize, count, index, length; + unsigned int oldSize, index; + int count, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; /* @@ -986,11 +992,12 @@ return; } tablePtr->numBuckets *= 4; - tablePtr->buckets = Tcl_Alloc(tablePtr->numBuckets * sizeof(LiteralEntry*)); + tablePtr->buckets = (LiteralEntry **)ckalloc( + tablePtr->numBuckets * sizeof(LiteralEntry*)); for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets; count>0 ; count--, newChainPtr++) { *newChainPtr = NULL; } tablePtr->rebuildSize *= 4; @@ -1015,11 +1022,11 @@ /* * Free up the old bucket array, if it was dynamically allocated. */ if (oldBuckets != tablePtr->staticBuckets) { - Tcl_Free(oldBuckets); + ckfree(oldBuckets); } } /* *---------------------------------------------------------------------- @@ -1088,13 +1095,15 @@ char * TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - size_t count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS]; + int overflow; + size_t i, j; double average, tmp; - register LiteralEntry *entryPtr; + LiteralEntry *entryPtr; char *result, *p; /* * Compute a histogram of bucket usage. For each bucket chain i, j is the * number of entries in the chain. @@ -1122,20 +1131,20 @@ /* * Print out the histogram and a few other pieces of information. */ - result = Tcl_Alloc(NUM_COUNTERS*60 + 300); - sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", + result = (char *)ckalloc(NUM_COUNTERS*60 + 300); + sprintf(result, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; ilocalLitTable; - register LiteralEntry *localPtr; + LiteralTable *localTablePtr = &envPtr->localLitTable; + LiteralEntry *localPtr; char *bytes; - size_t i, length, count = 0; + size_t i, count; + int length; + count = 0; for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; - if (localPtr->refCount != TCL_AUTO_LENGTH) { + if (localPtr->refCount != (unsigned)-1) { bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u", "TclVerifyLocalLiteralTable", - (length>60? 60 : (int) length), bytes, localPtr->refCount); + (length>60? 60 : length), bytes, localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyLocalLiteralTable"); } } } if (count != localTablePtr->numEntries) { - Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u", + Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %u", "TclVerifyLocalLiteralTable", count, localTablePtr->numEntries); } } @@ -1210,33 +1221,35 @@ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { - register LiteralTable *globalTablePtr = &iPtr->literalTable; - register LiteralEntry *globalPtr; + LiteralTable *globalTablePtr = &iPtr->literalTable; + LiteralEntry *globalPtr; char *bytes; - size_t i, length, count = 0; + size_t i, count; + int length; + count = 0; for (i=0 ; inumBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount + 1 < 2) { bytes = TclGetStringFromObj(globalPtr->objPtr, &length); - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclVerifyGlobalLiteralTable", - (length>60? 60 : (int)length), bytes, globalPtr->refCount); + (length>60? 60 : length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyGlobalLiteralTable"); } } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u", + Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %u", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } } #endif /*TCL_COMPILE_DEBUG*/ Index: generic/tclLoad.c ================================================================== --- generic/tclLoad.c +++ generic/tclLoad.c @@ -113,11 +113,11 @@ *---------------------------------------------------------------------- */ int Tcl_LoadObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; @@ -129,11 +129,11 @@ const char *symbols[2]; Tcl_PackageInitProc *initProc; const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; Tcl_UniChar ch = 0; - size_t len; + unsigned len; int index, flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { "-global", "-lazy", "--", NULL }; @@ -163,11 +163,11 @@ return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } - fullFileName = TclGetString(objv[1]); + fullFileName = Tcl_GetString(objv[1]); Tcl_DStringInit(&pkgName); Tcl_DStringInit(&initName); Tcl_DStringInit(&safeInitName); Tcl_DStringInit(&unloadName); @@ -174,11 +174,11 @@ Tcl_DStringInit(&safeUnloadName); Tcl_DStringInit(&tmp); packageName = NULL; if (objc >= 3) { - packageName = TclGetString(objv[2]); + packageName = Tcl_GetString(objv[2]); if (packageName[0] == '\0') { packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { @@ -194,11 +194,11 @@ * Figure out which interpreter we're going to load the package into. */ target = interp; if (objc == 4) { - const char *slaveIntName = TclGetString(objv[3]); + const char *slaveIntName = Tcl_GetString(objv[3]); target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { code = TCL_ERROR; goto done; @@ -269,11 +269,11 @@ * interpreter. If the package we want is already loaded there, then * there's nothing for us to do. */ if (pkgPtr != NULL) { - ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); + ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { code = TCL_OK; goto done; } @@ -322,11 +322,11 @@ * that. */ splitPtr = Tcl_FSSplitPath(objv[1], &pElements); Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); - pkgGuess = TclGetString(pkgGuessPtr); + pkgGuess = Tcl_GetString(pkgGuessPtr); if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') && (pkgGuess[2] == 'b')) { pkgGuess += 3; } #ifdef __CYGWIN__ @@ -399,16 +399,16 @@ /* * Create a new record to describe this package. */ - pkgPtr = Tcl_Alloc(sizeof(LoadedPackage)); + pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage)); len = strlen(fullFileName) + 1; - pkgPtr->fileName = Tcl_Alloc(len); + pkgPtr->fileName = (char *)ckalloc(len); memcpy(pkgPtr->fileName, fullFileName, len); len = Tcl_DStringLength(&pkgName) + 1; - pkgPtr->packageName = Tcl_Alloc(len); + pkgPtr->packageName = (char *)ckalloc(len); memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len); pkgPtr->loadHandle = loadHandle; pkgPtr->initProc = initProc; pkgPtr->safeInitProc = (Tcl_PackageInitProc *) Tcl_FindSymbol(interp, loadHandle, @@ -468,21 +468,23 @@ * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ if (code != TCL_OK) { +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 Interp *iPtr = (Interp *) target; - if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) { + if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) { /* * A call to Tcl_InitStubs() determined the caller extension and * this interp are incompatible in their stubs mechanisms, and * recorded the error in the oldest legacy place we have to do so. */ - Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); - iPtr->legacyResult = NULL; - iPtr->legacyFreeProc = (void (*) (void))-1; + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1)); + iPtr->result = &tclEmptyString; + iPtr->freeProc = NULL; } +#endif /* defined(TCL_NO_DEPRECATED) */ Tcl_TransferResult(target, code, interp); goto done; } /* @@ -503,12 +505,12 @@ /* * Refetch ipFirstPtr: loading the package may have introduced additional * static packages at the head of the linked list! */ - ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); - ipPtr = Tcl_Alloc(sizeof(InterpPackage)); + ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL); + ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); done: @@ -538,11 +540,11 @@ *---------------------------------------------------------------------- */ int Tcl_UnloadObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *target; /* Which interpreter to unload from. */ @@ -562,11 +564,11 @@ }; for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { - fullFileName = TclGetString(objv[i]); + fullFileName = Tcl_GetString(objv[i]); if (fullFileName[0] == '-') { /* * It looks like the command contains an option so signal an * error */ @@ -602,17 +604,17 @@ } if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { return TCL_ERROR; } - fullFileName = TclGetString(objv[i]); + fullFileName = Tcl_GetString(objv[i]); Tcl_DStringInit(&pkgName); Tcl_DStringInit(&tmp); packageName = NULL; if (objc - i >= 2) { - packageName = TclGetString(objv[i+1]); + packageName = Tcl_GetString(objv[i+1]); if (packageName[0] == '\0') { packageName = NULL; } } if ((fullFileName[0] == 0) && (packageName == NULL)) { @@ -628,11 +630,11 @@ * Figure out which interpreter we're going to load the package into. */ target = interp; if (objc - i == 3) { - const char *slaveIntName = TclGetString(objv[i + 2]); + const char *slaveIntName = Tcl_GetString(objv[i + 2]); target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { return TCL_ERROR; } @@ -716,11 +718,11 @@ * should proceed with unloading. */ code = TCL_ERROR; if (pkgPtr != NULL) { - ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); + ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { code = TCL_OK; break; } @@ -871,31 +873,31 @@ /* * Remove this library from the interpreter's library cache. */ - ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL); + ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL); ipPtr = ipFirstPtr; if (ipPtr->pkgPtr == defaultPtr) { ipFirstPtr = ipFirstPtr->nextPtr; } else { InterpPackage *ipPrevPtr; for (ipPrevPtr = ipPtr; ipPtr != NULL; ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) { - if (ipPtr->pkgPtr == pkgPtr) { + if (ipPtr->pkgPtr == defaultPtr) { ipPrevPtr->nextPtr = ipPtr->nextPtr; break; } } } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - Tcl_Free(defaultPtr->fileName); - Tcl_Free(defaultPtr->packageName); - Tcl_Free(defaultPtr); - Tcl_Free(ipPtr); + ckfree(defaultPtr->fileName); + ckfree(defaultPtr->packageName); + ckfree(defaultPtr); + ckfree(ipPtr); Tcl_MutexUnlock(&packageMutex); } else { code = TCL_ERROR; } } @@ -978,14 +980,14 @@ * If the package is not yet recorded as being loaded statically, add it * to the list now. */ if (pkgPtr == NULL) { - pkgPtr = Tcl_Alloc(sizeof(LoadedPackage)); - pkgPtr->fileName = Tcl_Alloc(1); + pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage)); + pkgPtr->fileName = (char *)ckalloc(1); pkgPtr->fileName[0] = 0; - pkgPtr->packageName = Tcl_Alloc(strlen(pkgName) + 1); + pkgPtr->packageName = (char *)ckalloc(strlen(pkgName) + 1); strcpy(pkgPtr->packageName, pkgName); pkgPtr->loadHandle = NULL; pkgPtr->initProc = initProc; pkgPtr->safeInitProc = safeInitProc; Tcl_MutexLock(&packageMutex); @@ -999,11 +1001,11 @@ /* * If we're loading the package into an interpreter, determine whether * it's already loaded. */ - ipFirstPtr = Tcl_GetAssocData(interp, "tclLoad", NULL); + ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL); for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { if (ipPtr->pkgPtr == pkgPtr) { return; } } @@ -1011,11 +1013,11 @@ /* * Package isn't loaded in the current interp yet. Mark it as now being * loaded. */ - ipPtr = Tcl_Alloc(sizeof(InterpPackage)); + ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); } } @@ -1087,11 +1089,11 @@ target = Tcl_GetSlave(interp, targetName); if (target == NULL) { return TCL_ERROR; } - ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL); + ipPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL); /* * Return information about all of the available packages. */ if (packageName) { @@ -1148,18 +1150,18 @@ static void LoadCleanupProc( ClientData clientData, /* Pointer to first InterpPackage structure * for interp. */ - Tcl_Interp *interp) /* Interpreter that is being deleted. */ + TCL_UNUSED(Tcl_Interp *)) { InterpPackage *ipPtr, *nextPtr; - ipPtr = clientData; + ipPtr = (InterpPackage *)clientData; while (ipPtr != NULL) { nextPtr = ipPtr->nextPtr; - Tcl_Free(ipPtr); + ckfree(ipPtr); ipPtr = nextPtr; } } /* @@ -1206,13 +1208,13 @@ if (pkgPtr->fileName[0] != '\0') { Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle); } #endif - Tcl_Free(pkgPtr->fileName); - Tcl_Free(pkgPtr->packageName); - Tcl_Free(pkgPtr); + ckfree(pkgPtr->fileName); + ckfree(pkgPtr->packageName); + ckfree(pkgPtr); } } /* * Local Variables: Index: generic/tclMain.c ================================================================== --- generic/tclMain.c +++ generic/tclMain.c @@ -15,25 +15,15 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ /* - * On Windows, this file needs to be compiled twice, once with TCL_ASCII_MAIN - * defined. This way both Tcl_MainEx and Tcl_MainExW can be implemented, sharing - * the same source code. + * On Windows, this file needs to be compiled twice, once with UNICODE and + * _UNICODE defined. This way both Tcl_Main and Tcl_MainExW can be + * implemented, sharing the same source code. */ -#if defined(TCL_ASCII_MAIN) -# ifdef UNICODE -# undef UNICODE -# undef _UNICODE -# else -# define UNICODE -# define _UNICODE -# endif -#endif - #include "tclInt.h" /* * The default prompt used when the user has not overridden it. */ @@ -51,37 +41,24 @@ # define TCHAR char # define TEXT(arg) arg # define _tcscmp strcmp #endif -/* - * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise - * NewNativeObj is needed (which provides proper conversion from native - * encoding to UTF-8). - */ - -#if defined(UNICODE) && (TCL_UTF_MAX <= 4) -# define NewNativeObj Tcl_NewUnicodeObj -#else /* !UNICODE || (TCL_UTF_MAX > 4) */ static inline Tcl_Obj * NewNativeObj( - TCHAR *string, - size_t length) + TCHAR *string) { Tcl_DString ds; #ifdef UNICODE - if (length > 0) { - length *= sizeof(WCHAR); - } - Tcl_WinTCharToUtf(string, length, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(string, -1, &ds); #else - Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds); + Tcl_ExternalToUtfDString(NULL, (char *) string, -1, &ds); #endif return TclDStringToObj(&ds); } -#endif /* !UNICODE || (TCL_UTF_MAX > 4) */ /* * Declarations for various library functions and variables (don't want to * include tclPort.h here, because people might copy this file out of the Tcl * source directory to make their own modified versions). @@ -139,11 +116,11 @@ MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void); static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr); static void StdinProc(ClientData clientData, int mask); static void FreeMainInterp(ClientData clientData); -#ifndef TCL_ASCII_MAIN +#if !defined(_WIN32) || defined(UNICODE) && !defined(TCL_ASCII_MAIN) static Tcl_ThreadDataKey dataKey; /* *---------------------------------------------------------------------- * @@ -220,11 +197,11 @@ if (encodingPtr != NULL) { if (tsdPtr->encoding == NULL) { *encodingPtr = NULL; } else { - *encodingPtr = TclGetString(tsdPtr->encoding); + *encodingPtr = Tcl_GetString(tsdPtr->encoding); } } return tsdPtr->path; } @@ -284,11 +261,11 @@ } } Tcl_DStringFree(&temp); } } -#endif /* !TCL_ASCII_MAIN */ +#endif /* !UNICODE */ /*---------------------------------------------------------------------- * * Tcl_MainEx -- * @@ -304,11 +281,11 @@ * interpreted. * *---------------------------------------------------------------------- */ -TCL_NORETURN void +void Tcl_MainEx( int argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization @@ -346,26 +323,26 @@ * FILENAME */ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { - Tcl_Obj *value = NewNativeObj(argv[2], -1); - Tcl_SetStartupScript(NewNativeObj(argv[3], -1), - TclGetString(value)); + Tcl_Obj *value = NewNativeObj(argv[2]); + Tcl_SetStartupScript(NewNativeObj(argv[3]), + Tcl_GetString(value)); Tcl_DecrRefCount(value); argc -= 3; argv += 3; } else if ((argc > 1) && ('-' != argv[1][0])) { - Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); + Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); argc--; argv++; } } path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { - appName = NewNativeObj(argv[0], -1); + appName = NewNativeObj(argv[0]); } else { appName = path; } Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); argc--; @@ -373,11 +350,11 @@ Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { - Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1)); + Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++)); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. @@ -467,16 +444,16 @@ /* * Get a new value for tty if anyone writes to ::tcl_interactive */ - Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN); + Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN); is.input = Tcl_GetStdChannel(TCL_STDIN); while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { - size_t length; + int length; if (is.tty) { Prompt(interp, &is); if (Tcl_InterpDeleted(interp)) { break; @@ -493,11 +470,11 @@ Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. * This sets up a tight polling loop (since we have no @@ -537,11 +514,11 @@ /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ - (void)TclGetStringFromObj(is.commandPtr, &length); + TclGetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); is.input = Tcl_GetStdChannel(TCL_STDIN); Tcl_DecrRefCount(is.commandPtr); @@ -554,11 +531,11 @@ Tcl_WriteChars(chan, "\n", 1); } } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); - (void)TclGetStringFromObj(resultPtr, &length); + TclGetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } @@ -640,11 +617,11 @@ */ Tcl_Exit(exitCode); } -#ifndef TCL_ASCII_MAIN +#if !defined(_WIN32) || defined(UNICODE) /* *--------------------------------------------------------------- * * Tcl_SetMainLoop -- @@ -731,11 +708,11 @@ Tcl_DStringFree(&ds); } return finalize; #endif /* PURIFY */ } -#endif /* !TCL_ASCII_MAIN */ +#endif /* UNICODE */ /* *---------------------------------------------------------------------- * * StdinProc -- @@ -752,19 +729,17 @@ * Could be almost arbitrary, depending on the command that's typed. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ - int mask) /* Not used. */ + TCL_UNUSED(int) /*mask*/) { - int code; - size_t length; - InteractiveState *isPtr = clientData; + int code, length; + InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; Tcl_Interp *interp = isPtr->interp; if (Tcl_IsShared(commandPtr)) { @@ -771,11 +746,11 @@ Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { if (Tcl_InputBlocked(chan)) { return; } if (isPtr->tty) { /* @@ -799,11 +774,11 @@ if (!TclObjCommandComplete(commandPtr)) { isPtr->prompt = PROMPT_CONTINUE; goto prompt; } isPtr->prompt = PROMPT_START; - (void)TclGetStringFromObj(commandPtr, &length); + TclGetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* * Disable the stdin channel handler while evaluating the command; * otherwise if the command re-enters the event loop we might process @@ -830,11 +805,11 @@ } else if (isPtr->tty) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); - (void)TclGetStringFromObj(resultPtr, &length); + TclGetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); @@ -932,11 +907,11 @@ static void FreeMainInterp( ClientData clientData) { - Tcl_Interp *interp = clientData; + Tcl_Interp *interp = (Tcl_Interp *)clientData; /*if (TclInExit()) return;*/ if (!Tcl_InterpDeleted(interp)) { Tcl_DeleteInterp(interp); Index: generic/tclNamesp.c ================================================================== --- generic/tclNamesp.c +++ generic/tclNamesp.c @@ -31,11 +31,11 @@ * Thread-local storage used to avoid having a global lock on data that is not * limited to a single interpreter. */ typedef struct { - size_t numNsCreated; /* Count of the number of namespaces created + unsigned long numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be * per-interp because the nsId is used to * distinguish objects which can be passed * around between interps in the same thread, @@ -51,11 +51,11 @@ * of resolving the namespace's name in some other namespace. It is the * internal representation for a nsName object. It contains the pointer along * with some information that is used to check the cached pointer's validity. */ -typedef struct { +typedef struct ResolvedNsName { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ Namespace *refNsPtr; /* Points to the namespace context in which * the name was resolved. NULL if the name is * fully qualified and thus the resolution @@ -90,51 +90,31 @@ static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); static int InvokeImportedNRCmd(ClientData clientData, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceChildrenCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceCurrentCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NRNamespaceEvalCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceExistsCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc NamespaceChildrenCmd; +static Tcl_ObjCmdProc NamespaceCodeCmd; +static Tcl_ObjCmdProc NamespaceCurrentCmd; +static Tcl_ObjCmdProc NamespaceDeleteCmd; +static Tcl_ObjCmdProc NamespaceEvalCmd; +static Tcl_ObjCmdProc NRNamespaceEvalCmd; +static Tcl_ObjCmdProc NamespaceExistsCmd; +static Tcl_ObjCmdProc NamespaceExportCmd; +static Tcl_ObjCmdProc NamespaceForgetCmd; static void NamespaceFree(Namespace *nsPtr); -static int NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceInscopeCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NRNamespaceInscopeCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespacePathCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceQualifiersCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int NamespaceUnknownCmd(ClientData dummy, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); -static int NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc NamespaceImportCmd; +static Tcl_ObjCmdProc NamespaceInscopeCmd; +static Tcl_ObjCmdProc NRNamespaceInscopeCmd; +static Tcl_ObjCmdProc NamespaceOriginCmd; +static Tcl_ObjCmdProc NamespaceParentCmd; +static Tcl_ObjCmdProc NamespacePathCmd; +static Tcl_ObjCmdProc NamespaceQualifiersCmd; +static Tcl_ObjCmdProc NamespaceTailCmd; +static Tcl_ObjCmdProc NamespaceUpvarCmd; +static Tcl_ObjCmdProc NamespaceUnknownCmd; +static Tcl_ObjCmdProc NamespaceWhichCmd; static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UnlinkNsPath(Namespace *nsPtr); static Tcl_NRPostProc NsEval_Callback; @@ -164,11 +144,11 @@ #define NsNameGetIntRep(objPtr, nnPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &nsNameType); \ - (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. @@ -238,11 +218,11 @@ *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( - register Tcl_Interp *interp)/* Interpreter whose current namespace is + Tcl_Interp *interp)/* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); } @@ -262,11 +242,11 @@ *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( - register Tcl_Interp *interp)/* Interpreter whose global namespace should + Tcl_Interp *interp)/* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); } @@ -314,12 +294,12 @@ * inscope" command and var references are * treated as references to namespace * variables. */ { Interp *iPtr = (Interp *) interp; - register CallFrame *framePtr = (CallFrame *) callFramePtr; - register Namespace *nsPtr; + CallFrame *framePtr = (CallFrame *) callFramePtr; + Namespace *nsPtr; if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; @@ -333,11 +313,10 @@ * Review of those designs might permit stricter checking here. */ if (nsPtr->flags & NS_DEAD) { Tcl_Panic("Trying to push call frame for dead namespace"); - /*NOTREACHED*/ } } nsPtr->activationCount++; framePtr->nsPtr = nsPtr; @@ -391,12 +370,12 @@ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { - register Interp *iPtr = (Interp *) interp; - register CallFrame *framePtr = iPtr->framePtr; + Interp *iPtr = (Interp *) interp; + CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; /* * It's important to remove the call frame from the interpreter's stack of * call frames before deleting local variables, so that traces invoked by @@ -410,11 +389,11 @@ /* Tcl_PopCallFrame: trying to pop rootCallFrame! */ } if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); - Tcl_Free(framePtr->varTablePtr); + ckfree(framePtr->varTablePtr); framePtr->varTablePtr = NULL; } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); if (framePtr->localCachePtr->refCount-- <= 1) { @@ -428,12 +407,13 @@ * is "dying" and there are no more active call frames, call * Tcl_DeleteNamespace to destroy it. */ nsPtr = framePtr->nsPtr; - if ((--nsPtr->activationCount <= (unsigned)(nsPtr == iPtr->globalNsPtr)) - && (nsPtr->flags & NS_DYING)) { + nsPtr->activationCount--; + if ((nsPtr->flags & NS_DYING) + && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; if (framePtr->tailcallPtr) { @@ -477,11 +457,11 @@ * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { - *framePtrPtr = TclStackAlloc(interp, sizeof(CallFrame)); + *framePtrPtr = (Tcl_CallFrame *)TclStackAlloc(interp, sizeof(CallFrame)); return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr, isProcCallFrame); } void @@ -511,15 +491,15 @@ *---------------------------------------------------------------------- */ static char * EstablishErrorCodeTraces( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - const char *name1, - const char *name2, - int flags) + TCL_UNUSED(const char *) /*name1*/, + TCL_UNUSED(const char *) /*name2*/, + TCL_UNUSED(int) /*flags*/) { Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS, ErrorCodeRead, NULL); Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS, EstablishErrorCodeTraces, NULL); @@ -543,15 +523,15 @@ *---------------------------------------------------------------------- */ static char * ErrorCodeRead( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - const char *name1, - const char *name2, - int flags) + TCL_UNUSED(const char *) /*name1*/, + TCL_UNUSED(const char *) /*name2*/, + TCL_UNUSED(int) /*flags*/) { Interp *iPtr = (Interp *) interp; if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) { return NULL; @@ -585,15 +565,15 @@ *---------------------------------------------------------------------- */ static char * EstablishErrorInfoTraces( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - const char *name1, - const char *name2, - int flags) + TCL_UNUSED(const char *) /*name1*/, + TCL_UNUSED(const char *) /*name2*/, + TCL_UNUSED(int) /*flags*/) { Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS, ErrorInfoRead, NULL); Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS, EstablishErrorInfoTraces, NULL); @@ -617,15 +597,15 @@ *---------------------------------------------------------------------- */ static char * ErrorInfoRead( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - const char *name1, - const char *name2, - int flags) + TCL_UNUSED(const char *) /*name1*/, + TCL_UNUSED(const char *) /*name2*/, + TCL_UNUSED(int) /*flags*/) { Interp *iPtr = (Interp *) interp; if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) { return NULL; @@ -676,19 +656,18 @@ /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { Interp *iPtr = (Interp *) interp; - register Namespace *nsPtr, *ancestorPtr; + Namespace *nsPtr, *ancestorPtr; Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr; Namespace *globalNsPtr = iPtr->globalNsPtr; const char *simpleName; Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; Tcl_DString *namePtr, *buffPtr; - int newEntry; - size_t nameLen; + int newEntry, nameLen; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); const char *nameStr; Tcl_DString tmpBuffer; Tcl_DStringInit(&tmpBuffer); @@ -783,13 +762,13 @@ * Create the new namespace and root it in its parent. Increment the count * of namespaces created. */ doCreate: - nsPtr = Tcl_Alloc(sizeof(Namespace)); + nsPtr = (Namespace *)ckalloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; - nsPtr->name = Tcl_Alloc(nameLen); + nsPtr->name = (char *)ckalloc(nameLen); memcpy(nsPtr->name, simpleName, nameLen); nsPtr->fullName = NULL; /* Set below. */ nsPtr->clientData = clientData; nsPtr->deleteProc = deleteProc; nsPtr->parentPtr = parentPtr; @@ -846,11 +825,11 @@ namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { - register Tcl_DString *tempPtr = namePtr; + Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); TclDStringAppendDString(buffPtr, namePtr); @@ -873,11 +852,11 @@ } } name = Tcl_DStringValue(namePtr); nameLen = Tcl_DStringLength(namePtr); - nsPtr->fullName = Tcl_Alloc(nameLen + 1); + nsPtr->fullName = (char *)ckalloc(nameLen + 1); memcpy(nsPtr->fullName, name, nameLen + 1); Tcl_DStringFree(&buffer1); Tcl_DStringFree(&buffer2); Tcl_DStringFree(&tmpBuffer); @@ -920,11 +899,11 @@ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { - register Namespace *nsPtr = (Namespace *) namespacePtr; + Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; Tcl_HashSearch search; @@ -965,11 +944,11 @@ * separate list of coros. */ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); if (cmdPtr->nreProc == TclNRInterpCoroutine) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); } else { @@ -1021,11 +1000,11 @@ * namespace resolution code to recognize that the namespace is "deleted". * The structure's storage is freed by FreeNsNameInternalRep when its * refCount reaches 0. */ - if (nsPtr->activationCount > (unsigned)(nsPtr == globalNsPtr)) { + if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( TclGetNamespaceChildTable((Tcl_Namespace *) nsPtr->parentPtr), nsPtr->name); @@ -1060,11 +1039,11 @@ #ifndef BREAK_NAMESPACE_COMPAT Tcl_DeleteHashTable(&nsPtr->childTable); #else if (nsPtr->childTablePtr != NULL) { Tcl_DeleteHashTable(nsPtr->childTablePtr); - Tcl_Free(nsPtr->childTablePtr); + ckfree(nsPtr->childTablePtr); } #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); nsPtr ->flags |= NS_DEAD; @@ -1116,17 +1095,17 @@ *---------------------------------------------------------------------- */ void TclTeardownNamespace( - register Namespace *nsPtr) /* Points to the namespace to be dismantled + Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - size_t i; + int i; /* * Start by destroying the namespace's variable table, since variables * might trigger traces. Variable table should be cleared but not freed! * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards. @@ -1143,19 +1122,19 @@ * f97d4ee020]) we copy to a temporary array and then delete all those * commands. */ while (nsPtr->cmdTable.numEntries > 0) { - size_t length = nsPtr->cmdTable.numEntries; - Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr, + int length = nsPtr->cmdTable.numEntries; + Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Command *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - cmds[i] = Tcl_GetHashValue(entryPtr); + cmds[i] = (Command *)Tcl_GetHashValue(entryPtr); cmds[i]->refCount++; i++; } for (i = 0 ; i < length ; i++) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, @@ -1215,19 +1194,19 @@ * Important: leave the hash table itself still live. */ #ifndef BREAK_NAMESPACE_COMPAT while (nsPtr->childTable.numEntries > 0) { - size_t length = nsPtr->childTable.numEntries; - Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, + int length = nsPtr->childTable.numEntries; + Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = Tcl_GetHashValue(entryPtr); + children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); children[i]->refCount++; i++; } for (i = 0 ; i < length ; i++) { Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); @@ -1236,12 +1215,12 @@ TclStackFree((Tcl_Interp *) iPtr, children); } #else if (nsPtr->childTablePtr != NULL) { while (nsPtr->childTablePtr->numEntries > 0) { - size_t length = nsPtr->childTablePtr->numEntries; - Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, + int length = nsPtr->childTablePtr->numEntries; + Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); entryPtr != NULL; @@ -1263,13 +1242,13 @@ * Free the namespace's export pattern array. */ if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { - Tcl_Free(nsPtr->exportArrayPtr[i]); + ckfree(nsPtr->exportArrayPtr[i]); } - Tcl_Free(nsPtr->exportArrayPtr); + ckfree(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; } @@ -1309,21 +1288,21 @@ *---------------------------------------------------------------------- */ static void NamespaceFree( - register Namespace *nsPtr) /* Points to the namespace to free. */ + Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is * deleted by Tcl_DeleteNamespace. All that remains is to free its names * (for error messages), and the structure itself. */ - Tcl_Free(nsPtr->name); - Tcl_Free(nsPtr->fullName); - Tcl_Free(nsPtr); + ckfree(nsPtr->name); + ckfree(nsPtr->fullName); + ckfree(nsPtr); } /* *---------------------------------------------------------------------- * @@ -1388,11 +1367,11 @@ #define INIT_EXPORT_PATTERNS 5 Namespace *nsPtr, *exportNsPtr, *dummyPtr; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; - size_t neededElems, len, i; + int neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. */ @@ -1408,13 +1387,13 @@ */ if (resetListFirst) { if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { - Tcl_Free(nsPtr->exportArrayPtr[i]); + ckfree(nsPtr->exportArrayPtr[i]); } - Tcl_Free(nsPtr->exportArrayPtr); + ckfree(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; TclInvalidateNsCmdLookup(nsPtr); nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; } @@ -1457,20 +1436,20 @@ neededElems = nsPtr->numExportPatterns + 1; if (neededElems > nsPtr->maxExportPatterns) { nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ? 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS; - nsPtr->exportArrayPtr = Tcl_Realloc(nsPtr->exportArrayPtr, + nsPtr->exportArrayPtr = (char **)ckrealloc(nsPtr->exportArrayPtr, sizeof(char *) * nsPtr->maxExportPatterns); } /* * Add the pattern to the namespace's array of export patterns. */ len = strlen(pattern); - patternCpy = Tcl_Alloc(len + 1); + patternCpy = (char *)ckalloc(len + 1); memcpy(patternCpy, pattern, len + 1); nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; nsPtr->numExportPatterns++; @@ -1515,12 +1494,11 @@ * for the current namespace. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * export pattern list is appended. */ { Namespace *nsPtr; - size_t i; - int result; + int i, result; /* * If the specified namespace is NULL, use the current namespace. */ @@ -1585,11 +1563,11 @@ * return an error if an imported cmd * conflicts with an existing one. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ @@ -1678,11 +1656,11 @@ return DoImport(interp, nsPtr, hPtr, simplePattern, pattern, importNsPtr, allowOverwrite); } for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { - char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); + char *cmdName = (char *)Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern) && DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite) == TCL_ERROR) { return TCL_ERROR; @@ -1718,11 +1696,11 @@ const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite) { - size_t i = 0, exported = 0; + int i = 0, exported = 0; Tcl_HashEntry *found; /* * The command cmdName in the source namespace matches the pattern. Check * whether it was exported. If it wasn't, we ignore it. @@ -1765,17 +1743,17 @@ /* * Check whether creating the new imported command in the current * namespace would create a cycle of imported command references. */ - cmdPtr = Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) { - Command *overwrite = Tcl_GetHashValue(found); + Command *overwrite = (Command *)Tcl_GetHashValue(found); Command *linkCmd = cmdPtr; while (linkCmd->deleteProc == DeleteImportedCmd) { - dataPtr = linkCmd->objClientData; + dataPtr = (ImportedCmdData *)linkCmd->objClientData; linkCmd = dataPtr->realCmdPtr; if (overwrite == linkCmd) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "import pattern \"%s\" would create a loop" " containing command \"%s\"", @@ -1785,11 +1763,11 @@ return TCL_ERROR; } } } - dataPtr = Tcl_Alloc(sizeof(ImportedCmdData)); + dataPtr = (ImportedCmdData *)ckalloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); dataPtr->realCmdPtr = cmdPtr; dataPtr->selfPtr = (Command *) importedCmd; @@ -1799,19 +1777,19 @@ /* * Create an ImportRef structure describing this new import command * and add it to the import ref list in the "real" command. */ - refPtr = Tcl_Alloc(sizeof(ImportRef)); + refPtr = (ImportRef *)ckalloc(sizeof(ImportRef)); refPtr->importedCmdPtr = (Command *) importedCmd; refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; } else { - Command *overwrite = Tcl_GetHashValue(found); + Command *overwrite = (Command *)Tcl_GetHashValue(found); if (overwrite->deleteProc == DeleteImportedCmd) { - ImportedCmdData *dataPtr = overwrite->objClientData; + ImportedCmdData *dataPtr = (ImportedCmdData *)overwrite->objClientData; if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) { /* * Repeated import of same command is acceptable. */ @@ -1864,11 +1842,11 @@ * commands to remove. */ { Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ @@ -1901,26 +1879,26 @@ */ if (TclMatchIsTrivial(simplePattern)) { hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (hPtr != NULL) { - Command *cmdPtr = Tcl_GetHashValue(hPtr); + Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } } return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { - Command *cmdPtr = Tcl_GetHashValue(hPtr); + Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc != DeleteImportedCmd) { continue; } - cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); + cmdName = (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); if (Tcl_StringMatch(cmdName, simplePattern)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } } return TCL_OK; @@ -1931,11 +1909,11 @@ */ for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Tcl_CmdInfo info; - Tcl_Command token = Tcl_GetHashValue(hPtr); + Tcl_Command token = (Tcl_Command)Tcl_GetHashValue(hPtr); Tcl_Command origin = TclGetOriginalCommand(token); if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) { continue; /* Not an imported command. */ } @@ -1944,11 +1922,11 @@ * Original not in namespace we're matching. Check the first link * in the import chain. */ Command *cmdPtr = (Command *) token; - ImportedCmdData *dataPtr = cmdPtr->objClientData; + ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData; Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr; if (firstToken == origin) { continue; } @@ -1991,19 +1969,19 @@ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { - register Command *cmdPtr = (Command *) command; + Command *cmdPtr = (Command *) command; ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { return NULL; } while (cmdPtr->deleteProc == DeleteImportedCmd) { - dataPtr = cmdPtr->objClientData; + dataPtr = (ImportedCmdData *)cmdPtr->objClientData; cmdPtr = dataPtr->realCmdPtr; } return (Tcl_Command) cmdPtr; } @@ -2032,11 +2010,11 @@ * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - ImportedCmdData *dataPtr = clientData; + ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; Command *realCmdPtr = dataPtr->realCmdPtr; TclSkipTailcall(interp); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr); } @@ -2077,14 +2055,14 @@ static void DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { - ImportedCmdData *dataPtr = clientData; + ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; - register ImportRef *refPtr, *prevPtr; + ImportRef *refPtr, *prevPtr; prevPtr = NULL; for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL; refPtr = refPtr->nextPtr) { if (refPtr->importedCmdPtr == selfPtr) { @@ -2096,12 +2074,12 @@ if (prevPtr == NULL) { /* refPtr is first in list. */ realCmdPtr->importRefPtr = refPtr->nextPtr; } else { prevPtr->nextPtr = refPtr->nextPtr; } - Tcl_Free(refPtr); - Tcl_Free(dataPtr); + ckfree(refPtr); + ckfree(dataPtr); return; } prevPtr = refPtr; } @@ -2353,11 +2331,11 @@ } else { entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName); } #endif if (entryPtr != NULL) { - nsPtr = Tcl_GetHashValue(entryPtr); + nsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) { Tcl_CallFrame *framePtr; (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0); @@ -2388,11 +2366,11 @@ } else { entryPtr = NULL; } #endif if (entryPtr != NULL) { - altNsPtr = Tcl_GetHashValue(entryPtr); + altNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); } else { altNsPtr = NULL; } } @@ -2500,11 +2478,11 @@ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ - register int flags) /* Flags controlling namespace lookup: an OR'd + int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; const char *dummy; @@ -2571,12 +2549,12 @@ * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; - register Tcl_HashEntry *entryPtr; - register Command *cmdPtr; + Tcl_HashEntry *entryPtr; + Command *cmdPtr; const char *simpleName; int result; /* * If this namespace has a command resolver, then give it first crack at @@ -2627,11 +2605,11 @@ */ cmdPtr = NULL; if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2) && !(flags & TCL_NAMESPACE_ONLY)) { - size_t i; + int i; Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr; (void) TclGetNamespaceForQualName(interp, name, cxtNsPtr, TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); @@ -2638,11 +2616,11 @@ if ((realNsPtr != NULL) && (simpleName != NULL)) { if ((cxtNsPtr == realNsPtr) || !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } /* @@ -2659,11 +2637,11 @@ &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL) && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } /* @@ -2677,17 +2655,17 @@ &simpleName); if ((realNsPtr != NULL) && (simpleName != NULL) && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; - register int search; + int search; TclGetNamespaceForQualName(interp, name, cxtNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* @@ -2699,11 +2677,11 @@ for (search = 0; (search < 2) && (cmdPtr == NULL); search++) { if ((nsPtr[search] != NULL) && (simpleName != NULL)) { entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = Tcl_GetHashValue(entryPtr); + cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } } @@ -2757,17 +2735,17 @@ Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; - register Namespace *nsPtr; + Namespace *nsPtr; Namespace *trailNsPtr, *shadowNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; int trailFront = -1; int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ - Namespace **trailPtr = TclStackAlloc(interp, + Namespace **trailPtr = (Namespace **)TclStackAlloc(interp, trailSize * sizeof(Namespace *)); /* * Start at the namespace containing the new command, and work up through * the list of parents. Stop just before the global namespace, since the @@ -2783,11 +2761,11 @@ * there is a identically-named sequence of child namespaces starting from * :: (e.g. "::b") whose tail namespace contains a command also named * cmdName. */ - cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr); + cmdName = (char *)Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr); for (nsPtr=newCmdPtr->nsPtr ; (nsPtr!=NULL) && (nsPtr!=globalNsPtr) ; nsPtr=nsPtr->parentPtr) { /* * Find the maximal sequence of child namespaces contained in nsPtr * such that there is a identically-named sequence of child namespaces @@ -2812,11 +2790,11 @@ } else { hPtr = NULL; } #endif if (hPtr != NULL) { - shadowNsPtr = Tcl_GetHashValue(hPtr); + shadowNsPtr = (Namespace *)Tcl_GetHashValue(hPtr); } else { found = 0; break; } } @@ -2853,11 +2831,11 @@ trailFront++; if (trailFront == trailSize) { int newSize = 2 * trailSize; - trailPtr = TclStackRealloc(interp, trailPtr, + trailPtr = (Namespace **)TclStackRealloc(interp, trailPtr, newSize * sizeof(Namespace *)); trailSize = newSize; } trailPtr[trailFront] = nsPtr; } @@ -2997,21 +2975,21 @@ *---------------------------------------------------------------------- */ static int NamespaceChildrenCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; - register Tcl_HashEntry *entryPtr; + Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Tcl_Obj *listPtr, *elemPtr; /* * Get a pointer to the specified namespace, or the current namespace. @@ -3054,11 +3032,11 @@ * names match the specified pattern, if any. */ listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - size_t length = strlen(nsPtr->fullName); + unsigned int length = strlen(nsPtr->fullName); if (strncmp(pattern, nsPtr->fullName, length) != 0) { goto searchDone; } if ( @@ -3081,11 +3059,11 @@ goto searchDone; } entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); #endif while (entryPtr != NULL) { - childNsPtr = Tcl_GetHashValue(entryPtr); + childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); if ((pattern == NULL) || Tcl_StringMatch(childNsPtr->fullName, pattern)) { elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemPtr); } @@ -3126,19 +3104,19 @@ *---------------------------------------------------------------------- */ static int NamespaceCodeCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; - register const char *arg; - size_t length; + const char *arg; + int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); return TCL_ERROR; } @@ -3207,16 +3185,16 @@ *---------------------------------------------------------------------- */ static int NamespaceCurrentCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Namespace *currNsPtr; + Namespace *currNsPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } @@ -3270,18 +3248,18 @@ *---------------------------------------------------------------------- */ static int NamespaceDeleteCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; const char *name; - register int i; + int i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?name name...?"); return TCL_ERROR; } @@ -3358,11 +3336,11 @@ objv); } static int NRNamespaceEvalCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -3444,22 +3422,22 @@ NsEval_Callback( ClientData data[], Tcl_Interp *interp, int result) { - Tcl_Namespace *namespacePtr = data[0]; + Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0]; if (result == TCL_ERROR) { - size_t length = strlen(namespacePtr->fullName); - unsigned limit = 200; + int length = strlen(namespacePtr->fullName); + int limit = 200; int overflow = (length > limit); - char *cmd = data[1]; + char *cmd = (char *)data[1]; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace %s \"%.*s%s\" script line %d)", cmd, - (overflow ? limit : (unsigned)length), namespacePtr->fullName, + (overflow ? limit : length), namespacePtr->fullName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* * Restore the previous "current" namespace. @@ -3490,11 +3468,11 @@ *---------------------------------------------------------------------- */ static int NamespaceExistsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; @@ -3545,11 +3523,11 @@ *---------------------------------------------------------------------- */ static int NamespaceExportCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int firstArg, i; @@ -3575,11 +3553,11 @@ /* * Process the optional "-clear" argument. */ firstArg = 1; - if (strcmp("-clear", TclGetString(objv[firstArg])) == 0) { + if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) { Tcl_Export(interp, NULL, "::", 1); Tcl_ResetResult(interp); firstArg++; } @@ -3586,11 +3564,11 @@ /* * Add each pattern to the namespace's export pattern list. */ for (i = firstArg; i < objc; i++) { - int result = Tcl_Export(interp, NULL, TclGetString(objv[i]), 0); + int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0); if (result != TCL_OK) { return result; } } return TCL_OK; @@ -3626,17 +3604,17 @@ *---------------------------------------------------------------------- */ static int NamespaceForgetCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; - register int i, result; + int i, result; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?"); return TCL_ERROR; } @@ -3691,18 +3669,18 @@ *---------------------------------------------------------------------- */ static int NamespaceImportCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowOverwrite = 0; const char *string, *pattern; - register int i, result; + int i, result; int firstArg; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?"); return TCL_ERROR; @@ -3731,15 +3709,15 @@ Tcl_Obj *listPtr; TclNewObj(listPtr); for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Command *cmdPtr = Tcl_GetHashValue(hPtr); + Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj( - Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1)); + (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1)); } } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -3806,11 +3784,11 @@ objv); } static int NRNamespaceInscopeCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; @@ -3851,11 +3829,11 @@ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; - register Tcl_Obj *listPtr; + Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (i = 3; i < objc; i++) { if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){ Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ @@ -3903,11 +3881,11 @@ *---------------------------------------------------------------------- */ static int NamespaceOriginCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Command command, origCommand; @@ -3964,11 +3942,11 @@ *---------------------------------------------------------------------- */ static int NamespaceParentCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *nsPtr; @@ -4022,18 +4000,17 @@ *---------------------------------------------------------------------- */ static int NamespacePathCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); - size_t i; - int nsObjc, result = TCL_ERROR; + int i, nsObjc, result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pathList?"); @@ -4063,14 +4040,14 @@ if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) { goto badNamespace; } if (nsObjc != 0) { - namespaceList = TclStackAlloc(interp, + namespaceList = (Tcl_Namespace **)TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); - for (i=0 ; i<(size_t)nsObjc ; i++) { + for (i=0 ; icommandPathLength ; i++) { NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; if (nsPathPtr->prevPtr != NULL) { nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr; @@ -4184,11 +4161,11 @@ if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) { nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr; } } } - Tcl_Free(nsPtr->commandPathArray); + ckfree(nsPtr->commandPathArray); } /* *---------------------------------------------------------------------- * @@ -4248,17 +4225,17 @@ *---------------------------------------------------------------------- */ static int NamespaceQualifiersCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register const char *name, *p; - size_t length; + const char *name, *p; + int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } @@ -4316,11 +4293,11 @@ *---------------------------------------------------------------------- */ static int NamespaceUnknownCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *currNsPtr; @@ -4503,16 +4480,16 @@ *---------------------------------------------------------------------- */ static int NamespaceTailCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register const char *name, *p; + const char *name, *p; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } @@ -4561,11 +4538,11 @@ *---------------------------------------------------------------------- */ static int NamespaceUpvarCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -4635,11 +4612,11 @@ *---------------------------------------------------------------------- */ static int NamespaceWhichCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const opts[] = { @@ -4711,11 +4688,11 @@ *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( - register Tcl_Obj *objPtr) /* nsName object with internal representation + Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; NsNameGetIntRep(objPtr, resNamePtr); @@ -4732,11 +4709,11 @@ * namespace is dead, and there are no more references to it, free * it. */ TclNsDecrRefCount(resNamePtr->nsPtr); - Tcl_Free(resNamePtr); + ckfree(resNamePtr); } } /* *---------------------------------------------------------------------- @@ -4758,11 +4735,11 @@ */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; NsNameGetIntRep(srcPtr, resNamePtr); assert(resNamePtr != NULL); @@ -4794,15 +4771,15 @@ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; - register ResolvedNsName *resNamePtr; + ResolvedNsName *resNamePtr; const char *name; if (interp == NULL) { return TCL_ERROR; } @@ -4819,11 +4796,11 @@ * If we found a namespace, then create a new ResolvedNsName structure * that holds a reference to it. */ nsPtr->refCount++; - resNamePtr = Tcl_Alloc(sizeof(ResolvedNsName)); + resNamePtr = (ResolvedNsName *)ckalloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; if ((name[0] == ':') && (name[1] == ':')) { resNamePtr->refNsPtr = NULL; } else { resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); @@ -4879,11 +4856,11 @@ Namespace *nPtr = (Namespace *) nsPtr; #ifndef BREAK_NAMESPACE_COMPAT return &nPtr->childTable; #else if (nPtr->childTablePtr == NULL) { - nPtr->childTablePtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + nPtr->childTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS); } return nPtr->childTablePtr; #endif } @@ -4915,17 +4892,17 @@ Tcl_Interp *interp, /* Interpreter in which to log information. */ const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - size_t length, /* Number of bytes in command (-1 means - * use all bytes up to first null byte). */ + int length, /* Number of bytes in command (-1 means use + * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { - register const char *p; + const char *p; Interp *iPtr = (Interp *) interp; int overflow, limit = 150; Var *varPtr, *arrayPtr; if (iPtr->flags & ERR_ALREADY_LOGGED) { @@ -4947,18 +4924,18 @@ if (*p == '\n') { iPtr->errorLine++; } } - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = strlen(command); } - overflow = (length > (size_t)limit); + overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), - (overflow ? limit : (int)length), command, + (overflow ? limit : length), command, (overflow ? "..." : ""))); varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, NULL, 0, 0, &arrayPtr); if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) { @@ -4968,11 +4945,11 @@ return; } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); - VarTrace *tracePtr = Tcl_GetHashValue(hPtr); + VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); if (tracePtr->traceProc != EstablishErrorInfoTraces) { /* * The most recent trace set on ::errorInfo is not the one the * core itself puts on last. This means some other code is @@ -5072,11 +5049,11 @@ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, - size_t length) + int length) { Interp *iPtr = (Interp *) interp; if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; @@ -5127,11 +5104,11 @@ Tcl_Interp *interp, /* Interpreter in which to log information. */ const char *script, /* First character in script containing * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - size_t length) /* Number of bytes in command (-1 means use + int length) /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } Index: generic/tclNotify.c ================================================================== --- generic/tclNotify.c +++ generic/tclNotify.c @@ -179,11 +179,11 @@ Tcl_MutexLock(&(tsdPtr->queueMutex)); for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) { hold = evPtr; evPtr = evPtr->nextPtr; - Tcl_Free(hold); + ckfree(hold); } tsdPtr->firstEventPtr = NULL; tsdPtr->lastEventPtr = NULL; Tcl_MutexUnlock(&(tsdPtr->queueMutex)); @@ -274,11 +274,11 @@ * happened. */ ClientData clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - EventSource *sourcePtr = Tcl_Alloc(sizeof(EventSource)); + EventSource *sourcePtr = (EventSource *)ckalloc(sizeof(EventSource)); sourcePtr->setupProc = setupProc; sourcePtr->checkProc = checkProc; sourcePtr->clientData = clientData; sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr; @@ -328,11 +328,11 @@ if (prevPtr == NULL) { tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr; } else { prevPtr->nextPtr = sourcePtr->nextPtr; } - Tcl_Free(sourcePtr); + ckfree(sourcePtr); return; } } /* @@ -353,11 +353,11 @@ void Tcl_QueueEvent( Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (Tcl_Alloc), and it becomes the + * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, * TCL_QUEUE_MARK. */ { @@ -385,11 +385,11 @@ void Tcl_ThreadQueueEvent( Tcl_ThreadId threadId, /* Identifier for thread to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (Tcl_Alloc), and it becomes the + * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, * TCL_QUEUE_MARK. */ { @@ -410,11 +410,11 @@ */ if (tsdPtr) { QueueEvent(tsdPtr, evPtr, position); } else { - Tcl_Free(evPtr); + ckfree(evPtr); } Tcl_MutexUnlock(&listLock); } /* @@ -442,11 +442,11 @@ QueueEvent( ThreadSpecificData *tsdPtr, /* Handle to thread local data that indicates * which event queue to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (Tcl_Alloc), and it becomes the + * malloc (ckalloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, * TCL_QUEUE_MARK. */ { @@ -561,11 +561,11 @@ * Delete the event data structure. */ hold = evPtr; evPtr = evPtr->nextPtr; - Tcl_Free(hold); + ckfree(hold); } else { /* * Event is to be retained. */ @@ -700,11 +700,11 @@ } else { evPtr = NULL; } } if (evPtr) { - Tcl_Free(evPtr); + ckfree(evPtr); } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; } else { /* Index: generic/tclOO.c ================================================================== --- generic/tclOO.c +++ generic/tclOO.c @@ -75,17 +75,14 @@ static Tcl_NRPostProc FinalizeObjectCall; static inline void InitClassPath(Tcl_Interp * interp, Class *clsPtr); static void InitClassSystemRoots(Tcl_Interp *interp, Foundation *fPtr); static int InitFoundation(Tcl_Interp *interp); -static void KillFoundation(ClientData clientData, - Tcl_Interp *interp); +static Tcl_InterpDeleteProc KillFoundation; static void MyDeleted(ClientData clientData); static void ObjectNamespaceDeleted(ClientData clientData); -static void ObjectRenamedTrace(ClientData clientData, - Tcl_Interp *interp, const char *oldName, - const char *newName, int flags); +static Tcl_CommandTraceProc ObjectRenamedTrace; static inline void RemoveClass(Class **list, int num, int idx); static inline void RemoveObject(Object **list, int num, int idx); static inline void SquelchCachedName(Object *oPtr); static int PublicNRObjectCmd(ClientData clientData, @@ -173,11 +170,11 @@ * either an oPtr or a classPtr. Note that the roots oo::object and oo::class * have _both_ their object and class flags tagged with ROOT_OBJECT and * ROOT_CLASS respectively. */ -#define Deleted(oPtr) ((oPtr)->flags & OBJECT_DELETED) +#define Destructing(oPtr) ((oPtr)->flags & OBJECT_DESTRUCTING) #define IsRootObject(ocPtr) ((ocPtr)->flags & ROOT_OBJECT) #define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS) #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) #define RemoveItem(type, lst, i) \ @@ -297,12 +294,12 @@ InitFoundation( Tcl_Interp *interp) { static Tcl_ThreadDataKey tsdKey; ThreadLocalData *tsdPtr = - Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); - Foundation *fPtr = Tcl_Alloc(sizeof(Foundation)); + (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); + Foundation *fPtr = (Foundation *)ckalloc(sizeof(Foundation)); Tcl_Obj *namePtr; Tcl_DString buffer; Command *cmdPtr; int i; @@ -321,11 +318,11 @@ DeletedDefineNamespace); fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr, DeletedObjdefNamespace); fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr, DeletedHelpersNamespace); - fPtr->epoch = 1; + fPtr->epoch = 0; fPtr->tsdPtr = tsdPtr; TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown"); TclNewLiteralStringObj(fPtr->constructorName, ""); TclNewLiteralStringObj(fPtr->destructorName, ""); TclNewLiteralStringObj(fPtr->clonedName, ""); @@ -463,11 +460,11 @@ * incremented reference count of fPtr->objectCls that was swallowed by * fakeObject. */ fPtr->objectCls->superclasses.num = 0; - Tcl_Free(fPtr->objectCls->superclasses.list); + ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* * Special initialization for the primordial objects. */ @@ -531,29 +528,29 @@ static void DeletedDefineNamespace( ClientData clientData) { - Foundation *fPtr = clientData; + Foundation *fPtr = (Foundation *)clientData; fPtr->defineNs = NULL; } static void DeletedObjdefNamespace( ClientData clientData) { - Foundation *fPtr = clientData; + Foundation *fPtr = (Foundation *)clientData; fPtr->objdefNs = NULL; } static void DeletedHelpersNamespace( ClientData clientData) { - Foundation *fPtr = clientData; + Foundation *fPtr = (Foundation *)clientData; fPtr->helpersNs = NULL; } /* @@ -567,14 +564,13 @@ * ---------------------------------------------------------------------- */ static void KillFoundation( - ClientData clientData, /* Pointer to the OO system foundation - * structure. */ - Tcl_Interp *interp) /* The interpreter containing the OO system - * foundation. */ + TCL_UNUSED(ClientData), + Tcl_Interp *interp) /* The interpreter containing the OO system + * foundation. */ { Foundation *fPtr = GetFoundation(interp); TclDecrRefCount(fPtr->unknownMethodNameObj); TclDecrRefCount(fPtr->constructorName); @@ -582,11 +578,11 @@ TclDecrRefCount(fPtr->clonedName); TclDecrRefCount(fPtr->defineName); TclOODecrRefCount(fPtr->objectCls->thisPtr); TclOODecrRefCount(fPtr->classCls->thisPtr); - Tcl_Free(fPtr); + ckfree(fPtr); } /* * ---------------------------------------------------------------------- * @@ -620,13 +616,13 @@ { Foundation *fPtr = GetFoundation(interp); Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - size_t creationEpoch; + int creationEpoch; - oPtr = Tcl_Alloc(sizeof(Object)); + oPtr = (Object *)ckalloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); /* * Every object has a namespace; make one. Note that this also normally * computes the creation epoch value for the object, a sequence number @@ -649,11 +645,11 @@ } while (1) { char objName[10 + TCL_INTEGER_SPACE]; - sprintf(objName, "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount); + sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = fPtr->tsdPtr->nsCount; break; } @@ -733,11 +729,11 @@ * abstractions, it is faster and we're inside Tcl here so we're allowed. */ cmdPtr = (Command *) oPtr->command; cmdPtr->nreProc = PublicNRObjectCmd; - cmdPtr->tracePtr = tracePtr = Tcl_Alloc(sizeof(CommandTrace)); + cmdPtr->tracePtr = tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace)); tracePtr->traceProc = ObjectRenamedTrace; tracePtr->clientData = oPtr; tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE; tracePtr->nextPtr = NULL; tracePtr->refCount = 1; @@ -787,20 +783,20 @@ static void MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { - register Object *oPtr = clientData; + Object *oPtr = (Object *)clientData; oPtr->myCommand = NULL; } static void MyClassDeleted( ClientData clientData) { - Object *oPtr = clientData; + Object *oPtr = (Object *)clientData; oPtr->myclassCommand = NULL; } /* * ---------------------------------------------------------------------- @@ -816,16 +812,16 @@ */ static void ObjectRenamedTrace( ClientData clientData, /* The object being deleted. */ - Tcl_Interp *interp, /* The interpreter containing the object. */ - const char *oldName, /* What the object was (last) called. */ - const char *newName, /* What it's getting renamed to. (unused) */ + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(const char *) /*oldName*/, + TCL_UNUSED(const char *) /*newName*/, int flags) /* Why was the object deleted? */ { - Object *oPtr = clientData; + Object *oPtr = (Object *)clientData; /* * If this is a rename and not a delete of the object, we just flush the * cache of the object name. */ @@ -838,11 +834,11 @@ /* * The namespace is only deleted if it hasn't already been deleted. [Bug * 2950259]. */ - if (!Deleted(oPtr)) { + if (!Destructing(oPtr)) { Tcl_DeleteNamespace(oPtr->namespacePtr); } oPtr->command = NULL; TclOODecrRefCount(oPtr); return; @@ -878,20 +874,20 @@ /* * This condition also covers the case where mixinSubclassPtr == * clsPtr */ - if (!Deleted(mixinSubclassPtr->thisPtr) + if (!Destructing(mixinSubclassPtr->thisPtr) && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); } TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); } } if (clsPtr->mixinSubs.size > 0) { - Tcl_Free(clsPtr->mixinSubs.list); + ckfree(clsPtr->mixinSubs.list); clsPtr->mixinSubs.size = 0; } /* * Squelch subclasses of this class. @@ -898,20 +894,20 @@ */ if (clsPtr->subclasses.num > 0) { while (clsPtr->subclasses.num > 0) { subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1]; - if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr) + if (!Destructing(subclassPtr->thisPtr) && !IsRoot(subclassPtr) && !(subclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } TclOORemoveFromSubclasses(subclassPtr, clsPtr); } } if (clsPtr->subclasses.size > 0) { - Tcl_Free(clsPtr->subclasses.list); + ckfree(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; clsPtr->subclasses.size = 0; } /* @@ -924,19 +920,19 @@ /* * This condition also covers the case where instancePtr == oPtr */ - if (!Deleted(instancePtr) && !IsRoot(instancePtr) && + if (!Destructing(instancePtr) && !IsRoot(instancePtr) && !(instancePtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } TclOORemoveFromInstances(instancePtr, clsPtr); } } if (clsPtr->instances.size > 0) { - Tcl_Free(clsPtr->instances.list); + ckfree(clsPtr->instances.list); clsPtr->instances.list = NULL; clsPtr->instances.size = 0; } } @@ -966,11 +962,11 @@ /* * Sanity check! */ - if (!Deleted(oPtr)) { + if (!Destructing(oPtr)) { if (IsRootClass(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::class"); } else if (IsRootObject(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", @@ -1008,11 +1004,11 @@ FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) { TclOODeleteChain(callPtr); } Tcl_DeleteHashTable(clsPtr->classChainCache); - Tcl_Free(clsPtr->classChainCache); + ckfree(clsPtr->classChainCache); clsPtr->classChainCache = NULL; } /* * Squelch our filter list. @@ -1022,11 +1018,11 @@ Tcl_Obj *filterObj; FOREACH(filterObj, clsPtr->filters) { TclDecrRefCount(filterObj); } - Tcl_Free(clsPtr->filters.list); + ckfree(clsPtr->filters.list); clsPtr->filters.list = NULL; clsPtr->filters.num = 0; } /* @@ -1039,30 +1035,30 @@ FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(clsPtr->metadataPtr); - Tcl_Free(clsPtr->metadataPtr); + ckfree(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } if (clsPtr->mixins.num) { FOREACH(tmpClsPtr, clsPtr->mixins) { TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } - Tcl_Free(clsPtr->mixins.list); + ckfree(clsPtr->mixins.list); clsPtr->mixins.list = NULL; clsPtr->mixins.num = 0; } if (clsPtr->superclasses.num > 0) { FOREACH(tmpClsPtr, clsPtr->superclasses) { TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } - Tcl_Free(clsPtr->superclasses.list); + ckfree(clsPtr->superclasses.list); clsPtr->superclasses.num = 0; clsPtr->superclasses.list = NULL; } FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { @@ -1074,22 +1070,22 @@ FOREACH(variableObj, clsPtr->variables) { TclDecrRefCount(variableObj); } if (i) { - Tcl_Free(clsPtr->variables.list); + ckfree(clsPtr->variables.list); } FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) { TclDecrRefCount(privateVariable->variableObj); TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - Tcl_Free(clsPtr->privateVariables.list); + ckfree(clsPtr->privateVariables.list); } - if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) { + if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) { Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command); } } /* @@ -1108,21 +1104,21 @@ static void ObjectNamespaceDeleted( ClientData clientData) /* Pointer to the class whose namespace is * being deleted. */ { - Object *oPtr = clientData; + Object *oPtr = (Object *)clientData; Foundation *fPtr = oPtr->fPtr; FOREACH_HASH_DECLS; Class *mixinPtr; Method *mPtr; Tcl_Obj *filterObj, *variableObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; int i; - if (Deleted(oPtr)) { + if (Destructing(oPtr)) { /* * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, * this guard could be removed. */ @@ -1133,11 +1129,11 @@ * One rule for the teardown routines is that if an object is in the * process of being deleted, nothing else may modify its bookeeping * records. This is the flag that */ - oPtr->flags |= OBJECT_DELETED; + oPtr->flags |= OBJECT_DESTRUCTING; /* * Let the dominoes fall! */ @@ -1214,42 +1210,42 @@ FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } if (oPtr->mixins.list != NULL) { - Tcl_Free(oPtr->mixins.list); + ckfree(oPtr->mixins.list); } } FOREACH(filterObj, oPtr->filters) { TclDecrRefCount(filterObj); } if (i) { - Tcl_Free(oPtr->filters.list); + ckfree(oPtr->filters.list); } if (oPtr->methodsPtr) { FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) { TclOODelMethodRef(mPtr); } Tcl_DeleteHashTable(oPtr->methodsPtr); - Tcl_Free(oPtr->methodsPtr); + ckfree(oPtr->methodsPtr); } FOREACH(variableObj, oPtr->variables) { TclDecrRefCount(variableObj); } if (i) { - Tcl_Free(oPtr->variables.list); + ckfree(oPtr->variables.list); } FOREACH_STRUCT(privateVariable, oPtr->privateVariables) { TclDecrRefCount(privateVariable->variableObj); TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - Tcl_Free(oPtr->privateVariables.list); + ckfree(oPtr->privateVariables.list); } if (oPtr->chainCache) { TclOODeleteChainCache(oPtr->chainCache); } @@ -1262,11 +1258,11 @@ FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) { metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(oPtr->metadataPtr); - Tcl_Free(oPtr->metadataPtr); + ckfree(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } /* * Because an object can be a class that is an instance of itself, the @@ -1278,11 +1274,11 @@ * class of classes now as well. Due to the incestuous nature of those two * classes, if one goes the other must too and yet the tangle can * sometimes not go away automatically; we force it here. [Bug 2962664] */ - if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr) + if (IsRootObject(oPtr) && !Destructing(fPtr->classCls->thisPtr) && !Tcl_InterpDeleted(interp)) { Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } if (oPtr->classPtr != NULL) { @@ -1318,17 +1314,31 @@ Object *oPtr) { if (oPtr->refCount-- <= 1) { if (oPtr->classPtr != NULL) { - Tcl_Free(oPtr->classPtr); + ckfree(oPtr->classPtr); } - Tcl_Free(oPtr); + ckfree(oPtr); return 1; } return 0; } + +/* + * ---------------------------------------------------------------------- + * + * TclOOObjectDestroyed -- + * + * Returns TCL_OK if an object is entirely deleted, i.e. the destruction + * sequence has completed. + * + * ---------------------------------------------------------------------- + */ +int TclOOObjectDestroyed(Object *oPtr) { + return (oPtr->namespacePtr == NULL); +} /* * ---------------------------------------------------------------------- * * TclOORemoveFromInstances -- @@ -1378,13 +1388,13 @@ * present as an instance in the class. */ { if (clsPtr->instances.num >= clsPtr->instances.size) { clsPtr->instances.size += ALLOC_CHUNK; if (clsPtr->instances.size == ALLOC_CHUNK) { - clsPtr->instances.list = Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK); + clsPtr->instances.list = (Object **)ckalloc(sizeof(Object *) * ALLOC_CHUNK); } else { - clsPtr->instances.list = Tcl_Realloc(clsPtr->instances.list, + clsPtr->instances.list = (Object **)ckrealloc(clsPtr->instances.list, sizeof(Object *) * clsPtr->instances.size); } } clsPtr->instances.list[clsPtr->instances.num++] = oPtr; AddRef(oPtr); @@ -1417,11 +1427,11 @@ res++; break; } } if (oPtr->mixins.num == 0) { - Tcl_Free(oPtr->mixins.list); + ckfree(oPtr->mixins.list); oPtr->mixins.list = NULL; } return res; } @@ -1471,19 +1481,19 @@ Class *subPtr, /* The subclass to add. */ Class *superPtr) /* The superclass to add the subclass to. It * is assumed that the class is not already * present as a subclass in the superclass. */ { - if (Deleted(superPtr->thisPtr)) { + if (Destructing(superPtr->thisPtr)) { return; } if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { - superPtr->subclasses.list = Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->subclasses.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->subclasses.list = Tcl_Realloc(superPtr->subclasses.list, + superPtr->subclasses.list = (Class **)ckrealloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size); } } superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr; AddRef(subPtr->thisPtr); @@ -1536,19 +1546,19 @@ Class *subPtr, /* The subclass to add. */ Class *superPtr) /* The superclass to add the subclass to. It * is assumed that the class is not already * present as a subclass in the superclass. */ { - if (Deleted(superPtr->thisPtr)) { + if (Destructing(superPtr->thisPtr)) { return; } if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) { superPtr->mixinSubs.size += ALLOC_CHUNK; if (superPtr->mixinSubs.size == ALLOC_CHUNK) { - superPtr->mixinSubs.list = Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->mixinSubs.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->mixinSubs.list = Tcl_Realloc(superPtr->mixinSubs.list, + superPtr->mixinSubs.list = (Class **)ckrealloc(superPtr->mixinSubs.list, sizeof(Class *) * superPtr->mixinSubs.size); } } superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; AddRef(subPtr->thisPtr); @@ -1590,11 +1600,11 @@ * class. */ Object *useThisObj) /* Object that is to act as the class * representation. */ { Foundation *fPtr = GetFoundation(interp); - Class *clsPtr = Tcl_Alloc(sizeof(Class)); + Class *clsPtr = (Class *)ckalloc(sizeof(Class)); memset(clsPtr, 0, sizeof(Class)); clsPtr->thisPtr = useThisObj; /* @@ -1607,11 +1617,11 @@ * Classes are subclasses of oo::object, i.e. the objects they create are * objects. */ clsPtr->superclasses.num = 1; - clsPtr->superclasses.list = Tcl_Alloc(sizeof(Class *)); + clsPtr->superclasses.list = (Class **)ckalloc(sizeof(Class *)); clsPtr->superclasses.list[0] = fPtr->objectCls; AddRef(fPtr->objectCls->thisPtr); /* * Finish connecting the class structure to the object structure. @@ -1650,11 +1660,11 @@ * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip) /* Number of arguments to _not_ pass to the * constructor. */ { - register Class *classPtr = (Class *) cls; + Class *classPtr = (Class *) cls; Object *oPtr; ClientData clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { @@ -1720,11 +1730,11 @@ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { - register Class *classPtr = (Class *) cls; + Class *classPtr = (Class *) cls; CallContext *contextPtr; Tcl_InterpState state; Object *oPtr; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); @@ -1835,21 +1845,21 @@ FinalizeAlloc( ClientData data[], Tcl_Interp *interp, int result) { - CallContext *contextPtr = data[0]; - Object *oPtr = data[1]; - Tcl_InterpState state = data[2]; - Tcl_Object *objectPtr = data[3]; + CallContext *contextPtr = (CallContext *)data[0]; + Object *oPtr = (Object *)data[1]; + Tcl_InterpState state = (Tcl_InterpState)data[2]; + Tcl_Object *objectPtr = (Tcl_Object *)data[3]; /* * Ensure an error if the object was deleted in the constructor. Don't * want to lose errors by accident. [Bug 2903011] */ - if (result != TCL_ERROR && Deleted(oPtr)) { + if (result != TCL_ERROR && Destructing(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object deleted in constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } @@ -1860,11 +1870,11 @@ * Take care to not delete a deleted object; that would be bad. [Bug * 2903011] Also take care to make sure that we have the name of the * command before we delete it. [Bug 9dd1bd7a74] */ - if (!Deleted(oPtr)) { + if (!Destructing(oPtr)) { (void) TclOOObjectName(interp, oPtr); Tcl_DeleteCommandFromToken(interp, oPtr->command); } /* @@ -1957,11 +1967,11 @@ if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOORemoveFromInstances(o2Ptr, mixinPtr); } TclOODecrRefCount(mixinPtr->thisPtr); } - Tcl_Free(o2Ptr->mixins.list); + ckfree(o2Ptr->mixins.list); } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOOAddToInstances(o2Ptr, mixinPtr); @@ -2005,11 +2015,11 @@ * it the root of the object system or in the midst of processing a filter * call. */ o2Ptr->flags = oPtr->flags & ~( - OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); + OBJECT_DESTRUCTING | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. */ @@ -2058,15 +2068,15 @@ FOREACH(superPtr, cls2Ptr->superclasses) { TclOORemoveFromSubclasses(cls2Ptr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } if (cls2Ptr->superclasses.num) { - cls2Ptr->superclasses.list = Tcl_Realloc(cls2Ptr->superclasses.list, + cls2Ptr->superclasses.list = (Class **) ckrealloc(cls2Ptr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); } else { cls2Ptr->superclasses.list = - Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num); + (Class **)ckalloc(sizeof(Class *) * clsPtr->superclasses.num); } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); cls2Ptr->superclasses.num = clsPtr->superclasses.num; FOREACH(superPtr, cls2Ptr->superclasses) { @@ -2113,11 +2123,11 @@ if (cls2Ptr->mixins.num != 0) { FOREACH(mixinPtr, cls2Ptr->mixins) { TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - Tcl_Free(clsPtr->mixins.list); + ckfree(clsPtr->mixins.list); } DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *); FOREACH(mixinPtr, cls2Ptr->mixins) { TclOOAddToMixinSubs(cls2Ptr, mixinPtr); @@ -2356,11 +2366,11 @@ if (clsPtr->metadataPtr == NULL) { if (metadata == NULL) { return; } - clsPtr->metadataPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + clsPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS); } /* * If the metadata is NULL, we're deleting the metadata for the type. @@ -2436,11 +2446,11 @@ if (oPtr->metadataPtr == NULL) { if (metadata == NULL) { return; } - oPtr->metadataPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS); } /* * If the metadata is NULL, we're deleting the metadata for the type. @@ -2495,11 +2505,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD, + return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD, NULL); } int TclOOPrivateObjectCmd( @@ -2516,11 +2526,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL); + return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL); } int TclOOInvokeObject( Tcl_Interp *interp, /* Interpreter for commands, variables, @@ -2577,11 +2587,11 @@ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { - Object *oPtr = clientData; + Object *oPtr = (Object *)clientData; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?"); return TCL_ERROR; } @@ -2636,11 +2646,11 @@ * Determine if we're in a context that can see the extra, private methods * in this class. */ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) { - CallContext *callerContextPtr = framePtr->clientData; + CallContext *callerContextPtr = (CallContext *)framePtr->clientData; Method *callerMethodPtr = callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr; if (callerMethodPtr->declaringObjectPtr) { callerObjPtr = callerMethodPtr->declaringObjectPtr; @@ -2654,11 +2664,11 @@ * Give plugged in code a chance to remap the method name. */ methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { - register Class **startClsPtr = &startCls; + Class **startClsPtr = &startCls; Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr); result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr, (Tcl_Class *) startClsPtr, mappedMethodName); if (result != TCL_OK) { @@ -2713,11 +2723,11 @@ */ if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { - register struct MInvoke *miPtr = + struct MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index]; if (miPtr->isFilter) { continue; } @@ -2745,19 +2755,19 @@ } static int FinalizeObjectCall( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { /* * Dispose of the call chain, which drops the lock on the object's * structure. */ - TclOODeleteContext(data[0]); + TclOODeleteContext((CallContext *)data[0]); return result; } /* * ---------------------------------------------------------------------- @@ -2851,11 +2861,11 @@ Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { - register CallContext *contextPtr = (CallContext *) context; + CallContext *contextPtr = (CallContext *) context; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting @@ -2906,14 +2916,14 @@ } static int FinalizeNext( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { - CallContext *contextPtr = data[0]; + CallContext *contextPtr = (CallContext *)data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ @@ -2950,11 +2960,11 @@ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) { goto notAnObject; } } - return cmdPtr->objClientData; + return (Tcl_Object)cmdPtr->objClientData; notAnObject: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s does not refer to an object", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr), Index: generic/tclOO.decls ================================================================== --- generic/tclOO.decls +++ generic/tclOO.decls @@ -49,24 +49,24 @@ declare 8 { int Tcl_MethodIsPublic(Tcl_Method method) } declare 9 { int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - void **clientDataPtr) + ClientData *clientDataPtr) } declare 10 { Tcl_Obj *Tcl_MethodName(Tcl_Method method) } declare 11 { Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - void *clientData) + ClientData clientData) } declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - void *clientData) + ClientData clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip) @@ -85,24 +85,24 @@ } declare 18 { int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { - void *Tcl_ClassGetMetadata(Tcl_Class clazz, + ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) } declare 20 { void Tcl_ClassSetMetadata(Tcl_Class clazz, - const Tcl_ObjectMetadataType *typePtr, void *metadata) + const Tcl_ObjectMetadataType *typePtr, ClientData metadata) } declare 21 { - void *Tcl_ObjectGetMetadata(Tcl_Object object, + ClientData Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) } declare 22 { void Tcl_ObjectSetMetadata(Tcl_Object object, - const Tcl_ObjectMetadataType *typePtr, void *metadata) + const Tcl_ObjectMetadataType *typePtr, ClientData metadata) } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) @@ -142,18 +142,18 @@ Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp) } declare 1 { Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - const Tcl_MethodType *typePtr, void *clientData, + const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr) } declare 2 { Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - void *clientData, Proc **procPtrPtr) + ClientData clientData, Proc **procPtrPtr) } declare 3 { Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr) @@ -180,17 +180,17 @@ } declare 9 { Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, - void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, + ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 10 { Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, + ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 11 { int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Index: generic/tclOO.h ================================================================== --- generic/tclOO.h +++ generic/tclOO.h @@ -58,16 +58,16 @@ * Public datatypes for callbacks and structures used in the TIP#257 (OO) * implementation. These are used to implement custom types of method calls * and to allow the attachment of arbitrary data to objects and classes. */ -typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, +typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); -typedef void (Tcl_MethodDeleteProc)(void *clientData); -typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, - void **newClientData); -typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData); +typedef void (Tcl_MethodDeleteProc)(ClientData clientData); +typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData, + ClientData *newClientData); +typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData); typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); /* * The type of a method implementation. This describes how to call the method @@ -93,11 +93,11 @@ } Tcl_MethodType; /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking - * binary compatibility. + * binary compatability. */ #define TCL_OO_METHOD_VERSION_CURRENT 1 /* @@ -129,11 +129,11 @@ } Tcl_ObjectMetadataType; /* * The correct value for the version field of the Tcl_ObjectMetadataType * structure. This allows new versions of the structure to be introduced - * without breaking binary compatibility. + * without breaking binary compatability. */ #define TCL_OO_METADATA_VERSION_CURRENT 1 /* Index: generic/tclOOBasic.c ================================================================== --- generic/tclOOBasic.c +++ generic/tclOOBasic.c @@ -53,11 +53,11 @@ FinalizeConstruction( ClientData data[], Tcl_Interp *interp, int result) { - Object *oPtr = data[0]; + Object *oPtr = (Object *)data[0]; if (result != TCL_OK) { return result; } Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr)); @@ -74,11 +74,11 @@ * ---------------------------------------------------------------------- */ int TclOO_Class_Constructor( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -106,11 +106,11 @@ /* * Delegate to [oo::define] to do the work. */ - invoke = Tcl_Alloc(3 * sizeof(Tcl_Obj *)); + invoke = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *)); invoke[0] = oPtr->fPtr->defineName; invoke[1] = TclOOObjectName(interp, oPtr); invoke[2] = objv[objc-1]; /* @@ -136,12 +136,12 @@ DecrRefsPostClassConstructor( ClientData data[], Tcl_Interp *interp, int result) { - Tcl_Obj **invoke = data[0]; - Object *oPtr = data[1]; + Tcl_Obj **invoke = (Tcl_Obj **)data[0]; + Object *oPtr = (Object *)data[1]; Tcl_InterpState saved; int code; TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); @@ -152,11 +152,11 @@ Tcl_IncrRefCount(invoke[1]); saved = Tcl_SaveInterpState(interp, result); code = Tcl_EvalObjv(interp, 2, invoke, 0); TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); - Tcl_Free(invoke); + ckfree(invoke); if (code != TCL_OK) { Tcl_DiscardInterpState(saved); return code; } return Tcl_RestoreInterpState(interp, saved); @@ -172,20 +172,20 @@ * ---------------------------------------------------------------------- */ int TclOO_Class_Create( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName; - size_t len; + int len; /* * Sanity check; should not be possible to invoke this method on a * non-class. */ @@ -206,11 +206,11 @@ if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName ?arg ...?"); return TCL_ERROR; } - objName = TclGetStringFromObj( + objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); @@ -237,20 +237,20 @@ * ---------------------------------------------------------------------- */ int TclOO_Class_CreateNs( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName, *nsName; - size_t len; + int len; /* * Sanity check; should not be possible to invoke this method on a * non-class. */ @@ -271,19 +271,19 @@ if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName namespaceName ?arg ...?"); return TCL_ERROR; } - objName = TclGetStringFromObj( + objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } - nsName = TclGetStringFromObj( + nsName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "namespace name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); @@ -310,11 +310,11 @@ * ---------------------------------------------------------------------- */ int TclOO_Class_New( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ @@ -354,11 +354,11 @@ * ---------------------------------------------------------------------- */ int TclOO_Object_Destroy( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ @@ -394,11 +394,11 @@ AfterNRDestructor( ClientData data[], Tcl_Interp *interp, int result) { - CallContext *contextPtr = data[0]; + CallContext *contextPtr = (CallContext *)data[0]; if (contextPtr->oPtr->command) { Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command); } TclOODeleteContext(contextPtr); @@ -415,20 +415,20 @@ * ---------------------------------------------------------------------- */ int TclOO_Object_Eval( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); - register const int skip = Tcl_ObjectContextSkippedArgs(context); + const int skip = Tcl_ObjectContextSkippedArgs(context); CallFrame *framePtr, **framePtrPtr = &framePtr; Tcl_Obj *scriptPtr; CmdFrame *invoker; if (objc-1 < skip) { @@ -481,11 +481,11 @@ ClientData data[], Tcl_Interp *interp, int result) { if (result == TCL_ERROR) { - Object *oPtr = data[0]; + Object *oPtr = (Object *)data[0]; const char *namePtr; if (oPtr) { namePtr = TclGetString(TclOOObjectName(interp, oPtr)); } else { @@ -516,11 +516,11 @@ * ---------------------------------------------------------------------- */ int TclOO_Object_Unknown( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ @@ -549,11 +549,11 @@ * Determine if the calling context should know about extra private * methods, and if so, which. */ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) { - CallContext *callerContext = framePtr->clientData; + CallContext *callerContext = (CallContext *)framePtr->clientData; Method *mPtr = callerContext->callPtr->chain[ callerContext->index].mPtr; if (mPtr->declaringObjectPtr) { if (oPtr == mPtr->declaringObjectPtr) { @@ -603,11 +603,11 @@ } if (i) { Tcl_AppendToObj(errorMsg, " or ", -1); } Tcl_AppendToObj(errorMsg, methodNames[i], -1); - Tcl_Free((void *)methodNames); + ckfree(methodNames); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[skip]), NULL); return TCL_ERROR; } @@ -622,11 +622,11 @@ * ---------------------------------------------------------------------- */ int TclOO_Object_LinkVar( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ @@ -724,11 +724,11 @@ * ---------------------------------------------------------------------- */ int TclOO_Object_VarName( - ClientData clientData, /* Ignored. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ @@ -742,11 +742,11 @@ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "varName"); return TCL_ERROR; } argPtr = objv[objc-1]; - arg = TclGetString(argPtr); + arg = Tcl_GetString(argPtr); /* * Convert the variable name to fully-qualified form if it wasn't already. * This has to be done prior to lookup because we can run into problems * with resolvers otherwise. [Bug 3603695] @@ -771,20 +771,20 @@ * current object is an instance of that class. */ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); - CallContext *callerContext = framePtr->clientData; + CallContext *callerContext = (CallContext *)framePtr->clientData; Method *mPtr = callerContext->callPtr->chain[ callerContext->index].mPtr; PrivateVariableMapping *pvPtr; int i; if (mPtr->declaringObjectPtr == oPtr) { FOREACH_STRUCT(pvPtr, oPtr->privateVariables) { - if (!strcmp(TclGetString(pvPtr->variableObj), - TclGetString(argPtr))) { + if (!strcmp(Tcl_GetString(pvPtr->variableObj), + Tcl_GetString(argPtr))) { argPtr = pvPtr->fullNameObj; break; } } } else if (mPtr->declaringClassPtr && @@ -801,12 +801,12 @@ } } } if (isInstance) { FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) { - if (!strcmp(TclGetString(pvPtr->variableObj), - TclGetString(argPtr))) { + if (!strcmp(Tcl_GetString(pvPtr->variableObj), + Tcl_GetString(argPtr))) { argPtr = pvPtr->fullNameObj; break; } } } @@ -862,11 +862,11 @@ * ---------------------------------------------------------------------- */ int TclOONextObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -884,11 +884,11 @@ "%s may only be called from inside a method", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } - context = framePtr->clientData; + context = (Tcl_ObjectContext)framePtr->clientData; /* * Invoke the (advanced) method call context in the caller context. Note * that this is like [uplevel 1] and not [eval]. */ @@ -898,11 +898,11 @@ return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } int TclOONextToObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -924,11 +924,11 @@ "%s may only be called from inside a method", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } - contextPtr = framePtr->clientData; + contextPtr = (CallContext *)framePtr->clientData; /* * Sanity check the arguments; we need the first one to refer to a class. */ @@ -1009,13 +1009,13 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - CallContext *contextPtr = data[1]; + CallContext *contextPtr = (CallContext *)data[1]; - iPtr->varFramePtr = data[0]; + iPtr->varFramePtr = (CallFrame *)data[0]; if (contextPtr != NULL) { contextPtr->index = PTR2INT(data[2]); } return result; } @@ -1031,11 +1031,11 @@ * ---------------------------------------------------------------------- */ int TclOOSelfObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { static const char *const subcmds[] = { @@ -1065,11 +1065,11 @@ TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } - contextPtr = framePtr->clientData; + contextPtr = (CallContext*)framePtr->clientData; /* * Now we do "conventional" argument parsing for a while. Note that no * subcommand takes arguments. */ @@ -1120,11 +1120,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { - register struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); + struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; const char *type; if (miPtr->filterDeclarer != NULL) { oPtr = miPtr->filterDeclarer->thisPtr; @@ -1146,11 +1146,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "caller is not an object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } else { - CallContext *callerPtr = framePtr->callerVarPtr->clientData; + CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData; Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr; Object *declarerPtr; if (mPtr->declaringClassPtr != NULL) { declarerPtr = mPtr->declaringClassPtr->thisPtr; @@ -1268,11 +1268,11 @@ * ---------------------------------------------------------------------- */ int TclOOCopyObjectCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Object oPtr, o2Ptr; Index: generic/tclOOCall.c ================================================================== --- generic/tclOOCall.c +++ generic/tclOOCall.c @@ -166,11 +166,11 @@ void TclOODeleteContext( CallContext *contextPtr) { - register Object *oPtr = contextPtr->oPtr; + Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); @@ -203,11 +203,11 @@ if (callPtr) { TclOODeleteChain(callPtr); } } Tcl_DeleteHashTable(tablePtr); - Tcl_Free(tablePtr); + ckfree(tablePtr); } /* * ---------------------------------------------------------------------- * @@ -224,13 +224,13 @@ { if (callPtr == NULL || callPtr->refCount-- > 1) { return; } if (callPtr->chain != callPtr->staticChain) { - Tcl_Free(callPtr->chain); + ckfree(callPtr->chain); } - Tcl_Free(callPtr); + ckfree(callPtr); } /* * ---------------------------------------------------------------------- * @@ -278,19 +278,19 @@ DupMethodNameRep( Tcl_Obj *srcPtr, Tcl_Obj *dstPtr) { StashCallChain(dstPtr, - TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); + (CallChain *)TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); } static void FreeMethodNameRep( Tcl_Obj *objPtr) { TclOODeleteChain( - TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1); + (CallChain *)TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1); } /* * ---------------------------------------------------------------------- * @@ -312,11 +312,11 @@ * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { - register CallContext *const contextPtr = clientData; + CallContext *const contextPtr = (CallContext *)clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; /* @@ -374,38 +374,38 @@ } static int SetFilterFlags( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { - CallContext *contextPtr = data[0]; + CallContext *contextPtr = (CallContext *)data[0]; contextPtr->oPtr->flags |= FILTER_HANDLING; return result; } static int ResetFilterFlags( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { - CallContext *contextPtr = data[0]; + CallContext *contextPtr = (CallContext *)data[0]; contextPtr->oPtr->flags &= ~FILTER_HANDLING; return result; } static int FinalizeMethodRefs( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { - CallContext *contextPtr = data[0]; + CallContext *contextPtr = (CallContext *)data[0]; int i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); } @@ -587,17 +587,17 @@ * circumstances. */ int flags, /* Whether we are looking for unexported * methods. Full private methods are handled * on insertion to the table. */ const char ***stringsPtr) /* Where to store the sorted list of strings - * that we produce. Tcl_Alloced() */ + * that we produce. ckalloced() */ { const char **strings; FOREACH_HASH_DECLS; Tcl_Obj *namePtr; void *isWanted; - size_t i = 0; + int i = 0; /* * See how many (visible) method names there are. If none, we do not (and * should not) try to sort the list of them. */ @@ -611,11 +611,11 @@ * We need to build the list of methods to sort. We will be using qsort() * for this, because it is very unlikely that the list will be heavily * sorted when it is long enough to matter. */ - strings = Tcl_Alloc(sizeof(char *) * namesPtr->numEntries); + strings = (const char **)ckalloc(sizeof(char *) * namesPtr->numEntries); FOREACH_HASH(namePtr, isWanted, namesPtr) { if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) { if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { continue; } @@ -633,11 +633,11 @@ if (i > 1) { qsort((void *) strings, i, sizeof(char *), CmpStr); } *stringsPtr = strings; } else { - Tcl_Free((void *)strings); + ckfree(strings); *stringsPtr = NULL; } return i; } @@ -833,11 +833,11 @@ int donePrivate = 0; if (oPtr->methodsPtr) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName); if (hPtr != NULL) { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags); donePrivate = 1; } } @@ -883,11 +883,11 @@ if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj); if (hPtr != NULL) { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (WANT_PUBLIC(flags)) { if (!IS_PUBLIC(mPtr)) { blockedUnexported = 1; } else { @@ -913,11 +913,11 @@ flags | TRAVERSED_MIXIN, filterDecl); } if (oPtr->methodsPtr && !blockedUnexported) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); if (hPtr != NULL) { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); } } @@ -966,11 +966,11 @@ * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { - register CallChain *callPtr = cbPtr->callChainPtr; + CallChain *callPtr = cbPtr->callChainPtr; int i; /* * Return if this is just an entry used to record whether this is a public * method. If so, there's nothing real to call and so nothing to add to @@ -1035,15 +1035,15 @@ * realloc-ing if the chain gets long. */ if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { callPtr->chain = - Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); + (struct MInvoke *)ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); memcpy(callPtr->chain, callPtr->staticChain, sizeof(struct MInvoke) * callPtr->numChain); } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) { - callPtr->chain = Tcl_Realloc(callPtr->chain, + callPtr->chain = (struct MInvoke *)ckrealloc(callPtr->chain, sizeof(struct MInvoke) * (callPtr->numChain + 1)); } callPtr->chain[i].mPtr = mPtr; callPtr->chain[i].isFilter = (doneFilters != NULL); callPtr->chain[i].filterDeclarer = filterDecl; @@ -1191,11 +1191,11 @@ const Tcl_ObjIntRep *irPtr; const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) { - callPtr = irPtr->twoPtrValue.ptr1; + callPtr = (CallChain *)irPtr->twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL); @@ -1216,11 +1216,11 @@ hPtr = NULL; } } if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { - callPtr = Tcl_GetHashValue(hPtr); + callPtr = (CallChain *)Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_SetHashValue(hPtr, NULL); @@ -1228,11 +1228,11 @@ } doFilters = 1; } - callPtr = Tcl_Alloc(sizeof(CallChain)); + callPtr = (CallChain *)ckalloc(sizeof(CallChain)); InitCallChain(callPtr, oPtr, flags); cb.callChainPtr = callPtr; cb.filterLength = 0; cb.oPtr = oPtr; @@ -1246,11 +1246,11 @@ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = 0; + callPtr->epoch = -1; if (callPtr->numChain == 0) { TclOODeleteChain(callPtr); return NULL; } goto returnContext; @@ -1323,29 +1323,29 @@ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = 0; + callPtr->epoch = -1; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else if (doFilters && !donePrivate) { if (hPtr == NULL) { if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { oPtr->selfCls->classChainCache = - Tcl_Alloc(sizeof(Tcl_HashTable)); + (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); } hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache, (char *) methodNameObj, &i); } else { if (oPtr->chainCache == NULL) { - oPtr->chainCache = Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->chainCache); } hPtr = Tcl_CreateHashEntry(oPtr->chainCache, (char *) methodNameObj, &i); @@ -1367,11 +1367,11 @@ oPtr->selfCls->destructorChainPtr = callPtr; callPtr->refCount++; } returnContext: - contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); + contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; /* * Corresponding TclOODecrRefCount() in TclOODeleteContext */ @@ -1436,11 +1436,11 @@ hPtr = Tcl_FindHashEntry(clsPtr->classChainCache, (char *) methodNameObj); if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); - callPtr = Tcl_GetHashValue(hPtr); + callPtr = (CallChain *)Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, &obj, flags, reuseMask)) { callPtr->refCount++; return callPtr; } Tcl_SetHashValue(hPtr, NULL); @@ -1448,11 +1448,11 @@ } } else { hPtr = NULL; } - callPtr = Tcl_Alloc(sizeof(CallChain)); + callPtr = (CallChain *)ckalloc(sizeof(CallChain)); memset(callPtr, 0, sizeof(CallChain)); callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING); callPtr->epoch = fPtr->epoch; callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount; callPtr->objectEpoch = clsPtr->thisPtr->epoch; @@ -1495,19 +1495,19 @@ AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = 0; + callPtr->epoch = -1; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else { if (hPtr == NULL) { if (clsPtr->classChainCache == NULL) { - clsPtr->classChainCache = Tcl_Alloc(sizeof(Tcl_HashTable)); + clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(clsPtr->classChainCache); } hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, (char *) methodNameObj, &i); } @@ -1651,14 +1651,14 @@ } } if (classPtr == contextCls) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, - (char *) methodName); + methodName); if (hPtr != NULL) { - register Method *mPtr = Tcl_GetHashValue(hPtr); + Method *mPtr = (Method *)Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); return 1; @@ -1675,10 +1675,11 @@ if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, methodName, cbPtr, doneFilters, flags, filterDecl)) { return 1; } } + /* FALLTHRU */ case 0: return 0; } } @@ -1738,11 +1739,11 @@ if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; } if (hPtr != NULL) { - register Method *mPtr = Tcl_GetHashValue(hPtr); + Method *mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (!(flags & KNOWN_STATE)) { if (flags & PUBLIC_METHOD) { if (!IS_PUBLIC(mPtr)) { @@ -1766,10 +1767,11 @@ default: FOREACH(superPtr, classPtr->superclasses) { privateDanger |= AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } + /* FALLTHRU */ case 0: return privateDanger; } } @@ -1817,11 +1819,11 @@ * the method in question (which differs for "unknown" and "filter" types) * and the third word is the full name of the class that declares the * method (or "object" if it is declared on the instance). */ - objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); for (i = 0 ; i < callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; descObjs[0] = miPtr->isFilter ? filterLiteral : @@ -1920,11 +1922,11 @@ break; } Tcl_ResetResult(interp); } if (define.list != staticSpace) { - Tcl_Free(define.list); + ckfree(define.list); } return nsPtr; } /* @@ -2085,15 +2087,15 @@ definePtr->size *= 2; if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) { DefineEntry *staticList = definePtr->list; definePtr->list = - Tcl_Alloc(sizeof(DefineEntry) * definePtr->size); + (DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size); memcpy(definePtr->list, staticList, sizeof(DefineEntry) * definePtr->num); } else { - definePtr->list = Tcl_Realloc(definePtr->list, + definePtr->list = (DefineEntry *)ckrealloc(definePtr->list, sizeof(DefineEntry) * definePtr->size); } } definePtr->list[i].definerCls = definerCls; definePtr->list[i].namespaceName = namespaceName; Index: generic/tclOODecls.h ================================================================== --- generic/tclOODecls.h +++ generic/tclOODecls.h @@ -51,23 +51,23 @@ /* 8 */ TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - void **clientDataPtr); + ClientData *clientDataPtr); /* 10 */ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - void *clientData); + ClientData clientData); /* 12 */ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - void *clientData); + ClientData clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); @@ -82,23 +82,23 @@ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, +TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, - void *metadata); + ClientData metadata); /* 21 */ -TCLAPI void * Tcl_ObjectGetMetadata(Tcl_Object object, +TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, - void *metadata); + ClientData metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 24 */ @@ -134,24 +134,24 @@ Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */ Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */ Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ - int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ + int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ - Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ - Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ + Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */ + Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ - void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ - void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ - void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ - void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ + ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ + void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */ + ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ + void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */ int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ Index: generic/tclOODefineCmds.c ================================================================== --- generic/tclOODefineCmds.c +++ generic/tclOODefineCmds.c @@ -265,11 +265,11 @@ if (numFilters == 0) { /* * No list of filters was supplied, so we're deleting filters. */ - Tcl_Free(oPtr->filters.list); + ckfree(oPtr->filters.list); oPtr->filters.list = NULL; oPtr->filters.num = 0; RecomputeClassCacheFlag(oPtr); } else { /* @@ -278,13 +278,13 @@ Tcl_Obj **filtersList; int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (oPtr->filters.num == 0) { - filtersList = Tcl_Alloc(size); + filtersList = (Tcl_Obj **)ckalloc(size); } else { - filtersList = Tcl_Realloc(oPtr->filters.list, size); + filtersList = (Tcl_Obj **)ckrealloc(oPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; Tcl_IncrRefCount(filters[i]); } @@ -325,11 +325,11 @@ if (numFilters == 0) { /* * No list of filters was supplied, so we're deleting filters. */ - Tcl_Free(classPtr->filters.list); + ckfree(classPtr->filters.list); classPtr->filters.list = NULL; classPtr->filters.num = 0; } else { /* * We've got a list of filters, so we're creating filters. @@ -337,13 +337,13 @@ Tcl_Obj **filtersList; int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (classPtr->filters.num == 0) { - filtersList = Tcl_Alloc(size); + filtersList = (Tcl_Obj **)ckalloc(size); } else { - filtersList = Tcl_Realloc(classPtr->filters.list, size); + filtersList = (Tcl_Obj **)ckrealloc(classPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; Tcl_IncrRefCount(filters[i]); } @@ -381,11 +381,11 @@ if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - Tcl_Free(oPtr->mixins.list); + ckfree(oPtr->mixins.list); oPtr->mixins.num = 0; } RecomputeClassCacheFlag(oPtr); } else { if (oPtr->mixins.num != 0) { @@ -393,14 +393,14 @@ if (mixinPtr && mixinPtr != oPtr->selfCls) { TclOORemoveFromInstances(oPtr, mixinPtr); } TclOODecrRefCount(mixinPtr->thisPtr); } - oPtr->mixins.list = Tcl_Realloc(oPtr->mixins.list, + oPtr->mixins.list = (Class **)ckrealloc(oPtr->mixins.list, sizeof(Class *) * numMixins); } else { - oPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins); + oPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins); oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, oPtr->mixins) { @@ -442,23 +442,23 @@ if (classPtr->mixins.num != 0) { FOREACH(mixinPtr, classPtr->mixins) { TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - Tcl_Free(classPtr->mixins.list); + ckfree(classPtr->mixins.list); classPtr->mixins.num = 0; } } else { if (classPtr->mixins.num != 0) { FOREACH(mixinPtr, classPtr->mixins) { TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - classPtr->mixins.list = Tcl_Realloc(classPtr->mixins.list, + classPtr->mixins.list = (Class **)ckrealloc(classPtr->mixins.list, sizeof(Class *) * numMixins); } else { - classPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins); + classPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); @@ -498,15 +498,15 @@ FOREACH(variableObj, *vnlPtr) { Tcl_DecrRefCount(variableObj); } if (i != varc) { if (varc == 0) { - Tcl_Free(vnlPtr->list); + ckfree(vnlPtr->list); } else if (i) { - vnlPtr->list = Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc); + vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc); } else { - vnlPtr->list = Tcl_Alloc(sizeof(Tcl_Obj *) * varc); + vnlPtr->list = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * varc); } } vnlPtr->num = 0; if (varc > 0) { Tcl_InitObjHashTable(&uniqueTable); @@ -523,11 +523,11 @@ /* * Shouldn't be necessary, but maintain num/list invariant. */ if (n != varc) { - vnlPtr->list = Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n); + vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n); } Tcl_DeleteHashTable(&uniqueTable); } } @@ -549,16 +549,16 @@ Tcl_DecrRefCount(privatePtr->variableObj); Tcl_DecrRefCount(privatePtr->fullNameObj); } if (i != varc) { if (varc == 0) { - Tcl_Free(pvlPtr->list); + ckfree(pvlPtr->list); } else if (i) { - pvlPtr->list = Tcl_Realloc(pvlPtr->list, + pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list, sizeof(PrivateVariableMapping) * varc); } else { - pvlPtr->list = Tcl_Alloc(sizeof(PrivateVariableMapping) * varc); + pvlPtr->list = (PrivateVariableMapping *)ckalloc(sizeof(PrivateVariableMapping) * varc); } } pvlPtr->num = 0; if (varc > 0) { @@ -568,11 +568,11 @@ if (created) { privatePtr = &(pvlPtr->list[n++]); privatePtr->variableObj = varv[i]; privatePtr->fullNameObj = Tcl_ObjPrintf( PRIVATE_VARIABLE_PATTERN, - creationEpoch, TclGetString(varv[i])); + creationEpoch, Tcl_GetString(varv[i])); Tcl_IncrRefCount(privatePtr->fullNameObj); } else { Tcl_DecrRefCount(varv[i]); } } @@ -581,11 +581,11 @@ /* * Shouldn't be necessary, but maintain num/list invariant. */ if (n != varc) { - pvlPtr->list = Tcl_Realloc(pvlPtr->list, + pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list, sizeof(PrivateVariableMapping) * n); } Tcl_DeleteHashTable(&uniqueTable); } } @@ -662,11 +662,11 @@ /* * Complete the splicing by changing the method's name. */ - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (toPtr) { Tcl_IncrRefCount(toPtr); Tcl_DecrRefCount(mPtr->namePtr); mPtr->namePtr = toPtr; Tcl_SetHashValue(newHPtr, mPtr); @@ -693,19 +693,19 @@ * ---------------------------------------------------------------------- */ int TclOOUnknownDefinition( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_HashSearch search; Tcl_HashEntry *hPtr; - size_t soughtLen; + int soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad call of unknown handler", -1)); @@ -720,11 +720,11 @@ if (soughtLen == 0) { goto noMatch; } hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (hPtr != NULL) { - const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); + const char *nameStr = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr); if (strncmp(soughtStr, nameStr, soughtLen) == 0) { if (matchedStr != NULL) { goto noMatch; } @@ -736,11 +736,11 @@ if (matchedStr != NULL) { /* * Got one match, and only one match! */ - Tcl_Obj **newObjv = + Tcl_Obj **newObjv = (Tcl_Obj **) TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1)); int result; newObjv[0] = Tcl_NewStringObj(matchedStr, -1); Tcl_IncrRefCount(newObjv[0]); @@ -775,13 +775,13 @@ FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { - size_t length; + int length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); - register Namespace *const nsPtr = (Namespace *) namespacePtr; + Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; /* * If someone is playing games, we stop playing right now. @@ -888,11 +888,11 @@ "this command may only be called from within the context of" " an ::oo::define or ::oo::objdefine command", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } - object = iPtr->varFramePtr->clientData; + object = (Tcl_Object)iPtr->varFramePtr->clientData; if (Tcl_ObjectDeleted(object)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command cannot be called when the object has been" " deleted", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); @@ -994,20 +994,20 @@ * could have been renamed... */ const char *typeOfSubject) /* Part of the message, saying whether it was * an object, class or class-as-object that * was being configured. */ { - size_t length; + int length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); const char *objName = TclGetStringFromObj(realNameObj, &length); - unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; + int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in definition script for %s \"%.*s%s\" line %d)", - typeOfSubject, (overflow ? limit : (unsigned)length), objName, + typeOfSubject, (overflow ? limit : length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* * ---------------------------------------------------------------------- @@ -1090,11 +1090,11 @@ * ---------------------------------------------------------------------- */ int TclOODefineObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Namespace *nsPtr; @@ -1166,11 +1166,11 @@ * ---------------------------------------------------------------------- */ int TclOOObjDefObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Namespace *nsPtr; @@ -1235,18 +1235,18 @@ * ---------------------------------------------------------------------- */ int TclOODefineSelfObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Namespace *nsPtr; Object *oPtr; - int result, private; + int result, isPrivate; oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } @@ -1254,11 +1254,11 @@ if (objc < 2) { Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr)); return TCL_OK; } - private = IsPrivateDefine(interp); + isPrivate = IsPrivateDefine(interp); /* * Make the oo::objdefine namespace the current namespace and evaluate the * command(s). */ @@ -1265,11 +1265,11 @@ nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0); if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) { return TCL_ERROR; } - if (private) { + if (isPrivate) { ((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME; } AddRef(oPtr); if (objc == 2) { @@ -1306,11 +1306,11 @@ * ---------------------------------------------------------------------- */ int TclOODefineObjSelfObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; @@ -1413,11 +1413,11 @@ * ---------------------------------------------------------------------- */ int TclOODefineClassObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; @@ -1494,12 +1494,12 @@ oPtr->fPtr->epoch++; oPtr->flags |= DONT_DELETE; TclOODeleteDescendants(interp, oPtr); oPtr->flags &= ~DONT_DELETE; TclOOReleaseClassContents(interp, oPtr); - Tcl_Free(oPtr->classPtr); - oPtr->classPtr = NULL; + ckfree(oPtr->classPtr); + oPtr->classPtr = NULL; } else if (!wasClass && willBeClass) { TclOOAllocClass(interp, oPtr); } if (oPtr->classPtr != NULL) { @@ -1522,19 +1522,19 @@ * ---------------------------------------------------------------------- */ int TclOODefineConstructorObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; Tcl_Method method; - size_t bodyLength; + int bodyLength; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arguments body"); return TCL_ERROR; } @@ -1548,11 +1548,11 @@ if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; - (void)TclGetStringFromObj(objv[2], &bodyLength); + TclGetStringFromObj(objv[2], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. */ @@ -1591,11 +1591,11 @@ * ---------------------------------------------------------------------- */ int TclOODefineDefnNsObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { static const char *kindList[] = { @@ -1636,11 +1636,11 @@ } if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[1], kindList, "kind", 0, &kind) != TCL_OK) { return TCL_ERROR; } - if (!TclGetString(objv[objc - 1])[0]) { + if (!Tcl_GetString(objv[objc - 1])[0]) { nsNamePtr = NULL; } else { nsPtr = GetNamespaceInOuterContext(interp, objv[objc - 1]); if (nsPtr == NULL) { return TCL_ERROR; @@ -1733,19 +1733,19 @@ * ---------------------------------------------------------------------- */ int TclOODefineDestructorObjCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; Tcl_Method method; - size_t bodyLength; + int bodyLength; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "body"); return TCL_ERROR; } @@ -1754,11 +1754,11 @@ if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; - (void)TclGetStringFromObj(objv[1], &bodyLength); + TclGetStringFromObj(objv[1], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. */ @@ -1839,11 +1839,11 @@ * their flags member. */ if (isInstanceExport) { if (!oPtr->methodsPtr) { - oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i], &isNew); @@ -1851,18 +1851,18 @@ hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], &isNew); } if (isNew) { - mPtr = Tcl_Alloc(sizeof(Method)); + mPtr = (Method *)ckalloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; Tcl_IncrRefCount(objv[i]); Tcl_SetHashValue(hPtr, mPtr); } else { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); } if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) { mPtr->flags |= PUBLIC_METHOD; mPtr->flags &= ~TRUE_PRIVATE_METHOD; changed = 1; @@ -2152,11 +2152,11 @@ * their flags member. */ if (isInstanceUnexport) { if (!oPtr->methodsPtr) { - oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i], &isNew); @@ -2164,18 +2164,18 @@ hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], &isNew); } if (isNew) { - mPtr = Tcl_Alloc(sizeof(Method)); + mPtr = (Method *)ckalloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; Tcl_IncrRefCount(objv[i]); Tcl_SetHashValue(hPtr, mPtr); } else { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); } if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) { mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD); changed = 1; } @@ -2312,11 +2312,11 @@ * ---------------------------------------------------------------------- */ static int ClassFilterGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2346,11 +2346,11 @@ return TCL_OK; } static int ClassFilterSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2392,11 +2392,11 @@ * ---------------------------------------------------------------------- */ static int ClassMixinGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2429,11 +2429,11 @@ } static int ClassMixinSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2459,11 +2459,11 @@ } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } - mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); + mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { @@ -2498,11 +2498,11 @@ * ---------------------------------------------------------------------- */ static int ClassSuperGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2534,11 +2534,11 @@ return TCL_OK; } static int ClassSuperSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2573,21 +2573,21 @@ /* * Allocate some working space. */ - superclasses = (Class **) Tcl_Alloc(sizeof(Class *) * superc); + superclasses = (Class **) ckalloc(sizeof(Class *) * superc); /* * Parse the arguments to get the class to use as superclasses. * * Note that zero classes is special, as it is equivalent to just the * class of objects. [Bug 9d61624b3d] */ if (superc == 0) { - superclasses = Tcl_Realloc(superclasses, sizeof(Class *)); + superclasses = (Class **)ckrealloc(superclasses, sizeof(Class *)); if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; } else { superclasses[0] = oPtr->fPtr->objectCls; } @@ -2596,11 +2596,10 @@ } else { for (i = 0; i < superc; i++) { superclasses[i] = GetClassInOuterContext(interp, superv[i], "only a class can be a superclass"); if (superclasses[i] == NULL) { - i--; goto failedAfterAlloc; } for (j = 0; j < i; j++) { if (superclasses[j] == superclasses[i]) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -2613,14 +2612,14 @@ if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to form circular dependency graph", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); failedAfterAlloc: - for (; i > 0; i--) { + for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); } - Tcl_Free(superclasses); + ckfree(superclasses); return TCL_ERROR; } /* * Corresponding TclOODecrRefCount() is near the end of this @@ -2641,11 +2640,11 @@ if (oPtr->classPtr->superclasses.num != 0) { FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOORemoveFromSubclasses(oPtr->classPtr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } - Tcl_Free(oPtr->classPtr->superclasses.list); + ckfree(oPtr->classPtr->superclasses.list); } oPtr->classPtr->superclasses.list = superclasses; oPtr->classPtr->superclasses.num = superc; FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOOAddToSubclasses(oPtr->classPtr, superPtr); @@ -2666,11 +2665,11 @@ * ---------------------------------------------------------------------- */ static int ClassVarsGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2710,11 +2709,11 @@ return TCL_OK; } static int ClassVarsSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2781,11 +2780,11 @@ * ---------------------------------------------------------------------- */ static int ObjFilterGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2809,11 +2808,11 @@ return TCL_OK; } static int ObjFilterSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2849,11 +2848,11 @@ * ---------------------------------------------------------------------- */ static int ObjMixinGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2881,11 +2880,11 @@ return TCL_OK; } static int ObjMixinSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2906,11 +2905,11 @@ if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } - mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); + mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { @@ -2935,11 +2934,11 @@ * ---------------------------------------------------------------------- */ static int ObjVarsGet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -2973,11 +2972,11 @@ return TCL_OK; } static int ObjVarsSet( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { @@ -3038,11 +3037,11 @@ * ---------------------------------------------------------------------- */ static int ResolveClass( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Index: generic/tclOOInfo.c ================================================================== --- generic/tclOOInfo.c +++ generic/tclOOInfo.c @@ -169,11 +169,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectClassCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -226,11 +226,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectDefnCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -259,11 +259,11 @@ "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } - procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); + procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); @@ -283,11 +283,11 @@ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } - resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr)); + resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr)); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } /* @@ -300,11 +300,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectFiltersCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int i; @@ -339,11 +339,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectForwardCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -370,11 +370,11 @@ "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } - prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr)); + prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", @@ -396,11 +396,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectIsACmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const categories[] = { @@ -515,11 +515,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectMethodsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -610,11 +610,11 @@ for (i=0 ; i 0) { - Tcl_Free((void *)names); + ckfree(names); } } else if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); @@ -635,11 +635,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectMethodTypeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -666,11 +666,11 @@ "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (mPtr->typePtr == NULL) { /* * Special entry for visibility control: pretend the method doesnt * exist. */ @@ -692,11 +692,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectMixinsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *mixinPtr; @@ -735,11 +735,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectIdCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -767,11 +767,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectNsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -800,36 +800,36 @@ * ---------------------------------------------------------------------- */ static int InfoObjectVariablesCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; Tcl_Obj *resultObj; - int i, private = 0; + int i, isPrivate = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?"); return TCL_ERROR; } if (objc == 3) { - if (strcmp("-private", TclGetString(objv[2])) != 0) { + if (strcmp("-private", Tcl_GetString(objv[2])) != 0) { return TCL_ERROR; } - private = 1; + isPrivate = 1; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } resultObj = Tcl_NewObj(); - if (private) { + if (isPrivate) { PrivateVariableMapping *privatePtr; FOREACH_STRUCT(privatePtr, oPtr->privateVariables) { Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj); } @@ -854,11 +854,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectVarsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -915,11 +915,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassConstrCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Proc *procPtr; @@ -976,11 +976,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassDefnCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_HashEntry *hPtr; @@ -1003,11 +1003,11 @@ "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } - procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); + procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); @@ -1027,11 +1027,11 @@ Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } - resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr)); + resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr)); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } /* @@ -1044,11 +1044,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassDefnNsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *kindList[] = { @@ -1094,11 +1094,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassDestrCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Proc *procPtr; @@ -1138,11 +1138,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassFiltersCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int i; @@ -1176,11 +1176,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassForwardCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_HashEntry *hPtr; @@ -1201,11 +1201,11 @@ "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } - prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr)); + prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", @@ -1227,11 +1227,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassInstancesCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -1275,11 +1275,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassMethodsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int flag = PUBLIC_METHOD, recurse = 0, scope = -1; @@ -1364,11 +1364,11 @@ for (i=0 ; i 0) { - Tcl_Free((void *)names); + ckfree(names); } } else { FOREACH_HASH_DECLS; FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { @@ -1391,11 +1391,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassMethodTypeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_HashEntry *hPtr; @@ -1418,11 +1418,11 @@ "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (mPtr->typePtr == NULL) { /* * Special entry for visibility control: pretend the method doesnt * exist. */ @@ -1443,11 +1443,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassMixinsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr, *mixinPtr; @@ -1485,11 +1485,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassSubsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr, *subclassPtr; @@ -1540,11 +1540,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassSupersCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr, *superPtr; @@ -1579,36 +1579,36 @@ * ---------------------------------------------------------------------- */ static int InfoClassVariablesCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr; Tcl_Obj *resultObj; - int i, private = 0; + int i, isPrivate = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?"); return TCL_ERROR; } if (objc == 3) { - if (strcmp("-private", TclGetString(objv[2])) != 0) { + if (strcmp("-private", Tcl_GetString(objv[2])) != 0) { return TCL_ERROR; } - private = 1; + isPrivate = 1; } clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr == NULL) { return TCL_ERROR; } resultObj = Tcl_NewObj(); - if (private) { + if (isPrivate) { PrivateVariableMapping *privatePtr; FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) { Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj); } @@ -1633,11 +1633,11 @@ * ---------------------------------------------------------------------- */ static int InfoObjectCallCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Object *oPtr; @@ -1679,11 +1679,11 @@ * ---------------------------------------------------------------------- */ static int InfoClassCallCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Class *clsPtr; Index: generic/tclOOInt.h ================================================================== --- generic/tclOOInt.h +++ generic/tclOOInt.h @@ -44,11 +44,11 @@ typedef struct Method { const Tcl_MethodType *typePtr; /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ - size_t refCount; + int refCount; void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; /* The object that declares this method, or * NULL if it was declared by a class. */ @@ -63,16 +63,16 @@ /* * Pre- and post-call callbacks, to allow procedure-like methods to be fine * tuned in their behaviour. */ -typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp, +typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished); -typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp, +typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result); -typedef void (TclOO_PmCDDeleteProc)(void *clientData); -typedef void *(TclOO_PmCDCloneProc)(void *clientData); +typedef void (TclOO_PmCDDeleteProc)(ClientData clientData); +typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData); /* * Procedure-like methods have the following extra information. */ @@ -81,11 +81,11 @@ * be 0. */ Proc *procPtr; /* Core of the implementation of the method; * includes the argument definition and the * body bytecodes. */ int flags; /* Flags to control features. */ - size_t refCount; + int refCount; void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; ProcErrorProc *errProc; /* Replacement error handler. */ TclOO_PreCallProc *preCallProc; @@ -182,22 +182,22 @@ LIST_STATIC(Tcl_Obj *) filters; /* List of filter names. */ struct Class *classPtr; /* This is non-NULL for all classes, and NULL * for everything else. It points to the class * structure. */ - size_t refCount; /* Number of strong references to this object. + int refCount; /* Number of strong references to this object. * Note that there may be many more weak * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - size_t creationEpoch; /* Unique value to make comparisons of objects + int creationEpoch; /* Unique value to make comparisons of objects * easier. */ - size_t epoch; /* Per-object epoch, incremented when the way + int epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the void *values that are the values + * the ClientData values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ Tcl_Obj *cachedNameObj; /* Cache of the name of the object. */ Tcl_HashTable *chainCache; /* Place to keep unused contexts. This table @@ -211,18 +211,15 @@ * used inside methods. */ Tcl_Command myclassCommand; /* Reference to this object's class dispatcher * command. */ } Object; -#define OBJECT_DELETED 1 /* Flag to say that an object has been - * destroyed. */ -#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been - * called. */ -#define CLASS_GONE 4 /* Obsolete. Indicates that the class of this - * object has been deleted, and so the object - * should not attempt to remove itself from its - * class. */ +#define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has + * been destroyed */ +#define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor script for the + object has began */ +#define OO_UNUSED_4 4 /* No longer used. */ #define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of * the class hierarchy and should be treated * specially during teardown. */ #define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a * filter; when set, filters are *not* @@ -284,11 +281,11 @@ Method *constructorPtr; /* Method record of the class constructor (if * any). */ Method *destructorPtr; /* Method record of the class destructor (if * any). */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the void *values that are the values + * the ClientData values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ struct CallChain *constructorChainPtr; struct CallChain *destructorChainPtr; @@ -330,11 +327,11 @@ * useful bits and pieces. Probably ought to eventually go in the Interp * structure itself. */ typedef struct ThreadLocalData { - size_t nsCount; /* Master epoch counter is used for keeping + int nsCount; /* Master epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter * boundaries within a thread (objects don't * generally cross threads). */ @@ -354,11 +351,11 @@ * "oo::objdefine" command acts as a special * kind of ensemble for this namespace. */ Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ - size_t epoch; /* Used to invalidate method chains when the + int epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ Tcl_Obj *unknownMethodNameObj; /* Shared object containing the name of the @@ -388,19 +385,19 @@ Class *filterDeclarer; /* What class decided to add the filter; if * NULL, it was added by the object. */ }; typedef struct CallChain { - size_t objectCreationEpoch; /* The object's creation epoch. Note that the + int objectCreationEpoch; /* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - size_t objectEpoch; /* Local (object structure) epoch counter + int objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - size_t epoch; /* Global (class structure) epoch counter + int epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ - size_t refCount; /* Reference count. */ + int refCount; /* Reference count. */ int numChain; /* Size of the call chain. */ struct MInvoke *chain; /* Array of call chain entries. May point to * staticChain if the number of entries is * small. */ struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE]; @@ -448,124 +445,100 @@ * Commands relating to OO support. *---------------------------------------------------------------- */ MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); -MODULE_SCOPE int TclOODefineObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOObjDefObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineConstructorObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDestructorObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineExportObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineForwardObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineMethodObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineRenameMethodObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextToObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefinePrivateObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, +MODULE_SCOPE int TclOODefineObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOODefineDefnNsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextObjCmd(void *clientData, +MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineExportObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineForwardObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineMethodObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineRenameMethodObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineUnexportObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOONextObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextToObjCmd(void *clientData, +MODULE_SCOPE int TclOONextToObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOSelfObjCmd(void *clientData, +MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); /* * Method implementations (in tclOOBasic.c). */ -MODULE_SCOPE int TclOO_Class_Constructor(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_Create(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_CreateNs(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_New(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Destroy(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Eval(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_LinkVar(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Unknown(void *clientData, - Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_VarName(void *clientData, +MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Class_Create(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Class_CreateNs(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Class_New(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Object_Destroy(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Object_Eval(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Object_LinkVar(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Object_Unknown(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); +MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); /* * Private definitions, some of which perhaps ought to be exposed properly or @@ -585,10 +558,11 @@ MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, const char *nameStr, const char *nsNameStr); MODULE_SCOPE int TclOODecrRefCount(Object *oPtr); +MODULE_SCOPE int TclOOObjectDestroyed(Object *oPtr); MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr); MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr); MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr); MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr); MODULE_SCOPE void TclOODeleteDescendants(Tcl_Interp *interp, @@ -611,11 +585,11 @@ MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, Object *contextObj, Class *contextCls, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); -MODULE_SCOPE int TclOOInvokeContext(void *clientData, +MODULE_SCOPE int TclOOInvokeContext(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); @@ -679,27 +653,27 @@ #define FOREACH_HASH_DECLS \ Tcl_HashEntry *hPtr;Tcl_HashSearch search #define FOREACH_HASH(key,val,tablePtr) \ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\ - (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search)) + (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\ + *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search)) #define FOREACH_HASH_VALUE(val,tablePtr) \ for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search)) + (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search)) /* * Convenience macro for duplicating a list. Needs no external declaration, * but all arguments are used multiple times and so must have no side effects. */ #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ #define DUPLICATE(target,source,type) \ do { \ - register size_t len = sizeof(type) * ((target).num=(source).num);\ + size_t len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ - memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \ + memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ } else { \ (target).list = NULL; \ } \ } while(0) Index: generic/tclOOIntDecls.h ================================================================== --- generic/tclOOIntDecls.h +++ generic/tclOOIntDecls.h @@ -20,18 +20,18 @@ /* 1 */ TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - void *clientData, Proc **procPtrPtr); + ClientData clientData, Proc **procPtrPtr); /* 2 */ TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - void *clientData, Proc **procPtrPtr); + ClientData clientData, Proc **procPtrPtr); /* 3 */ TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); @@ -57,23 +57,23 @@ /* 9 */ TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, void *clientData, - Tcl_Obj *nameObj, Tcl_Obj *argsObj, - Tcl_Obj *bodyObj, int flags, - void **internalTokenPtr); + ProcErrorProc *errProc, + ClientData clientData, Tcl_Obj *nameObj, + Tcl_Obj *argsObj, Tcl_Obj *bodyObj, + int flags, void **internalTokenPtr); /* 10 */ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, void *clientData, - Tcl_Obj *nameObj, Tcl_Obj *argsObj, - Tcl_Obj *bodyObj, int flags, - void **internalTokenPtr); + ProcErrorProc *errProc, + ClientData clientData, Tcl_Obj *nameObj, + Tcl_Obj *argsObj, Tcl_Obj *bodyObj, + int flags, void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); @@ -95,20 +95,20 @@ typedef struct TclOOIntStubs { int magic; void *hooks; Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ - Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */ - Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ + Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */ + Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ - Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ - Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ + Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ + Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */ void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */ void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */ Index: generic/tclOOMethod.c ================================================================== --- generic/tclOOMethod.c +++ generic/tclOOMethod.c @@ -78,30 +78,22 @@ PMFrameData *fdPtr); static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); static void DeleteProcedureMethod(void *clientData); static int CloneProcedureMethod(Tcl_Interp *interp, void *clientData, void **newClientData); -static void MethodErrorHandler(Tcl_Interp *interp, - Tcl_Obj *procNameObj); -static void ConstructorErrorHandler(Tcl_Interp *interp, - Tcl_Obj *procNameObj); -static void DestructorErrorHandler(Tcl_Interp *interp, - Tcl_Obj *procNameObj); +static ProcErrorProc MethodErrorHandler; +static ProcErrorProc ConstructorErrorHandler; +static ProcErrorProc DestructorErrorHandler; static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static void DeleteForwardMethod(void *clientData); static int CloneForwardMethod(Tcl_Interp *interp, void *clientData, void **newClientData); -static int ProcedureMethodVarResolver(Tcl_Interp *interp, - const char *varName, Tcl_Namespace *contextNs, - int flags, Tcl_Var *varPtr); -static int ProcedureMethodCompiledVarResolver(Tcl_Interp *interp, - const char *varName, int length, - Tcl_Namespace *contextNs, - Tcl_ResolvedVarInfo **rPtrPtr); +static Tcl_ResolveVarProc ProcedureMethodVarResolver; +static Tcl_ResolveCompiledVarProc ProcedureMethodCompiledVarResolver; /* * The types of methods defined by the core OO system. */ @@ -133,11 +125,11 @@ * ---------------------------------------------------------------------- */ Tcl_Method Tcl_NewInstanceMethod( - Tcl_Interp *interp, /* Unused? */ + TCL_UNUSED(Tcl_Interp *), Tcl_Object object, /* The object that has the method attached to * it. */ Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, * up to caller to manage storage (e.g., when * it is a constructor or destructor). */ @@ -144,38 +136,38 @@ int flags, /* Whether this is a public method. */ const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ - void *clientData) /* Some data associated with the particular + void *clientData) /* Some data associated with the particular * method to be created. */ { - register Object *oPtr = (Object *) object; - register Method *mPtr; + Object *oPtr = (Object *) object; + Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { - mPtr = Tcl_Alloc(sizeof(Method)); + mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } if (!oPtr->methodsPtr) { - oPtr->methodsPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew); if (isNew) { - mPtr = Tcl_Alloc(sizeof(Method)); + mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->namePtr = nameObj; mPtr->refCount = 1; Tcl_IncrRefCount(nameObj); Tcl_SetHashValue(hPtr, mPtr); } else { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } } @@ -206,43 +198,43 @@ * ---------------------------------------------------------------------- */ Tcl_Method Tcl_NewMethod( - Tcl_Interp *interp, /* The interpreter containing the class. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Class cls, /* The class to attach the method to. */ Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., * for constructors or destructors); if so, up * to caller to manage storage. */ int flags, /* Whether this is a public method. */ const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ - void *clientData) /* Some data associated with the particular + void *clientData) /* Some data associated with the particular * method to be created. */ { - register Class *clsPtr = (Class *) cls; - register Method *mPtr; + Class *clsPtr = (Class *) cls; + Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { - mPtr = Tcl_Alloc(sizeof(Method)); + mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew); if (isNew) { - mPtr = Tcl_Alloc(sizeof(Method)); + mPtr = (Method *)ckalloc(sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = nameObj; Tcl_IncrRefCount(nameObj); Tcl_SetHashValue(hPtr, mPtr); } else { - mPtr = Tcl_GetHashValue(hPtr); + mPtr = (Method *)Tcl_GetHashValue(hPtr); if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } } @@ -284,11 +276,11 @@ } if (mPtr->namePtr != NULL) { Tcl_DecrRefCount(mPtr->namePtr); } - Tcl_Free(mPtr); + ckfree(mPtr); } } /* * ---------------------------------------------------------------------- @@ -342,26 +334,26 @@ * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; - register ProcedureMethod *pmPtr; + ProcedureMethod *pmPtr; Tcl_Method method; if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } - pmPtr = Tcl_Alloc(sizeof(ProcedureMethod)); + pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->refCount = 1; method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { - Tcl_Free(pmPtr); + ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } return (Method *) method; } @@ -394,11 +386,11 @@ * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ - register ProcedureMethod *pmPtr; + ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; if (argsObj == NULL) { argsLen = -1; @@ -409,11 +401,11 @@ return NULL; } else { procName = (nameObj==NULL ? "" : TclGetString(nameObj)); } - pmPtr = Tcl_Alloc(sizeof(ProcedureMethod)); + pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; pmPtr->refCount = 1; @@ -422,11 +414,11 @@ if (argsLen == -1) { Tcl_DecrRefCount(argsObj); } if (method == NULL) { - Tcl_Free(pmPtr); + ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } return (Method *) method; @@ -503,16 +495,16 @@ */ if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = Tcl_Alloc(sizeof(int)); + cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; @@ -616,16 +608,16 @@ */ if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = Tcl_Alloc(sizeof(int)); + cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; @@ -670,31 +662,33 @@ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { - ProcedureMethod *pmPtr = clientData; + ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; int result; PMFrameData *fdPtr; /* Important data that has to have a lifetime * matched by this function (or rather, by the * call frame's lifetime). */ /* - * If the interpreter was deleted, we just skip to the next thing in the - * chain. + * If the object namespace (or interpreter) were deleted, we just skip to + * the next thing in the chain. */ - if (Tcl_InterpDeleted(interp)) { + if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) || + Tcl_InterpDeleted(interp) + ) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } /* * Allocate the special frame data. */ - fdPtr = TclStackAlloc(interp, sizeof(PMFrameData)); + fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData)); /* * Create a call frame for this method. */ @@ -747,13 +741,13 @@ FinalizePMCall( void *data[], Tcl_Interp *interp, int result) { - ProcedureMethod *pmPtr = data[0]; - Tcl_ObjectContext context = data[1]; - PMFrameData *fdPtr = data[2]; + ProcedureMethod *pmPtr = (ProcedureMethod *)data[0]; + Tcl_ObjectContext context = (Tcl_ObjectContext)data[1]; + PMFrameData *fdPtr = (PMFrameData *)data[2]; /* * Give the post-call callback a chance to do some cleanup. Note that at * this point the call frame itself is invalid; it's already been popped. */ @@ -794,11 +788,11 @@ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; - register int result; + int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; ByteCode *codePtr; /* @@ -827,11 +821,11 @@ * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { - register Method *mPtr = + Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) mPtr->declaringClassPtr->thisPtr->namespacePtr; @@ -898,11 +892,11 @@ if (pmPtr->gfivProc != NULL) { fdPtr->efi.fields[1].name = ""; fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { - register Tcl_Method method = + Tcl_Method method = Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); if (Tcl_MethodDeclarerObject(method) != NULL) { fdPtr->efi.fields[1].name = "object"; } else { @@ -956,11 +950,11 @@ static int ProcedureMethodVarResolver( Tcl_Interp *interp, const char *varName, Tcl_Namespace *contextNs, - int flags, + TCL_UNUSED(int) /*flags*/, /* Ignoring variable access flags (???) */ Tcl_Var *varPtr) { int result; Tcl_ResolvedVarInfo *rPtr = NULL; @@ -991,12 +985,11 @@ CallFrame *framePtr = iPtr->varFramePtr; CallContext *contextPtr; Tcl_Obj *variableObj; PrivateVariableMapping *privateVar; Tcl_HashEntry *hPtr; - int i, isNew, cacheIt; - size_t varLen, len; + int i, isNew, cacheIt, varLen, len; const char *match, *varName; /* * Check that the variable is being requested in a context that is also a * method call; if not (i.e. we're evaluating in the object's namespace or @@ -1004,11 +997,11 @@ */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { return NULL; } - contextPtr = framePtr->clientData; + contextPtr = (CallContext *)framePtr->clientData; /* * If we've done the work before (in a comparable context) then reuse that * rather than performing resolution ourselves. */ @@ -1099,19 +1092,19 @@ if (infoPtr->cachedObjectVar) { VarHashRefCount(infoPtr->cachedObjectVar)--; TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL); } Tcl_DecrRefCount(infoPtr->variableObj); - Tcl_Free(infoPtr); + ckfree(infoPtr); } static int ProcedureMethodCompiledVarResolver( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), const char *varName, int length, - Tcl_Namespace *contextNs, + TCL_UNUSED(Tcl_Namespace *), Tcl_ResolvedVarInfo **rPtrPtr) { OOResVarInfo *infoPtr; Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length); @@ -1118,17 +1111,17 @@ /* * Do not create resolvers for cases that contain namespace separators or * which look like array accesses. Both will lead us astray. */ - if (strstr(TclGetString(variableObj), "::") != NULL || - Tcl_StringMatch(TclGetString(variableObj), "*(*)")) { + if (strstr(Tcl_GetString(variableObj), "::") != NULL || + Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) { Tcl_DecrRefCount(variableObj); return TCL_CONTINUE; } - infoPtr = Tcl_Alloc(sizeof(OOResVarInfo)); + infoPtr = (OOResVarInfo *)ckalloc(sizeof(OOResVarInfo)); infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect; infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete; infoPtr->cachedObjectVar = NULL; infoPtr->variableObj = variableObj; Tcl_IncrRefCount(variableObj); @@ -1151,11 +1144,11 @@ static Tcl_Obj * RenderDeclarerName( void *clientData) { - struct PNI *pni = clientData; + struct PNI *pni = (struct PNI *)clientData; Tcl_Object object = Tcl_MethodDeclarerObject(pni->method); if (object == NULL) { object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method)); } @@ -1175,21 +1168,24 @@ * suitable formatting contexts. * * ---------------------------------------------------------------------- */ +/* TODO: Check whether Tcl_AppendLimitedToObj() can work here. */ + #define LIMIT 60 #define ELLIPSIFY(str,len) \ - ((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "") + ((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "") static void MethodErrorHandler( Tcl_Interp *interp, - Tcl_Obj *methodNameObj) + TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) + /* We pull the method name out of context instead of from argument */ { - size_t nameLen, objectNameLen; - CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData; + int nameLen, objectNameLen; + CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = TclGetStringFromObj(mPtr->namePtr, &nameLen); Object *declarerPtr; @@ -1202,11 +1198,11 @@ } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } - objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp))); @@ -1213,17 +1209,18 @@ } static void ConstructorErrorHandler( Tcl_Interp *interp, - Tcl_Obj *methodNameObj) + TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) + /* Ignore. We know it is the constructor. */ { - CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData; + CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - size_t objectNameLen; + int objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; } else { @@ -1232,27 +1229,28 @@ } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } - objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" constructor line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp))); } static void DestructorErrorHandler( Tcl_Interp *interp, - Tcl_Obj *methodNameObj) + TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) + /* Ignore. We know it is the destructor. */ { - CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData; + CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - size_t objectNameLen; + int objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; } else { @@ -1261,11 +1259,11 @@ } declarerPtr = mPtr->declaringClassPtr->thisPtr; kindName = "class"; } - objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" destructor line %d)", kindName, ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp))); } @@ -1286,18 +1284,18 @@ { TclProcDeleteProc(pmPtr->procPtr); if (pmPtr->deleteClientdataProc) { pmPtr->deleteClientdataProc(pmPtr->clientData); } - Tcl_Free(pmPtr); + ckfree(pmPtr); } static void DeleteProcedureMethod( void *clientData) { - register ProcedureMethod *pmPtr = clientData; + ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } } @@ -1306,11 +1304,11 @@ CloneProcedureMethod( Tcl_Interp *interp, void *clientData, void **newClientData) { - ProcedureMethod *pmPtr = clientData; + ProcedureMethod *pmPtr = (ProcedureMethod *)clientData; ProcedureMethod *pm2Ptr; Tcl_Obj *bodyObj, *argsObj; CompiledLocal *localPtr; /* @@ -1336,28 +1334,28 @@ * Must strip the internal representation in order to ensure that any * bound references to instance variables are removed. [Bug 3609693] */ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); - TclGetString(bodyObj); + Tcl_GetString(bodyObj); Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL); /* * Create the actual copy of the method record, manufacturing a new proc * record. */ - pm2Ptr = Tcl_Alloc(sizeof(ProcedureMethod)); + pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; Tcl_IncrRefCount(argsObj); Tcl_IncrRefCount(bodyObj); if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); - Tcl_Free(pm2Ptr); + ckfree(pm2Ptr); return TCL_ERROR; } Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); @@ -1386,11 +1384,11 @@ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; - register ForwardMethod *fmPtr; + ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1398,11 +1396,11 @@ "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } - fmPtr = Tcl_Alloc(sizeof(ForwardMethod)); + fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, &fwdMethodType, fmPtr); } @@ -1425,11 +1423,11 @@ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; - register ForwardMethod *fmPtr; + ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1437,11 +1435,11 @@ "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } - fmPtr = Tcl_Alloc(sizeof(ForwardMethod)); + fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, &fwdMethodType, fmPtr); } @@ -1464,11 +1462,11 @@ Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { CallContext *contextPtr = (CallContext *) context; - ForwardMethod *fmPtr = clientData; + ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_Obj **argObjs, **prefixObjs; int numPrefixes, len, skip = contextPtr->skip; /* * Build the real list of arguments to use. Note that we know that the @@ -1495,11 +1493,11 @@ FinalizeForwardCall( void *data[], Tcl_Interp *interp, int result) { - Tcl_Obj **argObjs = data[0]; + Tcl_Obj **argObjs = (Tcl_Obj **)data[0]; TclStackFree(interp, argObjs); return result; } @@ -1515,24 +1513,24 @@ static void DeleteForwardMethod( void *clientData) { - ForwardMethod *fmPtr = clientData; + ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_DecrRefCount(fmPtr->prefixObj); - Tcl_Free(fmPtr); + ckfree(fmPtr); } static int CloneForwardMethod( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), void *clientData, void **newClientData) { - ForwardMethod *fmPtr = clientData; - ForwardMethod *fm2Ptr = Tcl_Alloc(sizeof(ForwardMethod)); + ForwardMethod *fmPtr = (ForwardMethod *)clientData; + ForwardMethod *fm2Ptr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fm2Ptr->prefixObj = fmPtr->prefixObj; Tcl_IncrRefCount(fm2Ptr->prefixObj); *newClientData = fm2Ptr; return TCL_OK; @@ -1552,11 +1550,11 @@ Proc * TclOOGetProcFromMethod( Method *mPtr) { if (mPtr->typePtr == &procMethodType) { - ProcedureMethod *pmPtr = mPtr->clientData; + ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData; return pmPtr->procPtr; } return NULL; } @@ -1564,11 +1562,11 @@ Tcl_Obj * TclOOGetMethodBody( Method *mPtr) { if (mPtr->typePtr == &procMethodType) { - ProcedureMethod *pmPtr = mPtr->clientData; + ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData; (void) TclGetString(pmPtr->procPtr->bodyPtr); return pmPtr->procPtr->bodyPtr; } return NULL; @@ -1577,11 +1575,11 @@ Tcl_Obj * TclOOGetFwdFromMethod( Method *mPtr) { if (mPtr->typePtr == &fwdMethodType) { - ForwardMethod *fwPtr = mPtr->clientData; + ForwardMethod *fwPtr = (ForwardMethod *)mPtr->clientData; return fwPtr->prefixObj; } return NULL; } @@ -1619,11 +1617,11 @@ Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */ int *lengthPtr) /* Where to write the resulting length of the * array of rewritten arguments. */ { unsigned len = rewriteLength + objc - toRewrite; - Tcl_Obj **argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len); + Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len); memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *)); memcpy(argObjs + rewriteLength, objv + toRewrite, sizeof(Tcl_Obj *) * (objc - toRewrite)); Index: generic/tclOOScript.h ================================================================== --- generic/tclOOScript.h +++ generic/tclOOScript.h @@ -108,11 +108,11 @@ "\t\tif {\n" "\t\t\t[info object isa class $originDelegate]\n" "\t\t\t&& ![info object isa class $targetDelegate]\n" "\t\t} then {\n" "\t\t\tcopy $originDelegate $targetDelegate\n" -"\t\t\tobjdefine $targetObject mixin -set \\\n" +"\t\t\tobjdefine $targetObject ::oo::objdefine::mixin -set \\\n" "\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n" "\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n" "\t\t\t\t}]\n" "\t\t}\n" "\t}\n" DELETED generic/tclOOScript.tcl Index: generic/tclOOScript.tcl ================================================================== --- generic/tclOOScript.tcl +++ /dev/null @@ -1,456 +0,0 @@ -# tclOOScript.h -- -# -# This file contains support scripts for TclOO. They are defined here so -# that the code can be definitely run even in safe interpreters; TclOO's -# core setup is safe. -# -# Copyright (c) 2012-2018 Donal K. Fellows -# Copyright (c) 2013 Andreas Kupries -# Copyright (c) 2017 Gerald Lester -# -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. - -::namespace eval ::oo { - ::namespace path {} - - # - # Commands that are made available to objects by default. - # - namespace eval Helpers { - ::namespace path {} - - # ------------------------------------------------------------------ - # - # callback, mymethod -- - # - # Create a script prefix that calls a method on the current - # object. Same operation, two names. - # - # ------------------------------------------------------------------ - - proc callback {method args} { - list [uplevel 1 {::namespace which my}] $method {*}$args - } - - # Make the [callback] command appear as [mymethod] too. - namespace export callback - namespace eval tmp {namespace import ::oo::Helpers::callback} - namespace export -clear - rename tmp::callback mymethod - namespace delete tmp - - # ------------------------------------------------------------------ - # - # classvariable -- - # - # Link to a variable in the class of the current object. - # - # ------------------------------------------------------------------ - - proc classvariable {name args} { - # Get a reference to the class's namespace - set ns [info object namespace [uplevel 1 {self class}]] - # Double up the list of variable names - foreach v [list $name {*}$args] { - if {[string match *(*) $v]} { - set reason "can't create a scalar variable that looks like an array element" - return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \ - [format {bad variable name "%s": %s} $v $reason] - } - if {[string match *::* $v]} { - set reason "can't create a local variable with a namespace separator in it" - return -code error -errorcode {TCL UPVAR INVERTED} \ - [format {bad variable name "%s": %s} $v $reason] - } - lappend vs $v $v - } - # Lastly, link the caller's local variables to the class's variables - tailcall namespace upvar $ns {*}$vs - } - - # ------------------------------------------------------------------ - # - # link -- - # - # Make a command that invokes a method on the current object. - # The name of the command and the name of the method match by - # default. - # - # ------------------------------------------------------------------ - - proc link {args} { - set ns [uplevel 1 {::namespace current}] - foreach link $args { - if {[llength $link] == 2} { - lassign $link src dst - } elseif {[llength $link] == 1} { - lassign $link src - set dst $src - } else { - return -code error -errorcode {TCLOO CMDLINK FORMAT} \ - "bad link description; must only have one or two elements" - } - if {![string match ::* $src]} { - set src [string cat $ns :: $src] - } - interp alias {} $src {} ${ns}::my $dst - trace add command ${ns}::my delete [list \ - ::oo::UnlinkLinkedCommand $src] - } - return - } - } - - # ---------------------------------------------------------------------- - # - # UnlinkLinkedCommand -- - # - # Callback used to remove linked command when the underlying mechanism - # that supports it is deleted. - # - # ---------------------------------------------------------------------- - - proc UnlinkLinkedCommand {cmd args} { - if {[namespace which $cmd] ne {}} { - rename $cmd {} - } - } - - # ---------------------------------------------------------------------- - # - # DelegateName -- - # - # Utility that gets the name of the class delegate for a class. It's - # trivial, but makes working with them much easier as delegate names are - # intentionally hard to create by accident. - # - # ---------------------------------------------------------------------- - - proc DelegateName {class} { - string cat [info object namespace $class] {:: oo ::delegate} - } - - # ---------------------------------------------------------------------- - # - # MixinClassDelegates -- - # - # Support code called *after* [oo::define] inside the constructor of a - # class that patches in the appropriate class delegates. - # - # ---------------------------------------------------------------------- - - proc MixinClassDelegates {class} { - if {![info object isa class $class]} { - return - } - set delegate [DelegateName $class] - if {![info object isa class $delegate]} { - return - } - foreach c [info class superclass $class] { - set d [DelegateName $c] - if {![info object isa class $d]} { - continue - } - define $delegate ::oo::define::superclass -append $d - } - objdefine $class ::oo::objdefine::mixin -append $delegate - } - - # ---------------------------------------------------------------------- - # - # UpdateClassDelegatesAfterClone -- - # - # Support code that is like [MixinClassDelegates] except for when a - # class is cloned. - # - # ---------------------------------------------------------------------- - - proc UpdateClassDelegatesAfterClone {originObject targetObject} { - # Rebuild the class inheritance delegation class - set originDelegate [DelegateName $originObject] - set targetDelegate [DelegateName $targetObject] - if { - [info object isa class $originDelegate] - && ![info object isa class $targetDelegate] - } then { - copy $originDelegate $targetDelegate - objdefine $targetObject ::oo::objdefine::mixin -set \ - {*}[lmap c [info object mixin $targetObject] { - if {$c eq $originDelegate} {set targetDelegate} {set c} - }] - } - } - - # ---------------------------------------------------------------------- - # - # oo::define::classmethod -- - # - # Defines a class method. See define(n) for details. - # - # Note that the ::oo::define namespace is semi-public and a bit weird - # anyway, so we don't regard the namespace path as being under control: - # fully qualified names are used for everything. - # - # ---------------------------------------------------------------------- - - proc define::classmethod {name {args {}} {body {}}} { - # Create the method on the class if the caller gave arguments and body - ::set argc [::llength [::info level 0]] - ::if {$argc == 3} { - ::return -code error -errorcode {TCL WRONGARGS} [::format \ - {wrong # args: should be "%s name ?args body?"} \ - [::lindex [::info level 0] 0]] - } - ::set cls [::uplevel 1 self] - ::if {$argc == 4} { - ::oo::define [::oo::DelegateName $cls] method $name $args $body - } - # Make the connection by forwarding - ::tailcall forward $name myclass $name - } - - # ---------------------------------------------------------------------- - # - # oo::define::initialise, oo::define::initialize -- - # - # Do specific initialisation for a class. See define(n) for details. - # - # Note that the ::oo::define namespace is semi-public and a bit weird - # anyway, so we don't regard the namespace path as being under control: - # fully qualified names are used for everything. - # - # ---------------------------------------------------------------------- - - proc define::initialise {body} { - ::set clsns [::info object namespace [::uplevel 1 self]] - ::tailcall apply [::list {} $body $clsns] - } - - # Make the [initialise] definition appear as [initialize] too - namespace eval define { - ::namespace export initialise - ::namespace eval tmp {::namespace import ::oo::define::initialise} - ::namespace export -clear - ::rename tmp::initialise initialize - ::namespace delete tmp - } - - # ---------------------------------------------------------------------- - # - # Slot -- - # - # The class of slot operations, which are basically lists at the low - # level of TclOO; this provides a more consistent interface to them. - # - # ---------------------------------------------------------------------- - - define Slot { - # ------------------------------------------------------------------ - # - # Slot Get -- - # - # Basic slot getter. Retrieves the contents of the slot. - # Particular slots must provide concrete non-erroring - # implementation. - # - # ------------------------------------------------------------------ - - method Get {} { - return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" - } - - # ------------------------------------------------------------------ - # - # Slot Set -- - # - # Basic slot setter. Sets the contents of the slot. Particular - # slots must provide concrete non-erroring implementation. - # - # ------------------------------------------------------------------ - - method Set list { - return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" - } - - # ------------------------------------------------------------------ - # - # Slot Resolve -- - # - # Helper that lets a slot convert a list of arguments of a - # particular type to their canonical forms. Defaults to doing - # nothing (suitable for simple strings). - # - # ------------------------------------------------------------------ - - method Resolve list { - return $list - } - - # ------------------------------------------------------------------ - # - # Slot -set, -append, -clear, --default-operation -- - # - # Standard public slot operations. If a slot can't figure out - # what method to call directly, it uses --default-operation. - # - # ------------------------------------------------------------------ - - method -set args { - set my [namespace which my] - set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] - tailcall my Set $args - } - method -append args { - set my [namespace which my] - set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] - set current [uplevel 1 [list $my Get]] - tailcall my Set [list {*}$current {*}$args] - } - method -clear {} {tailcall my Set {}} - method -prepend args { - set my [namespace which my] - set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] - set current [uplevel 1 [list $my Get]] - tailcall my Set [list {*}$args {*}$current] - } - method -remove args { - set my [namespace which my] - set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] - set current [uplevel 1 [list $my Get]] - tailcall my Set [lmap val $current { - if {$val in $args} continue else {set val} - }] - } - - # Default handling - forward --default-operation my -append - method unknown {args} { - set def --default-operation - if {[llength $args] == 0} { - tailcall my $def - } elseif {![string match -* [lindex $args 0]]} { - tailcall my $def {*}$args - } - next {*}$args - } - - # Set up what is exported and what isn't - export -set -append -clear -prepend -remove - unexport unknown destroy - } - - # Set the default operation differently for these slots - objdefine define::superclass forward --default-operation my -set - objdefine define::mixin forward --default-operation my -set - objdefine objdefine::mixin forward --default-operation my -set - - # ---------------------------------------------------------------------- - # - # oo::object -- - # - # Handler for cloning objects that clones basic bits (only!) of the - # object's namespace. Non-procedures, traces, sub-namespaces, etc. need - # more complex (and class-specific) handling. - # - # ---------------------------------------------------------------------- - - define object method {originObject} { - # Copy over the procedures from the original namespace - foreach p [info procs [info object namespace $originObject]::*] { - set args [info args $p] - set idx -1 - foreach a $args { - if {[info default $p $a d]} { - lset args [incr idx] [list $a $d] - } else { - lset args [incr idx] [list $a] - } - } - set b [info body $p] - set p [namespace tail $p] - proc $p $args $b - } - # Copy over the variables from the original namespace - foreach v [info vars [info object namespace $originObject]::*] { - upvar 0 $v vOrigin - namespace upvar [namespace current] [namespace tail $v] vNew - if {[info exists vOrigin]} { - if {[array exists vOrigin]} { - array set vNew [array get vOrigin] - } else { - set vNew $vOrigin - } - } - } - # General commands, sub-namespaces and advancd variable config (traces, - # etc) are *not* copied over. Classes that want that should do it - # themselves. - } - - # ---------------------------------------------------------------------- - # - # oo::class -- - # - # Handler for cloning classes, which fixes up the delegates. - # - # ---------------------------------------------------------------------- - - define class method {originObject} { - next $originObject - # Rebuild the class inheritance delegation class - ::oo::UpdateClassDelegatesAfterClone $originObject [self] - } - - # ---------------------------------------------------------------------- - # - # oo::singleton -- - # - # A metaclass that is used to make classes that only permit one instance - # of them to exist. See singleton(n). - # - # ---------------------------------------------------------------------- - - class create singleton { - superclass class - variable object - unexport create createWithNamespace - method new args { - if {![info exists object] || ![info object isa object $object]} { - set object [next {*}$args] - ::oo::objdefine $object { - method destroy {} { - ::return -code error -errorcode {TCLOO SINGLETON} \ - "may not destroy a singleton object" - } - method {originObject} { - ::return -code error -errorcode {TCLOO SINGLETON} \ - "may not clone a singleton object" - } - } - } - return $object - } - } - - # ---------------------------------------------------------------------- - # - # oo::abstract -- - # - # A metaclass that is used to make classes that can't be directly - # instantiated. See abstract(n). - # - # ---------------------------------------------------------------------- - - class create abstract { - superclass class - unexport create createWithNamespace new - } -} - -# Local Variables: -# mode: tcl -# c-basic-offset: 4 -# fill-column: 78 -# End: Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -13,11 +13,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" #include #include /* * Table of all object types. @@ -56,11 +56,11 @@ * Structure for tracking the source file and line number where a given * Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself, * for sanity checking purposes. */ -typedef struct { +typedef struct ObjData { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ int line; /* Line number in the source file; used for * debugging. */ @@ -167,28 +167,25 @@ PendingObjData *const contextPtr = &pendingObjData #else static Tcl_ThreadDataKey pendingObjDataKey; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = \ - Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) + (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) #endif /* * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep */ #define PACK_BIGNUM(bignum, objPtr) \ - if ((bignum).used > 0x7fff) { \ - mp_int *temp = (void *) Tcl_Alloc(sizeof(mp_int)); \ + if ((bignum).used > 0x7FFF) { \ + mp_int *temp = (mp_int *) ckalloc(sizeof(mp_int)); \ *temp = bignum; \ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ - } else { \ - if ((bignum).alloc > 0x7fff) { \ - mp_shrink(&(bignum)); \ - } \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ + } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ | ((bignum).alloc << 15) | ((bignum).used)); \ } /* @@ -198,10 +195,13 @@ static int ParseBoolean(Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) +static void UpdateStringOfOldInt(Tcl_Obj *objPtr); +#endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int copy, mp_int *bignumValue); @@ -226,13 +226,22 @@ * means of functions that can be invoked by generic object code. See also * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager * implementations. */ -const Tcl_ObjType tclBooleanType = { +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +static const Tcl_ObjType oldBooleanType = { "boolean", /* name */ NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + TclSetBooleanFromAny /* setFromAnyProc */ +}; +#endif +const Tcl_ObjType tclBooleanType = { + "booleanString", /* name */ + NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ TclSetBooleanFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclDoubleType = { @@ -241,16 +250,29 @@ NULL, /* dupIntRepProc */ UpdateStringOfDouble, /* updateStringProc */ SetDoubleFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclIntType = { +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG) "int", /* name */ +#else + "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/ +#endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) +static const Tcl_ObjType oldIntType = { + "int", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfOldInt, /* updateStringProc */ + SetIntFromAny /* setFromAnyProc */ +}; +#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ DupBignum, /* dupIntRepProc */ UpdateStringOfBignum, /* updateStringProc */ @@ -312,21 +334,21 @@ Command *cmdPtr; /* A cached Command pointer. */ Namespace *refNsPtr; /* Points to the namespace containing the * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ - size_t refNsId; /* refNsPtr's unique namespace id. Used to + unsigned long refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - size_t refNsCmdEpoch; /* Value of the referencing namespace's + unsigned int refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - size_t cmdEpoch; /* Value of the command's cmdEpoch when this + unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, * deleted, hidden, or exposed, and so the * pointer is invalid. */ @@ -370,10 +392,19 @@ Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); Tcl_RegisterObjType(&tclCmdNameType); Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclProcBodyType); + + /* For backward compatibility only ... */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 + Tcl_RegisterObjType(&tclIntType); +#if !defined(TCL_WIDE_INT_IS_LONG) + Tcl_RegisterObjType(&oldIntType); +#endif + Tcl_RegisterObjType(&oldBooleanType); +#endif #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; tclObjsFreed = 0; @@ -415,19 +446,19 @@ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - ObjData *objData = Tcl_GetHashValue(hPtr); + ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { - Tcl_Free(objData); + ckfree(objData); } } Tcl_DeleteHashTable(tablePtr); - Tcl_Free(tablePtr); + ckfree(tablePtr); tsdPtr->objThreadMap = NULL; } #endif } @@ -499,11 +530,11 @@ */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->lineCLPtr) { - tsdPtr->lineCLPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + tsdPtr->lineCLPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); } return tsdPtr; } @@ -534,11 +565,11 @@ { int newEntry; ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); - ContLineLoc *clLocPtr = Tcl_Alloc(sizeof(ContLineLoc) + num*sizeof(int)); + ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(sizeof(ContLineLoc) + num*sizeof(int)); if (!newEntry) { /* * We're entering ContLineLoc data for the same value more than one * time. Taking care not to leak the old entry. @@ -558,11 +589,11 @@ * returning the stored entry would rebase them a second time, or * more, hosing the data. It is easier to simply replace, as we are * doing. */ - Tcl_Free(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); } clLocPtr->num = num; memcpy(&clLocPtr->loc, loc, num*sizeof(int)); clLocPtr->loc[num] = CLL_END; /* Sentinel */ @@ -594,12 +625,11 @@ TclContinuationsEnterDerived( Tcl_Obj *objPtr, int start, int *clNext) { - size_t length; - int end, num; + int length, end, num; int *wordCLLast = clNext; /* * We have to handle invisible continuations lines here as well, despite * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If @@ -622,11 +652,11 @@ /* * First compute the range of the word within the script. (Is there a * better way which doesn't shimmer?) */ - (void)TclGetStringFromObj(objPtr, &length); + TclGetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* * Then compute the table slice covering the range of the word. */ @@ -692,11 +722,11 @@ ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); if (hPtr) { - ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr); + ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr); TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc); } } @@ -728,11 +758,11 @@ Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (!hPtr) { return NULL; } - return Tcl_GetHashValue(hPtr); + return (ContLineLoc *)Tcl_GetHashValue(hPtr); } /* *---------------------------------------------------------------------- * @@ -751,11 +781,11 @@ *---------------------------------------------------------------------- */ static void TclThreadFinalizeContLines( - ClientData clientData) + TCL_UNUSED(ClientData)) { /* * Release the hashtable tracking invisible continuation lines. */ @@ -763,15 +793,15 @@ Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - Tcl_Free(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); - Tcl_Free(tsdPtr->lineCLPtr); + ckfree(tsdPtr->lineCLPtr); tsdPtr->lineCLPtr = NULL; } /* *-------------------------------------------------------------- @@ -835,11 +865,11 @@ Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * name of each registered type is appended as * a list element. */ { - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; Tcl_HashSearch search; int numElems; /* * Get the test for a valid list out of the way first. @@ -856,11 +886,11 @@ Tcl_MutexLock(&tableMutex); for (hPtr = Tcl_FirstHashEntry(&typeTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1)); + Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), -1)); } Tcl_MutexUnlock(&tableMutex); return TCL_OK; } @@ -883,17 +913,17 @@ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { - register Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { - typePtr = Tcl_GetHashValue(hPtr); + typePtr = (const Tcl_ObjType *)Tcl_GetHashValue(hPtr); } Tcl_MutexUnlock(&tableMutex); return typePtr; } @@ -960,27 +990,27 @@ * None. * *-------------------------------------------------------------- */ +#if TCL_THREADS && defined(TCL_MEM_DEBUG) void TclDbDumpActiveObjects( FILE *outFile) { -#if TCL_THREADS && defined(TCL_MEM_DEBUG) Tcl_HashSearch hSearch; Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { - fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries); + fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - ObjData *objData = Tcl_GetHashValue(hPtr); + ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { fprintf(outFile, "key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n", Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr, @@ -989,12 +1019,18 @@ fprintf(outFile, "key = 0x%p\n", Tcl_GetHashKey(tablePtr, hPtr)); } } } +} +#else +void +TclDbDumpActiveObjects( + TCL_UNUSED(FILE *)) +{ +} #endif -} /* *---------------------------------------------------------------------- * * TclDbInitNewObj -- @@ -1013,14 +1049,14 @@ */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( - register Tcl_Obj *objPtr, - register const char *file, /* The name of the source file calling this + Tcl_Obj *objPtr, + const char *file, /* The name of the source file calling this * function; used for debugging. */ - register int line) /* Line number in the source file; used for + int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; objPtr->typePtr = NULL; TclInitStringRep(objPtr, NULL, 0); @@ -1037,11 +1073,11 @@ int isNew; ObjData *objData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->objThreadMap == NULL) { - tsdPtr->objThreadMap = Tcl_Alloc(sizeof(Tcl_HashTable)); + tsdPtr->objThreadMap = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS); } tablePtr = tsdPtr->objThreadMap; hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew); if (!isNew) { @@ -1050,11 +1086,11 @@ /* * Record the debugging information. */ - objData = Tcl_Alloc(sizeof(ObjData)); + objData = (ObjData *)ckalloc(sizeof(ObjData)); objData->objPtr = objPtr; objData->file = file; objData->line = line; Tcl_SetHashValue(hPtr, objData); } @@ -1100,11 +1136,11 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ @@ -1142,16 +1178,16 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( - register const char *file, /* The name of the source file calling this + const char *file, /* The name of the source file calling this * function; used for debugging. */ - register int line) /* Line number in the source file; used for + int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ @@ -1160,14 +1196,12 @@ } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewObj( - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewObj(); } #endif /* TCL_MEM_DEBUG */ @@ -1175,11 +1209,11 @@ *---------------------------------------------------------------------- * * TclAllocateFreeObjects -- * * Function to allocate a number of free Tcl_Objs. This is done using a - * single Tcl_Alloc to reduce the overhead for Tcl_Obj allocation. + * single ckalloc to reduce the overhead for Tcl_Obj allocation. * * Assumes mutex is held. * * Results: * None. @@ -1197,23 +1231,23 @@ void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; - register Tcl_Obj *prevPtr, *objPtr; - register int i; + Tcl_Obj *prevPtr, *objPtr; + int i; /* * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually - * freeing the memory. TclFinalizeObjects() does not Tcl_Free() this memory, + * freeing the memory. TclFinalizeObjects() does not ckfree() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. * Purify apparently can't figure that out, and fires a false alarm. */ - basePtr = Tcl_Alloc(bytesToAlloc); + basePtr = (char *)ckalloc(bytesToAlloc); prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr; for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) { objPtr->internalRep.twoPtrValue.ptr1 = prevPtr; @@ -1249,13 +1283,13 @@ */ #ifdef TCL_MEM_DEBUG void TclFreeObj( - register Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { - register const Tcl_ObjType *typePtr = objPtr->typePtr; + const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... */ @@ -1281,14 +1315,14 @@ if (hPtr) { /* * As the Tcl_Obj is going to be deleted we remove the entry. */ - ObjData *objData = Tcl_GetHashValue(hPtr); + ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { - Tcl_Free(objData); + ckfree(objData); } Tcl_DeleteHashEntry(hPtr); } } @@ -1298,28 +1332,28 @@ * Check for a double free of the same value. This is slightly tricky * because it is customary to free a Tcl_Obj when its refcount falls * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though, * and so on, is always a sign of a botch in the caller. */ - if (objPtr->refCount == (size_t)-2) { + if (objPtr->refCount < -1) { Tcl_Panic("Reference count for %p was negative", objPtr); } /* * Now, in case we just approved drop from 1 to 0 as acceptable, make * sure we do not accept a second free when falling from 0 to -1. * Skip that possibility so any double free will trigger the panic. */ - objPtr->refCount = TCL_AUTO_LENGTH; + objPtr->refCount = -1; /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) - * with 'length == TCL_AUTO_LENGTH'. + * with 'length == -1'. */ TclInvalidateStringRep(objPtr); - objPtr->length = TCL_AUTO_LENGTH; + objPtr->length = -1; if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); } else { TCL_DTRACE_OBJ_FREE(objPtr); @@ -1328,11 +1362,11 @@ typePtr->freeIntRepProc(objPtr); ObjDeletionUnlock(context); } Tcl_MutexLock(&tclObjMutex); - Tcl_Free(objPtr); + ckfree(objPtr); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); ObjDeletionLock(context); while (ObjOnStack(context)) { Tcl_Obj *objToFree; @@ -1340,11 +1374,11 @@ PopObjToDelete(context, objToFree); TCL_DTRACE_OBJ_FREE(objToFree); TclFreeIntRep(objToFree); Tcl_MutexLock(&tclObjMutex); - Tcl_Free(objToFree); + ckfree(objToFree); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); } ObjDeletionUnlock(context); } @@ -1364,30 +1398,30 @@ Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - Tcl_Free(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( - register Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) * with 'length == -1'. */ TclInvalidateStringRep(objPtr); - objPtr->length = TCL_AUTO_LENGTH; + objPtr->length = -1; if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* * objPtr can be freed safely, as it will not attempt to free any * other objects: it will not cause recursive calls to this function. @@ -1455,11 +1489,11 @@ Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - Tcl_Free(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } @@ -1485,11 +1519,11 @@ int TclObjBeingDeleted( Tcl_Obj *objPtr) { - return (objPtr->length == TCL_AUTO_LENGTH); + return (objPtr->length == -1); } /* *---------------------------------------------------------------------- * @@ -1583,11 +1617,11 @@ *---------------------------------------------------------------------- */ char * Tcl_GetString( - register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { /* * Note we do not check for objPtr->typePtr == NULL. An invariant @@ -1604,11 +1638,11 @@ */ Tcl_Panic("UpdateStringProc should not be invoked for type %s", objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length == TCL_AUTO_LENGTH + if (objPtr->bytes == NULL || objPtr->length < 0 || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", objPtr->typePtr->name); } @@ -1639,13 +1673,13 @@ *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( - register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - register int *lengthPtr) /* If non-NULL, the location where the string + int *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { if (objPtr->bytes == NULL) { /* @@ -1663,19 +1697,19 @@ */ Tcl_Panic("UpdateStringProc should not be invoked for type %s", objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length == TCL_AUTO_LENGTH + if (objPtr->bytes == NULL || objPtr->length < 0 || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", objPtr->typePtr->name); } } if (lengthPtr != NULL) { - *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; + *lengthPtr = objPtr->length; } return objPtr->bytes; } /* @@ -1685,28 +1719,28 @@ * * This function is called in several configurations to provide all * the tools needed to set an object's string representation. The * function is determined by the arguments. * - * (objPtr->bytes != NULL && bytes != NULL) || (numBytes == -1) + * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0) * Invalid call -- panic! * - * objPtr->bytes == NULL && bytes == NULL && numBytes != -1 + * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0 * Allocation only - allocate space for (numBytes+1) chars. * store in objPtr->bytes and return. Also sets * objPtr->length to 0 and objPtr->bytes[0] to NUL. * - * objPtr->bytes == NULL && bytes != NULL && numBytes != -1 + * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0 * Allocate and copy. bytes is assumed to point to chars to * copy into the string rep. objPtr->length = numBytes. Allocate * array of (numBytes + 1) chars. store in objPtr->bytes. Copy * numBytes chars from bytes to objPtr->bytes; Set * objPtr->bytes[numBytes] to NUL and return objPtr->bytes. * Caller must guarantee there are numBytes chars at bytes to * be copied. * - * objPtr->bytes != NULL && bytes == NULL && numBytes != -1 + * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0 * Truncate. Set objPtr->length to numBytes and * objPr->bytes[numBytes] to NUL. Caller has to guarantee * that a prior allocating call allocated enough bytes for * this to be valid. Return objPtr->bytes. * @@ -1724,35 +1758,39 @@ char * Tcl_InitStringRep( Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, - size_t numBytes) + unsigned int numBytes) { assert(objPtr->bytes == NULL || bytes == NULL); + + if (numBytes > INT_MAX) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } /* Allocate */ if (objPtr->bytes == NULL) { /* Allocate only as empty - extend later if bytes copied */ objPtr->length = 0; if (numBytes) { - objPtr->bytes = Tcl_AttemptAlloc(numBytes + 1); + objPtr->bytes = (char *)attemptckalloc(numBytes + 1); if (objPtr->bytes == NULL) { return NULL; } if (bytes) { /* Copy */ memcpy(objPtr->bytes, bytes, numBytes); - objPtr->length = numBytes; + objPtr->length = (int) numBytes; } } else { TclInitStringRep(objPtr, NULL, 0); } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ - objPtr->bytes = Tcl_Realloc(objPtr->bytes, numBytes + 1); - objPtr->length = numBytes; + objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes + 1); + objPtr->length = (int)numBytes; } /* Terminate */ objPtr->bytes[objPtr->length] = '\0'; @@ -1777,11 +1815,11 @@ *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( - register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); } @@ -1897,10 +1935,149 @@ } /* *---------------------------------------------------------------------- * + * Tcl_NewBooleanObj -- + * + * This function is normally called when not debugging: i.e., when + * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and + * initializes it from the argument boolean value. A nonzero "boolValue" + * is coerced to 1. + * + * When TCL_MEM_DEBUG is defined, this function just returns the result + * of calling the debugging version Tcl_DbNewLongObj. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_NewBooleanObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_NewBooleanObj( + int boolValue) /* Boolean used to initialize new object. */ +{ + return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_NewBooleanObj( + int boolValue) /* Boolean used to initialize new object. */ +{ + Tcl_Obj *objPtr; + + TclNewIntObj(objPtr, boolValue!=0); + return objPtr; +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_DbNewBooleanObj -- + * + * This function is normally called when debugging: i.e., when + * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the + * same as the Tcl_NewBooleanObj function above except that it calls + * Tcl_DbCkalloc directly with the file name and line number from its + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. + * + * When TCL_MEM_DEBUG is not defined, this function just returns the + * result of calling Tcl_NewBooleanObj. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_DbNewBooleanObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_DbNewBooleanObj( + int boolValue, /* Boolean used to initialize new object. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ +{ + Tcl_Obj *objPtr; + + TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep() */ + objPtr->bytes = NULL; + + objPtr->internalRep.wideValue = (boolValue != 0); + objPtr->typePtr = &tclIntType; + return objPtr; +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_DbNewBooleanObj( + int boolValue, /* Boolean used to initialize new object. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ + return Tcl_NewBooleanObj(boolValue); +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetBooleanObj -- + * + * Modify an object to be a boolean object and to have the specified + * boolean value. A nonzero "boolValue" is coerced to 1. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_SetBooleanObj +void +Tcl_SetBooleanObj( + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + int boolValue) /* Boolean used to set object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); + } + + TclSetIntObj(objPtr, boolValue!=0); +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This * includes conversion from any of Tcl's numeric types. * @@ -1916,17 +2093,21 @@ */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get boolean. */ - register int *boolPtr) /* Place to store resulting boolean. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ + int *boolPtr) /* Place to store resulting boolean. */ { do { - if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) { + if (objPtr->typePtr == &tclIntType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; + } + if (objPtr->typePtr == &tclBooleanType) { + *boolPtr = objPtr->internalRep.longValue != 0; + return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { /* * Caution: Don't be tempted to check directly for the "double" * Tcl_ObjType and then compare the intrep to 0.0. This isn't @@ -1965,19 +2146,24 @@ * conversion, an error message is left in the interpreter's result * unless "interp" is NULL. * * Side effects: * If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal - * representation and the type of "objPtr" is set to boolean or int. + * representation and the type of "objPtr" is set to boolean or int/wideInt. + * + * Warning: If the returned type is "wideInt" (32-bit platforms) and your + * platform is bigendian, you cannot use internalRep.longValue to distinguish + * between false and true. On Windows and most other platforms this still will + * work fine, but basically it is non-portable. * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. @@ -2004,11 +2190,11 @@ return TCL_OK; } badBoolean: if (interp != NULL) { - size_t length; + int length; const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); Tcl_AppendLimitedToObj(msg, str, length, 50, ""); @@ -2019,16 +2205,16 @@ return TCL_ERROR; } static int ParseBoolean( - register Tcl_Obj *objPtr) /* The object to parse/convert. */ + Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; - size_t i, length; - const char *str = TclGetStringFromObj(objPtr, &length); + const char *str = TclGetString(objPtr); + size_t i, length = objPtr->length; if ((length == 0) || (length > 5)) { /* * Longest valid boolean string rep. is "false". */ @@ -2123,11 +2309,11 @@ * Tcl_GetStringFromObj, to use that old internalRep. */ goodBoolean: TclFreeIntRep(objPtr); - objPtr->internalRep.wideValue = newBool; + objPtr->internalRep.longValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; numericBoolean: TclFreeIntRep(objPtr); @@ -2161,22 +2347,22 @@ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( - register double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewDoubleObj( - register double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewDoubleObj(objPtr, dblValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2209,17 +2395,17 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( - register double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; @@ -2230,15 +2416,13 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewDoubleObj( - register double dblValue, /* Double used to initialize the object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ + double dblValue, /* Double used to initialize the object. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewDoubleObj(dblValue); } #endif /* TCL_MEM_DEBUG */ @@ -2260,12 +2444,12 @@ *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( - register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - register double dblValue) /* Double used to set the object's value. */ + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + double dblValue) /* Double used to set the object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj"); } @@ -2293,12 +2477,12 @@ */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get a double. */ - register double *dblPtr) /* Place to store resulting double. */ + Tcl_Obj *objPtr, /* The object from which to get a double. */ + double *dblPtr) /* Place to store resulting double. */ { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { if (interp != NULL) { @@ -2348,11 +2532,11 @@ */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); } @@ -2360,11 +2544,12 @@ *---------------------------------------------------------------------- * * UpdateStringOfDouble -- * * Update the string representation for a double-precision floating point - * object. Note: This function does not free an + * object. This must obey the current tcl_precision value for + * double-to-string conversions. Note: This function does not free an * existing old string rep so storage will be lost if this has not * already been done. * * Results: * None. @@ -2376,11 +2561,11 @@ *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( - register Tcl_Obj *objPtr) /* Double obj with string rep to update. */ + Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); TclOOM(dst, TCL_DOUBLE_SPACE + 1); @@ -2389,41 +2574,125 @@ } /* *---------------------------------------------------------------------- * + * Tcl_NewIntObj -- + * + * If a client is compiled with TCL_MEM_DEBUG defined, calls to + * Tcl_NewIntObj to create a new integer object end up calling the + * debugging function Tcl_DbNewLongObj instead. + * + * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, + * calls to Tcl_NewIntObj result in a call to one of the two + * Tcl_NewIntObj implementations below. We provide two implementations so + * that the Tcl core can be compiled to do memory debugging of the core + * even if a client does not request it for itself. + * + * Integer and long integer objects share the same "integer" type + * implementation. We store all integers as longs and Tcl_GetIntFromObj + * checks whether the current value of the long can be represented by an + * int. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_NewIntObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_NewIntObj( + int intValue) /* Int used to initialize the new object. */ +{ + return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_NewIntObj( + int intValue) /* Int used to initialize the new object. */ +{ + Tcl_Obj *objPtr; + + TclNewIntObj(objPtr, intValue); + return objPtr; +} +#endif /* if TCL_MEM_DEBUG */ +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetIntObj -- + * + * Modify an object to be an integer and to have the specified integer + * value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ +#ifndef TCL_NO_DEPRECATED +#undef Tcl_SetIntObj +void +Tcl_SetIntObj( + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + int intValue) /* Integer used to set object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); + } + + TclSetIntObj(objPtr, intValue); +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * Tcl_GetIntFromObj -- * - * Retrieve the integer value of 'objPtr'. - * - * Value - * - * TCL_OK - * - * Success. - * - * TCL_ERROR - * - * An error occurred during conversion or the integral value can not - * be represented as an integer (it might be too large). An error - * message is left in the interpreter's result if 'interp' is not - * NULL. - * - * Effect - * - * 'objPtr' is converted to an integer if necessary if it is not one - * already. The conversion frees any previously-existing internal - * representation. + * Attempt to return an int from the Tcl object "objPtr". If the object + * is not already an int, an attempt will be made to convert it to one. + * + * Integer and long integer objects share the same "integer" type + * implementation. We store all integers as longs and Tcl_GetIntFromObj + * checks whether the current value of the long can be represented by an + * int. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion or if the long integer held by the object can not be + * represented by an int, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already an int, the conversion will free any old + * internal representation. * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get a int. */ - register int *intPtr) /* Place to store resulting int. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + int *intPtr) /* Place to store resulting int. */ { #if (LONG_MAX == INT_MAX) return TclGetLongFromObj(interp, objPtr, (long *) intPtr); #else long l; @@ -2489,18 +2758,31 @@ *---------------------------------------------------------------------- */ static void UpdateStringOfInt( - register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ + Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); TclOOM(dst, TCL_INTEGER_SPACE + 1); (void) Tcl_InitStringRep(objPtr, NULL, TclFormatInt(dst, objPtr->internalRep.wideValue)); } + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) +static void +UpdateStringOfOldInt( + Tcl_Obj *objPtr) /* Int object whose string rep to update. */ +{ + char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); + + TclOOM(dst, TCL_INTEGER_SPACE + 1); + (void) Tcl_InitStringRep(objPtr, NULL, + TclFormatInt(dst, objPtr->internalRep.longValue)); +} +#endif /* *---------------------------------------------------------------------- * * Tcl_NewLongObj -- @@ -2534,24 +2816,24 @@ #undef Tcl_NewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( - register long longValue) /* Long integer used to initialize the + long longValue) /* Long integer used to initialize the * new object. */ { return Tcl_DbNewWideIntObj(longValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewLongObj( - register long longValue) /* Long integer used to initialize the + long longValue) /* Long integer used to initialize the * new object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewIntObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2593,18 +2875,18 @@ #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( - register long longValue, /* Long integer used to initialize the new + long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep */ objPtr->bytes = NULL; @@ -2615,20 +2897,52 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewLongObj( - register long longValue, /* Long integer used to initialize the new + long longValue, /* Long integer used to initialize the new * object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewWideIntObj(longValue); } #endif /* TCL_MEM_DEBUG */ +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetLongObj -- + * + * Modify an object to be an integer object and to have the specified + * long integer value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_SetLongObj +void +Tcl_SetLongObj( + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + long longValue) /* Long integer used to initialize the + * object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); + } + + TclSetIntObj(objPtr, longValue); +} #endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * @@ -2651,12 +2965,12 @@ */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* The object from which to get a long. */ - register long *longPtr) /* Place to store resulting long. */ + Tcl_Obj *objPtr, /* The object from which to get a long. */ + long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclIntType) { *longPtr = objPtr->internalRep.wideValue; @@ -2697,16 +3011,18 @@ * when auto-narrowing is enabled. Only those values in the signed * long range get auto-narrowed to tclIntType, while all the * values in the unsigned long range will fit in a long. */ + { mp_int big; - unsigned long scratch, value = 0, numBytes = sizeof(unsigned long); + unsigned long scratch, value = 0; unsigned char *bytes = (unsigned char *) &scratch; + size_t numBytes; TclUnpackBignum(objPtr, big); - if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) { + if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { if (value <= 1 + (unsigned long)LONG_MAX) { @@ -2717,10 +3033,11 @@ if (value <= (unsigned long)ULONG_MAX) { *longPtr = (long) value; return TCL_OK; } } + } } #ifndef TCL_WIDE_INT_IS_LONG tooLarge: #endif if (interp != NULL) { @@ -2765,11 +3082,11 @@ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( - register Tcl_WideInt wideValue) + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); } @@ -2776,15 +3093,15 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewWideIntObj( - register Tcl_WideInt wideValue) + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclNewObj(objPtr); TclSetIntObj(objPtr, wideValue); return objPtr; } @@ -2824,19 +3141,19 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( - register Tcl_WideInt wideValue, + Tcl_WideInt wideValue, /* Wide integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); TclSetIntObj(objPtr, wideValue); return objPtr; } @@ -2843,17 +3160,15 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewWideIntObj( - register Tcl_WideInt wideValue, + Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewWideIntObj(wideValue); } #endif /* TCL_MEM_DEBUG */ @@ -2875,12 +3190,12 @@ *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( - register Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - register Tcl_WideInt wideValue) + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideInt wideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); @@ -2911,12 +3226,12 @@ */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr, /* Object from which to get a wide int. */ - register Tcl_WideInt *wideIntPtr) + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { if (objPtr->typePtr == &tclIntType) { *wideIntPtr = objPtr->internalRep.wideValue; @@ -2937,16 +3252,16 @@ * Tcl_WideInt, even when auto-narrowing is enabled. */ mp_int big; Tcl_WideUInt value = 0; - unsigned long numBytes = sizeof(Tcl_WideInt); + size_t numBytes; Tcl_WideInt scratch; unsigned char *bytes = (unsigned char *) &scratch; TclUnpackBignum(objPtr, big); - if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) { + if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) { @@ -3016,18 +3331,24 @@ } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { mp_int big; + mp_err err; Tcl_WideUInt value = 0, scratch; - unsigned long numBytes = sizeof(Tcl_WideInt); + size_t numBytes; unsigned char *bytes = (unsigned char *) &scratch; Tcl_GetBignumFromObj(NULL, objPtr, &big); - mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big); - mp_to_unsigned_bin_n(&big, bytes, &numBytes); + err = mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big); + if (err == MP_OKAY) { + err = mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes); + } + if (err != MP_OKAY) { + return TCL_ERROR; + } while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value; mp_clear(&big); @@ -3058,11 +3379,11 @@ mp_int toFree; /* Bignum to free */ TclUnpackBignum(objPtr, toFree); mp_clear(&toFree); if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) { - Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1); + ckfree(objPtr->internalRep.twoPtrValue.ptr1); } objPtr->typePtr = NULL; } /* @@ -3143,11 +3464,11 @@ } stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1); TclOOM(stringVal, size); - if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) { + if (MP_OKAY != mp_to_radix(&bignumVal, stringVal, size, NULL, 10)) { Tcl_Panic("conversion failure in UpdateStringOfBignum"); } (void) Tcl_InitStringRep(objPtr, NULL, size - 1); } @@ -3170,18 +3491,18 @@ #ifdef TCL_MEM_DEBUG #undef Tcl_NewBignumObj Tcl_Obj * Tcl_NewBignumObj( - mp_int *bignumValue) + void *bignumValue) { return Tcl_DbNewBignumObj(bignumValue, "unknown", 0); } #else Tcl_Obj * Tcl_NewBignumObj( - mp_int *bignumValue) + void *bignumValue) { Tcl_Obj *objPtr; TclNewObj(objPtr); Tcl_SetBignumObj(objPtr, bignumValue); @@ -3208,11 +3529,11 @@ */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBignumObj( - mp_int *bignumValue, + void *bignumValue, const char *file, int line) { Tcl_Obj *objPtr; @@ -3221,13 +3542,13 @@ return objPtr; } #else Tcl_Obj * Tcl_DbNewBignumObj( - mp_int *bignumValue, - const char *file, - int line) + void *bignumValue, + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewBignumObj(bignumValue); } #endif @@ -3263,11 +3584,13 @@ if (objPtr->typePtr == &tclBignumType) { if (copy || Tcl_IsShared(objPtr)) { mp_int temp; TclUnpackBignum(objPtr, temp); - mp_init_copy(bignumValue, &temp); + if (mp_init_copy(bignumValue, &temp) != MP_OKAY) { + return TCL_ERROR; + } } else { TclUnpackBignum(objPtr, *bignumValue); /* Optimized TclFreeIntRep */ objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; @@ -3282,12 +3605,14 @@ } } return TCL_OK; } if (objPtr->typePtr == &tclIntType) { - TclInitBignumFromWideInt(bignumValue, - objPtr->internalRep.wideValue); + if (mp_init_i64(bignumValue, + objPtr->internalRep.wideValue) != MP_OKAY) { + return TCL_ERROR; + } return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3329,13 +3654,13 @@ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - mp_int *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { - return GetBignumFromObj(interp, objPtr, 1, bignumValue); + return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue); } /* *---------------------------------------------------------------------- * @@ -3364,13 +3689,13 @@ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - mp_int *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { - return GetBignumFromObj(interp, objPtr, 0, bignumValue); + return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue); } /* *---------------------------------------------------------------------- * @@ -3389,21 +3714,22 @@ */ void Tcl_SetBignumObj( Tcl_Obj *objPtr, /* Object to set */ - mp_int *bignumValue) /* Value to store */ + void *big) /* Value to store */ { Tcl_WideUInt value = 0; - unsigned long numBytes = sizeof(Tcl_WideUInt); + size_t numBytes; Tcl_WideUInt scratch; unsigned char *bytes = (unsigned char *) &scratch; + mp_int *bignumValue = (mp_int *) big; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } - if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) { + if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) { goto tooLargeForWide; } while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } @@ -3442,12 +3768,13 @@ */ void TclSetBignumIntRep( Tcl_Obj *objPtr, - mp_int *bignumValue) + void *big) { + mp_int *bignumValue = (mp_int *)big; objPtr->typePtr = &tclBignumType; PACK_BIGNUM(*bignumValue, objPtr); /* * Clear the mp_int value. @@ -3503,11 +3830,12 @@ *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; - mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, sizeof(mp_int)); + mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey, + sizeof(mp_int)); TclUnpackBignum(objPtr, *bigPtr); *typePtr = TCL_NUMBER_BIG; *clientDataPtr = bigPtr; return TCL_OK; @@ -3577,11 +3905,11 @@ #undef Tcl_IsShared int Tcl_IsShared( Tcl_Obj *objPtr) /* The object to test for being shared. */ { - return ((objPtr)->refCount + 1 > 2); + return ((objPtr)->refCount > 1); } /* *---------------------------------------------------------------------- * @@ -3601,20 +3929,20 @@ * The object's ref count is incremented. * *---------------------------------------------------------------------- */ +#ifdef TCL_MEM_DEBUG void Tcl_DbIncrRefCount( - register Tcl_Obj *objPtr, /* The object we are registering a reference + Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { -#ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("incrementing refCount of previously disposed object"); } @@ -3639,13 +3967,23 @@ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "incr ref count"); } } # endif /* TCL_THREADS */ -#endif /* TCL_MEM_DEBUG */ + ++(objPtr)->refCount; +} +#else /* !TCL_MEM_DEBUG */ +void +Tcl_DbIncrRefCount( + Tcl_Obj *objPtr, /* The object we are registering a reference + * to. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ ++(objPtr)->refCount; } +#endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbDecrRefCount -- @@ -3664,20 +4002,20 @@ * The object's ref count is incremented. * *---------------------------------------------------------------------- */ +#ifdef TCL_MEM_DEBUG void Tcl_DbDecrRefCount( - register Tcl_Obj *objPtr, /* The object we are releasing a reference + Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { -#ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("decrementing refCount of previously disposed object"); } @@ -3702,16 +4040,28 @@ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "decr ref count"); } } # endif /* TCL_THREADS */ -#endif /* TCL_MEM_DEBUG */ + if (objPtr->refCount-- <= 1) { + TclFreeObj(objPtr); + } +} +#else /* !TCL_MEM_DEBUG */ +void +Tcl_DbDecrRefCount( + Tcl_Obj *objPtr, /* The object we are releasing a reference + * to. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +{ if (objPtr->refCount-- <= 1) { TclFreeObj(objPtr); } } +#endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbIsShared -- @@ -3732,15 +4082,20 @@ *---------------------------------------------------------------------- */ int Tcl_DbIsShared( - register Tcl_Obj *objPtr, /* The object to test for being shared. */ + Tcl_Obj *objPtr, /* The object to test for being shared. */ +#ifdef TCL_MEM_DEBUG const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ +#else + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) +#endif { #ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); @@ -3804,11 +4159,11 @@ *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( - register Tcl_HashTable *tablePtr) + Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, &tclObjHashKeyType); @@ -3830,15 +4185,15 @@ *---------------------------------------------------------------------- */ static Tcl_HashEntry * AllocObjEntry( - Tcl_HashTable *tablePtr, /* Hash table. */ + TCL_UNUSED(Tcl_HashTable *), void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - Tcl_HashEntry *hPtr = Tcl_Alloc(sizeof(Tcl_HashEntry)); + Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry)); hPtr->key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); hPtr->clientData = NULL; @@ -3865,14 +4220,14 @@ int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr; + Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; - register const char *p1, *p2; - register size_t l1, l2; + const char *p1, *p2; + size_t l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller @@ -3928,11 +4283,11 @@ Tcl_HashEntry *hPtr) /* Hash entry to free. */ { Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue; Tcl_DecrRefCount(objPtr); - Tcl_Free(hPtr); + ckfree(hPtr); } /* *---------------------------------------------------------------------- * @@ -3951,16 +4306,16 @@ *---------------------------------------------------------------------- */ TCL_HASH_TYPE TclHashObjKey( - Tcl_HashTable *tablePtr, /* Hash table. */ + TCL_UNUSED(Tcl_HashTable *), void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - const char *string = TclGetString(objPtr); - size_t length = objPtr->length; + int length; + const char *string = TclGetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all @@ -3993,11 +4348,11 @@ * See also HashString in tclLiteral.c. * * See [tcl-Feature Request #2958832] */ - if (length) { + if (length > 0) { result = UCHAR(*string); while (--length) { result += (result << 3) + UCHAR(*++string); } } @@ -4025,17 +4380,17 @@ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ - register Tcl_Obj *objPtr) /* The object containing the command's name. + Tcl_Obj *objPtr) /* The object containing the command's name. * If the name starts with "::", will be * looked up in global namespace. Else, looked * up first in the current namespace, then in * global namespace. */ { - register ResolvedCmdName *resPtr; + ResolvedCmdName *resPtr; /* * Get the internal representation, converting to a command type if * needed. The internal representation is a ResolvedCmdName that points to * the actual command. @@ -4052,18 +4407,18 @@ * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ - resPtr = objPtr->internalRep.twoPtrValue.ptr1; + resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { - register Command *cmdPtr = resPtr->cmdPtr; + Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { - register Namespace *refNsPtr = (Namespace *) + Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) && (resPtr->refNsId == refNsPtr->nsId) @@ -4080,11 +4435,11 @@ /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { return NULL; } - resPtr = objPtr->internalRep.twoPtrValue.ptr1; + resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL); } /* *---------------------------------------------------------------------- @@ -4118,11 +4473,11 @@ const char *name = TclGetString(objPtr); if (resPtr) { fillPtr = resPtr; } else { - fillPtr = Tcl_Alloc(sizeof(ResolvedCmdName)); + fillPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName)); fillPtr->refCount = 1; } fillPtr->cmdPtr = cmdPtr; cmdPtr->refCount++; @@ -4161,19 +4516,19 @@ void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ - register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a + Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { - register ResolvedCmdName *resPtr; + ResolvedCmdName *resPtr; if (objPtr->typePtr == &tclCmdNameType) { - resPtr = objPtr->internalRep.twoPtrValue.ptr1; + resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } @@ -4201,14 +4556,14 @@ *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( - register Tcl_Obj *objPtr) /* CmdName object with internal + Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { - register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; + ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; /* * Decrement the reference count of the ResolvedCmdName structure. If * there are no more uses, free the ResolvedCmdName structure. */ @@ -4221,11 +4576,11 @@ */ Command *cmdPtr = resPtr->cmdPtr; TclCleanupCommandMacro(cmdPtr); - Tcl_Free(resPtr); + ckfree(resPtr); } objPtr->typePtr = NULL; } /* @@ -4249,13 +4604,13 @@ */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; + ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; resPtr->refCount++; copyPtr->typePtr = &tclCmdNameType; @@ -4283,15 +4638,15 @@ */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; - register Command *cmdPtr; - register ResolvedCmdName *resPtr; + Command *cmdPtr; + ResolvedCmdName *resPtr; if (interp == NULL) { return TCL_ERROR; } @@ -4314,11 +4669,11 @@ if (cmdPtr == NULL) { return TCL_ERROR; } - resPtr = objPtr->internalRep.twoPtrValue.ptr1; + resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) { /* * Re-use existing ResolvedCmdName struct when possible. * Cleanup the old fields that need it. */ @@ -4352,11 +4707,11 @@ *---------------------------------------------------------------------- */ int Tcl_RepresentationCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *descObj; @@ -4370,11 +4725,11 @@ * Value is a bignum with a refcount of 14, object pointer at 0x12345678, * internal representation 0x45671234:0x98765432, string representation * "1872361827361287" */ - descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u," + descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); if (objv[1]->typePtr) { Index: generic/tclOptimize.c ================================================================== --- generic/tclOptimize.c +++ generic/tclOptimize.c @@ -32,11 +32,11 @@ #define IsTargetAddress(tablePtr, address) \ (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL) #define AddrLength(address) \ (tclInstructionTable[*(unsigned char *)(address)].numBytes) #define InstLength(instruction) \ - (tclInstructionTable[(unsigned char)(instruction)].numBytes) + (tclInstructionTable[UCHAR(instruction)].numBytes) /* * ---------------------------------------------------------------------- * * LocateTargetAddresses -- @@ -229,11 +229,11 @@ blank = size + InstLength(nextInst); } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); - size_t numBytes; + int numBytes; (void) TclGetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } @@ -244,11 +244,11 @@ blank = size + 1; } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); - size_t numBytes; + int numBytes; (void) TclGetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } @@ -285,10 +285,12 @@ case INST_INCR_SCALAR1: case INST_INCR_ARRAY1: case INST_INCR_ARRAY_STK: case INST_INCR_SCALAR_STK: case INST_INCR_STK: + case INST_LOR: + case INST_LAND: case INST_EQ: case INST_NEQ: case INST_LT: case INST_LE: case INST_GT: @@ -425,13 +427,13 @@ void TclOptimizeBytecode( void *envPtr) { - ConvertZeroEffectToNOP(envPtr); - AdvanceJumps(envPtr); - TrimUnreachable(envPtr); + ConvertZeroEffectToNOP((CompileEnv *)envPtr); + AdvanceJumps((CompileEnv *)envPtr); + TrimUnreachable((CompileEnv *)envPtr); } /* * Local Variables: * mode: c Index: generic/tclPanic.c ================================================================== --- generic/tclPanic.c +++ generic/tclPanic.c @@ -13,19 +13,23 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #if defined(_WIN32) || defined(__CYGWIN__) - MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); + MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); #endif /* * The panicProc variable contains a pointer to an application specific panic * procedure. */ +#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)) +static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic; +#else static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; +#endif /* *---------------------------------------------------------------------- * * Tcl_SetPanicProc -- @@ -43,12 +47,85 @@ void Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *proc) { +#if defined(_WIN32) + /* tclWinDebugPanic only installs if there is no panicProc yet. */ + if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL)) +#elif defined(__CYGWIN__) + if (proc == NULL) + panicProc = tclWinDebugPanic; + else +#endif panicProc = proc; - TclInitSubsystems(); + Tcl_InitSubsystems(); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_PanicVA -- + * + * Print an error message and kill the process. + * + * Results: + * None. + * + * Side effects: + * The process dies, entering the debugger if possible. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_PanicVA( + const char *format, /* Format string, suitable for passing to + * fprintf. */ + va_list argList) /* Variable argument list. */ +{ + char *arg1, *arg2, *arg3; /* Additional arguments (variable in number) + * to pass to fprintf. */ + char *arg4, *arg5, *arg6, *arg7, *arg8; + + arg1 = va_arg(argList, char *); + arg2 = va_arg(argList, char *); + arg3 = va_arg(argList, char *); + arg4 = va_arg(argList, char *); + arg5 = va_arg(argList, char *); + arg6 = va_arg(argList, char *); + arg7 = va_arg(argList, char *); + arg8 = va_arg(argList, char *); + + if (panicProc != NULL) { + panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +#ifdef _WIN32 + } else if (IsDebuggerPresent()) { + tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +#endif + } else { + fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, + arg8); + fprintf(stderr, "\n"); + fflush(stderr); +#if defined(_WIN32) || defined(__CYGWIN__) +# if defined(__GNUC__) + __builtin_trap(); +# elif defined(_WIN64) + __debugbreak(); +# elif defined(_MSC_VER) && defined (_M_IX86) + _asm {int 3} +# else + DebugBreak(); +# endif +#endif +#if defined(_WIN32) + ExitProcess(1); +#else + abort(); +#endif + } } /* *---------------------------------------------------------------------- * @@ -63,11 +140,10 @@ * The process dies, entering the debugger if possible. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ /* * The following comment is here so that Coverity's static analizer knows that * a Tcl_Panic() call can never return and avoids lots of false positives. */ @@ -76,56 +152,18 @@ Tcl_Panic( const char *format, ...) { va_list argList; - char *arg1, *arg2, *arg3; /* Additional arguments (variable in number) - * to pass to fprintf. */ - char *arg4, *arg5, *arg6, *arg7, *arg8; - va_start(argList, format); - arg1 = va_arg(argList, char *); - arg2 = va_arg(argList, char *); - arg3 = va_arg(argList, char *); - arg4 = va_arg(argList, char *); - arg5 = va_arg(argList, char *); - arg6 = va_arg(argList, char *); - arg7 = va_arg(argList, char *); - arg8 = va_arg(argList, char *); + Tcl_PanicVA(format, argList); va_end (argList); - - if (panicProc != NULL) { - panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); - } else { -#if defined(_WIN32) || defined(__CYGWIN__) - tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#else - fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, - arg8); - fprintf(stderr, "\n"); - fflush(stderr); -#endif -# if defined(__GNUC__) - __builtin_trap(); -# elif defined(_WIN64) - __debugbreak(); -# elif defined(_MSC_VER) && defined (_M_IX86) - _asm {int 3} -# elif defined(_WIN32) - DebugBreak(); -# endif -#if defined(_WIN32) - ExitProcess(1); -#else - abort(); -#endif - } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclParse.c ================================================================== --- generic/tclParse.c +++ generic/tclParse.c @@ -117,19 +117,21 @@ /* * Prototypes for local functions defined in this file: */ -static inline int CommandComplete(const char *script, size_t numBytes); -static size_t ParseComment(const char *src, size_t numBytes, +static inline int CommandComplete(const char *script, int numBytes); +static int ParseComment(const char *src, int numBytes, Tcl_Parse *parsePtr); -static int ParseTokens(const char *src, size_t numBytes, int mask, +static int ParseTokens(const char *src, int numBytes, int mask, int flags, Tcl_Parse *parsePtr); -static size_t ParseWhiteSpace(const char *src, size_t numBytes, +static int ParseWhiteSpace(const char *src, int numBytes, int *incompletePtr, char *typePtr); -static size_t ParseAllWhiteSpace(const char *src, size_t numBytes, +static int ParseAllWhiteSpace(const char *src, int numBytes, int *incompletePtr); +static int ParseHex(const char *src, int numBytes, + int *resultPtr); /* *---------------------------------------------------------------------- * * TclParseInit -- @@ -147,11 +149,11 @@ void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ const char *start, /* Start of string to be parsed. */ - size_t numBytes, /* Total number of bytes in string. If -1, + int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Points to struct to initialize */ { parsePtr->numWords = 0; @@ -193,11 +195,11 @@ Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ - size_t numBytes, /* Total number of bytes in string. If -1, + int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: * close bracket should be considered a * command terminator. If zero, then close @@ -205,32 +207,32 @@ Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { - const char *src; /* Points to current character in the + const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ - size_t scanned; + int scanned; + if (numBytes < 0 && start) { + numBytes = strlen(start); + } + TclParseInit(interp, start, numBytes, parsePtr); if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't parse a NULL pointer", -1)); } return TCL_ERROR; } - if (numBytes == TCL_AUTO_LENGTH) { - numBytes = strlen(start); - } - TclParseInit(interp, start, numBytes, parsePtr); parsePtr->commentStart = NULL; parsePtr->commentSize = 0; parsePtr->commandStart = NULL; parsePtr->commandSize = 0; if (nested != 0) { @@ -342,11 +344,11 @@ expPtr = &parsePtr->tokenPtr[expIdx]; if ((0 == expandWord) /* Haven't seen prefix already */ && (1 == parsePtr->numTokens - expIdx) /* Only one token */ - && (((1 == expPtr->size) + && (((1 == (size_t) expPtr->size) /* Same length as prefix */ && (expPtr->start[0] == '*'))) /* Is the prefix */ && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr, numBytes, &parsePtr->incomplete, &type)) @@ -377,12 +379,11 @@ tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->size = src - tokenPtr->start; tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); if (expandWord) { - size_t i; - int isLiteral = 1; + int i, isLiteral = 1; /* * When a command includes a word that is an expanded literal; for * example, {*}{1 2 3}, the parser performs that expansion * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead @@ -424,11 +425,11 @@ * Step through the literal string, parsing and counting list * elements. */ while (nextElem < listEnd) { - size_t size; + int size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); if ((code != TCL_OK) || !literal) { break; @@ -616,21 +617,21 @@ * None. * *---------------------------------------------------------------------- */ -static size_t +static int ParseWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of bytes to scan. */ + int numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type * of character that ends run of whitespace */ { - register char type = TYPE_NORMAL; - register const char *p = src; + char type = TYPE_NORMAL; + const char *p = src; while (1) { while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { numBytes--; p++; @@ -670,41 +671,41 @@ * Returns the number of bytes recognized as white space. * *---------------------------------------------------------------------- */ -static size_t +static int ParseAllWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of byes to scan */ + int numBytes, /* Max number of byes to scan */ int *incompletePtr) /* Set true if parse is incomplete. */ { char type; const char *p = src; do { - size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); + int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); p += scanned; numBytes -= scanned; } while (numBytes && (*p == '\n') && (p++, --numBytes)); return (p-src); } -size_t +int TclParseAllWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes) /* Max number of byes to scan */ + int numBytes) /* Max number of byes to scan */ { int dummy; return ParseAllWhiteSpace(src, numBytes, &dummy); } /* *---------------------------------------------------------------------- * - * TclParseHex -- + * ParseHex -- * * Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing * \x and \u escape sequences). At most numBytes bytes are scanned. * * Results: @@ -720,24 +721,24 @@ * *---------------------------------------------------------------------- */ int -TclParseHex( +ParseHex( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of byes to scan */ - int *resultPtr) /* Points to storage provided by caller where + int numBytes, /* Max number of byes to scan */ + int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { int result = 0; - register const char *p = src; + const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); - if (!isxdigit(digit) || (result > 0x10fff)) { + if (!isxdigit(digit) || (result > 0x10FFF)) { break; } p++; result <<= 4; @@ -778,22 +779,21 @@ int TclParseBackslash( const char *src, /* Points to the backslash character of a a * backslash sequence. */ - size_t numBytes, /* Max number of bytes to scan. */ - size_t *readPtr, /* NULL, or points to storage where the number + int numBytes, /* Max number of bytes to scan. */ + int *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be - * written. At most TCL_UTF_MAX bytes will be - * written there. */ + * written. At most 4 bytes will be written there. */ { - register const char *p = src+1; + const char *p = src+1; Tcl_UniChar unichar = 0; int result; - size_t count; + int count; char buf[4] = ""; if (numBytes == 0) { if (readPtr != NULL) { *readPtr = 0; @@ -816,11 +816,11 @@ } count = 2; switch (*p) { /* - * Note: in the conversions below, use absolute values (e.g., 0xa) + * Note: in the conversions below, use absolute values (e.g., 0xA) * rather than symbolic values (e.g. \n) that get converted by the * compiler. It's possible that compilers on some platforms will do * the symbolic conversions differently, which could result in * non-portable Tcl scripts. */ @@ -830,26 +830,26 @@ break; case 'b': result = 0x8; break; case 'f': - result = 0xc; + result = 0xC; break; case 'n': - result = 0xa; + result = 0xA; break; case 'r': - result = 0xd; + result = 0xD; break; case 't': result = 0x9; break; case 'v': - result = 0xb; + result = 0xB; break; case 'x': - count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result); + count += ParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result); if (count == 2) { /* * No hexdigits -> This is just "x". */ @@ -856,29 +856,42 @@ result = 'x'; } else { /* * Keep only the last byte (2 hex digits). */ - result = (unsigned char) result; + result = UCHAR(result); } break; case 'u': - count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result); + count += ParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result); if (count == 2) { /* * No hexdigits -> This is just "u". */ result = 'u'; + } else if (((result & 0xFC00) == 0xD800) && (count == 6) + && (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) { + /* If high surrogate is immediately followed by a low surrogate + * escape, combine them into one character. */ + int low; + int count2 = ParseHex(p+7, 4, &low); + if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) { + result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000; + count += count2 + 2; + } } break; case 'U': - count += TclParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result); + count += ParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result); if (count == 2) { /* * No hexdigits -> This is just "U". */ result = 'U'; + } else if ((result | 0x7FF) == 0xDFFF) { + /* Upper or lower surrogate, not allowed in this syntax. */ + result = 0xFFFD; } break; case '\n': count--; do { @@ -923,11 +936,11 @@ */ if (Tcl_UtfCharComplete(p, numBytes - 1)) { count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */ } else { - char utfBytes[TCL_UTF_MAX]; + char utfBytes[4]; memcpy(utfBytes, p, numBytes - 1); utfBytes[numBytes - 1] = '\0'; count = TclUtfToUniChar(utfBytes, &unichar) + 1; } @@ -963,23 +976,23 @@ * None. * *---------------------------------------------------------------------- */ -static size_t +static int ParseComment( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of bytes to scan. */ + int numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { - register const char *p = src; + const char *p = src; int incomplete = parsePtr->incomplete; while (numBytes) { - size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); + int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; if ((numBytes == 0) || (*p != '#')) { break; @@ -1038,12 +1051,12 @@ *---------------------------------------------------------------------- */ static int ParseTokens( - register const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of bytes to scan. */ + const char *src, /* First character to parse. */ + int numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in * mask. */ int flags, /* OR-ed bits indicating what substitutions to @@ -1130,11 +1143,11 @@ * parse information. */ src++; numBytes--; - nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); + nestedPtr = (Tcl_Parse *)TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); while (1) { const char *curEnd; if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, nestedPtr) != TCL_OK) { @@ -1279,11 +1292,11 @@ Tcl_FreeParse( Tcl_Parse *parsePtr) /* Structure that was filled in by a previous * call to Tcl_ParseCommand. */ { if (parsePtr->tokenPtr != parsePtr->staticTokens) { - Tcl_Free(parsePtr->tokenPtr); + ckfree(parsePtr->tokenPtr); parsePtr->tokenPtr = parsePtr->staticTokens; } } /* @@ -1317,11 +1330,11 @@ Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ - size_t numBytes, /* Total number of bytes in string. If -1, + int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the variable name. */ int append) /* Non-zero means append tokens to existing @@ -1328,23 +1341,22 @@ * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ { Tcl_Token *tokenPtr; - register const char *src; + const char *src; int varIndex; unsigned array; - if ((numBytes == 0) || (start == NULL)) { - return TCL_ERROR; - } - if (numBytes == TCL_AUTO_LENGTH) { + if (numBytes < 0 && start) { numBytes = strlen(start); } - if (!append) { TclParseInit(interp, start, numBytes, parsePtr); + } + if ((numBytes == 0) || (start == NULL)) { + return TCL_ERROR; } /* * Generate one token for the variable, an additional token for the name, * plus any number of additional tokens for the index, if there is one. @@ -1510,19 +1522,19 @@ */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ - register const char *start, /* Start of variable substitution. First + const char *start, /* Start of variable substitution. First * character must be "$". */ const char **termPtr) /* If non-NULL, points to word to fill in with * character just after last one in the * variable specifier. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; int code; - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); return NULL; } @@ -1595,14 +1607,14 @@ Tcl_ParseBraces( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ - size_t numBytes, /* Total number of bytes in string. If -1, + int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ - register Tcl_Parse *parsePtr, + Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and @@ -1611,24 +1623,22 @@ * store a pointer to the character just after * the terminating '}' if the parse was * successful. */ { Tcl_Token *tokenPtr; - register const char *src; - int startIndex, level; - size_t length; + const char *src; + int startIndex, level, length; + if (numBytes < 0 && start) { + numBytes = strlen(start); + } + if (!append) { + TclParseInit(interp, start, numBytes, parsePtr); + } if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } - if (numBytes == TCL_AUTO_LENGTH) { - numBytes = strlen(start); - } - - if (!append) { - TclParseInit(interp, start, numBytes, parsePtr); - } src = start; startIndex = parsePtr->numTokens; TclGrowParseTokenArray(parsePtr, 1); @@ -1738,11 +1748,11 @@ * aren't performing a full Tcl parse, just look for an open brace * preceded by a '#' on the same line. */ { - register int openBrace = 0; + int openBrace = 0; while (--src > start) { switch (*src) { case '{': openBrace = 1; @@ -1749,11 +1759,11 @@ break; case '\n': openBrace = 0; break; case '#' : - if (openBrace && TclIsSpaceProc(src[-1])) { + if (openBrace && TclIsSpaceProcM(src[-1])) { Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp), ": possible unbalanced brace in comment", -1); goto error; } break; @@ -1798,14 +1808,14 @@ Tcl_ParseQuotedString( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ - size_t numBytes, /* Total number of bytes in string. If -1, + int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ - register Tcl_Parse *parsePtr, + Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and @@ -1813,19 +1823,18 @@ const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the quoted string's terminating close-quote * if the parse succeeds. */ { - if ((numBytes == 0) || (start == NULL)) { - return TCL_ERROR; - } - if (numBytes == TCL_AUTO_LENGTH) { + if (numBytes < 0 && start) { numBytes = strlen(start); } - if (!append) { TclParseInit(interp, start, numBytes, parsePtr); + } + if ((numBytes == 0) || (start == NULL)) { + return TCL_ERROR; } if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL, parsePtr)) { goto error; @@ -1880,16 +1889,16 @@ void TclSubstParse( Tcl_Interp *interp, const char *bytes, - size_t numBytes, + int numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr) { - size_t length = numBytes; + int length = numBytes; const char *p = bytes; TclParseInit(interp, p, length, parsePtr); /* @@ -2000,11 +2009,11 @@ * to claim for the final TCL_TOKEN_COMMAND token. */ Tcl_Token *tokenPtr; const char *lastTerm = parsePtr->term; - Tcl_Parse *nestedPtr = + Tcl_Parse *nestedPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); while (TCL_OK == Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) { Tcl_FreeParse(nestedPtr); @@ -2142,11 +2151,11 @@ } } if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = Tcl_Alloc(maxNumCL * sizeof(int)); + clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); } adjust = 0; result = NULL; for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { @@ -2182,21 +2191,21 @@ */ if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && (tokenPtr->start[1] == '\n')) { if (isLiteral) { - size_t clPos; + int clPos; if (result == 0) { clPos = 0; } else { - (void)TclGetStringFromObj(result, &clPos); + TclGetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = Tcl_Realloc(clPosition, + clPosition = (int *)ckrealloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; numCL++; } @@ -2350,11 +2359,11 @@ * Release the temp table we used to collect the locations of * continuation lines, if any. */ if (maxNumCL) { - Tcl_Free(clPosition); + ckfree(clPosition); } } else { Tcl_ResetResult(interp); } } @@ -2388,11 +2397,11 @@ */ static inline int CommandComplete( const char *script, /* Script to check. */ - size_t numBytes) /* Number of bytes in script. */ + int numBytes) /* Number of bytes in script. */ { Tcl_Parse parse; const char *p, *end; int result; @@ -2462,11 +2471,11 @@ int TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - size_t length; + int length; const char *script = TclGetStringFromObj(objPtr, &length); return CommandComplete(script, length); } Index: generic/tclPathObj.c ================================================================== --- generic/tclPathObj.c +++ generic/tclPathObj.c @@ -23,11 +23,11 @@ static void DupFsPathInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static size_t FindSplitPos(const char *path, int separator); +static int FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, Tcl_Obj *pathPtr); @@ -45,46 +45,30 @@ }; /* * struct FsPath -- * - * Internal representation of a Tcl_Obj of "path" type. This can be used to - * represent relative or absolute paths, and has certain optimisations when - * used to represent paths which are already normalized and absolute. - * - * There are two cases, with the first being the most common: - * - * (i) flags == 0, => Ordinary path. - * - * translatedPathPtr contains the translated path. If it is NULL then the path - * is pure normalized. cwdPtr is null for an absolute path, and non-null for a - * relative path (unless the cwd has never been set, in which case the cwdPtr - * may also be null for a relative path). - * - * (ii) flags != 0, => Special path, see TclNewFSPathObj - * - * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir - * and normPathPtr is the $tail. - * + * Internal representation of a Tcl_Obj of fsPathType */ -typedef struct { - Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this - * is NULL, then this is a pure normalized, - * absolute path object, in which the parent - * Tcl_Obj's string rep is already both - * translated and normalized. */ - Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or - * ~user sequences. */ - Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points - * to the cwd object used for this path. We - * have a refCount on the object. */ +typedef struct FsPath { + Tcl_Obj *translatedPathPtr; /* If the path has been normalized (flags == + * 0), this is NULL. Otherwise it is a path + * in which any ~user sequences have been + * translated away. */ + Tcl_Obj *normPathPtr; /* If the path has been normalized (flags == + * 0), this is an absolute path without ., .. + * or ~user components. Otherwise it is a + * path, possibly absolute, to normalize + * relative to cwdPtr. */ + Tcl_Obj *cwdPtr; /* If NULL, either translatedPtr exists or + * normPathPtr exists and is absolute. */ int flags; /* Flags to describe interpretation - see * below. */ ClientData nativePathPtr; /* Native representation of this path, which * is filesystem dependent. */ - size_t filesystemEpoch; /* Used to ensure the path representation was + int filesystemEpoch; /* Used to ensure the path representation was * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */ } FsPath; @@ -129,21 +113,21 @@ * defined. * * pathPtr may have a refCount of zero, or may be a shared object. * * Results: - * The result is returned in a Tcl_Obj with a refCount of 1, which is - * therefore owned by the caller. It must be freed (with - * Tcl_DecrRefCount) by the caller when no longer needed. + * The result is returned in a Tcl_Obj with a refCount already + * incremented, which gives the caller ownership of it. The caller must + * arrange for Tcl_DecRefCount to be called when the object is no-longer + * needed. * * Side effects: * None (beyond the memory allocation for the result). * * Special note: - * This code was originally based on code from Matt Newman and - * Jean-Claude Wippler, but has since been totally rewritten by Vince - * Darley to deal with symbolic links. + * Originally based on code from Matt Newman and Jean-Claude Wippler. + * Totally rewritten later by Vince Darley to handle symbolic links. * *--------------------------------------------------------------------------- */ Tcl_Obj * @@ -219,18 +203,18 @@ again: if (IsSeparatorOrNull(dirSep[2])) { /* * Need to skip '.' in the path. */ - size_t curLen; + int curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - (void)TclGetStringFromObj(retVal, &curLen); + TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } dirSep += 2; oldDirSep = dirSep; @@ -239,11 +223,11 @@ } continue; } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; - size_t curLen; + int curLen; char *linkStr; /* * Have '..' so need to skip previous directory. */ @@ -252,11 +236,11 @@ const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - (void)TclGetStringFromObj(retVal, &curLen); + TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { linkObj = Tcl_FSLink(retVal, NULL, 0); @@ -285,11 +269,11 @@ */ const char *path = TclGetStringFromObj(retVal, &curLen); - while (curLen-- > 0) { + while (--curLen >= 0) { if (IsSeparatorOrNull(path[curLen])) { break; } } @@ -318,11 +302,11 @@ /* * Convert to forward-slashes on windows. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - size_t i; + int i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { linkStr[i] = '/'; } @@ -336,11 +320,11 @@ /* * Either way, we now remove the last path element (but * not the first character of the path). */ - while (curLen-- > 0) { + while (--curLen >= 0) { if (IsSeparatorOrNull(linkStr[curLen])) { if (curLen) { Tcl_SetObjLength(retVal, curLen); } else { Tcl_SetObjLength(retVal, 1); @@ -398,11 +382,11 @@ /* * Ensure a windows drive like C:/ has a trailing separator. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - size_t len; + int len; const char *path = TclGetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { TclDecrRefCount(retVal); @@ -572,12 +556,13 @@ * part with the dirname of the joined-on bit. We could handle * that special case here, but we don't, and instead just use * the standardPath code. */ - size_t numBytes; - const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + int numBytes; + const char *rest = + TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } /* @@ -609,12 +594,13 @@ * it. If so, the 'tail' would be only the part following the * last delimiter. We could handle that special case here, but * we don't, and instead just use the standardPath code. */ - size_t numBytes; - const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + int numBytes; + const char *rest = + TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; } /* @@ -637,11 +623,11 @@ } case TCL_PATH_EXTENSION: return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; - size_t length; + int length; fileName = TclGetStringFromObj(fsPathPtr->normPathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { @@ -660,11 +646,11 @@ * the tail. */ Tcl_Obj *resultPtr = TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, - length - strlen(extension)); + (int)(length - strlen(extension))); Tcl_IncrRefCount(resultPtr); return resultPtr; } } @@ -688,31 +674,30 @@ standardPath: resultPtr = NULL; if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { - size_t length; + int length; const char *fileName, *extension; fileName = TclGetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); return pathPtr; } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, - length - strlen(extension)); + (int) (length - strlen(extension))); Tcl_IncrRefCount(root); return root; } } /* - * The behaviour we want here is slightly different to the standard * Tcl_FSSplitPath in the handling of home directories; - * Tcl_FSSplitPath preserves the "~" while this code computes the + * Tcl_FSSplitPath preserves the "~", but this code computes the * actual full path name, if we had just a single component. */ splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); @@ -867,11 +852,11 @@ * object which can be normalized more efficiently. Currently we only * use the special case when we have exactly two elements, but we * could expand that in the future. * * Bugfix [a47641a0]. TclNewFSPathObj requires first argument - * to be an absolute path. Added a check for that elt is absolute. + * to be an absolute path. Added a check to ensure that elt is absolute. */ if ((eltIr) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { @@ -881,11 +866,11 @@ /* if forceRelative - second path is relative */ type = forceRelative ? TCL_PATH_RELATIVE : TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; - size_t len; + int len; str = TclGetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. @@ -912,11 +897,11 @@ * all backslashes to forward slashes, so the base part * cannot have backslashes either. */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) - || (strchr(TclGetString(elt), '\\') == NULL)) { + || (strchr(Tcl_GetString(elt), '\\') == NULL)) { if (PATHFLAGS(elt)) { return TclNewFSPathObj(elt, str, len); } if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) { @@ -948,12 +933,11 @@ } assert ( res == NULL ); for (i = 0; i < elements; i++) { - int driveNameLength; - size_t strEltLen, length; + int driveNameLength, strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; @@ -1097,13 +1081,13 @@ } } if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - (void)TclGetStringFromObj(res, &length); + TclGetStringFromObj(res, &length); } - Tcl_SetObjLength(res, length + strlen(strElt)); + Tcl_SetObjLength(res, length + (int) strlen(strElt)); ptr = TclGetString(res) + length; for (; *strElt != '\0'; strElt++) { if (*strElt == separator) { while (strElt[1] == separator) { @@ -1201,11 +1185,11 @@ * Helper function for SetFsPathFromAny. Returns position of first directory * delimiter in the path. If no separator is found, then returns the position * of the end of the string. */ -static size_t +static int FindSplitPos( const char *path, int separator) { int count = 0; @@ -1255,11 +1239,11 @@ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, - size_t len) + int len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; const char *p; int state = 0, count = 0; @@ -1287,11 +1271,11 @@ Tcl_DecrRefCount(tail); return pathPtr; } pathPtr = Tcl_NewObj(); - fsPathPtr = Tcl_Alloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); /* * Set up the path. */ @@ -1312,16 +1296,16 @@ * Look for path components made up of only "." * This is overly conservative analysis to keep simple. It may mark some * things as needing more aggressive normalization that don't actually * need it. No harm done. */ - for (p = addStrRep; len+1 > 1; p++, len--) { + for (p = addStrRep; len > 0; p++, len--) { switch (state) { case 0: /* So far only "." since last dirsep or start */ switch (*p) { case '.': - count = 1; + count++; break; case '/': case '\\': case ':': if (count) { @@ -1354,24 +1338,24 @@ static Tcl_Obj * AppendPath( Tcl_Obj *head, Tcl_Obj *tail) { + int numBytes; const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); - size_t length; /* * This is likely buggy when dealing with virtual filesystem drivers * that use some character other than "/" as a path separator. I know * of no evidence that such a foolish thing exists. This solution was * chosen so that "JoinPath" operations that pass through either path * intrep produce the same results; that is, bugward compatibility. If * we need to fix that bug here, it needs fixing in TclJoinPath() too. */ - bytes = TclGetStringFromObj(tail, &length); - if (length == 0) { + bytes = TclGetStringFromObj(tail, &numBytes); + if (numBytes == 0) { Tcl_AppendToObj(copy, "/", 1); } else { TclpNativeJoinPath(copy, bytes); } return copy; @@ -1399,15 +1383,15 @@ *--------------------------------------------------------------------------- */ Tcl_Obj * TclFSMakePathRelative( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { - size_t cwdLen, len; + int cwdLen, len; const char *tempStr; Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); @@ -1470,20 +1454,20 @@ *--------------------------------------------------------------------------- */ static int MakePathFromNormalized( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; if (TclHasIntRep(pathPtr, &fsPathType)) { return TCL_OK; } - fsPathPtr = Tcl_Alloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. */ @@ -1505,20 +1489,20 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSNewNativePath -- * - * This function performs the something like the reverse of the usual + * Performs the something like the reverse of the usual * obj->path->nativerep conversions. If some code retrieves a path in * native form (from, e.g. readlink or a native dialog), and that path is * to be used at the Tcl level, then calling this function is an * efficient way of creating the appropriate path object type. * * Any memory which is allocated for 'clientData' should be retained * until clientData is passed to the filesystem's freeInternalRepProc * when it can be freed. The built in platform-specific filesystems use - * 'Tcl_Alloc' to allocate clientData, and Tcl_Free to free it. + * 'ckalloc' to allocate clientData, and ckfree to free it. * * Results: * NULL or a valid path object pointer, with refCount zero. * * Side effects: @@ -1547,11 +1531,11 @@ * Free old representation; shouldn't normally be any, but best to be * safe. */ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); - fsPathPtr = Tcl_Alloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr)); fsPathPtr->cwdPtr = NULL; @@ -1568,20 +1552,22 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSGetTranslatedPath -- * - * This function attempts to extract the translated path from the given + * Attempts to extract the translated path from the given * Tcl_Obj. If the translation succeeds (i.e. the object is a valid - * path), then it is returned. Otherwise NULL will be returned, and an - * error message may be left in the interpreter (if it is non-NULL) + * path), then it is returned. Otherwise NULL is returned and an + * error message may be left in the interpreter if it is not NULL. * * Results: - * NULL or a valid Tcl_Obj pointer. + * A Tcl_Obj pointer or NULL. * * Side effects: - * Only those of 'Tcl_FSConvertToPathType' + * pathPtr is converted to fsPathType if necessary. + * + * FsPath members are modified as needed. * *--------------------------------------------------------------------------- */ Tcl_Obj * @@ -1595,11 +1581,16 @@ if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { - if (PATHFLAGS(pathPtr) != 0) { + if (PATHFLAGS(pathPtr) == 0) { + /* + * Path is already normalized + */ + retObj = srcFsPathPtr->normPathPtr; + } else { /* * We lack a translated path result, but we have a directory * (cwdPtr) and a tail (normPathPtr), and if we join the * translated version of cwdPtr to normPathPtr, we'll get the * translated result we need, and can store it for future use. @@ -1622,18 +1613,10 @@ = PATHOBJ(translatedCwdPtr)->filesystemEpoch; } else { srcFsPathPtr->filesystemEpoch = 0; } Tcl_DecrRefCount(translatedCwdPtr); - } else { - /* - * It is a pure absolute, normalized path object. This is - * something like being a 'pure list'. The object's string, - * translatedPath and normalizedPath are all identical. - */ - - retObj = srcFsPathPtr->normPathPtr; } } else { /* * It is an ordinary path object. */ @@ -1672,13 +1655,13 @@ Tcl_Obj *pathPtr) { Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - size_t len; + int len; const char *orig = TclGetStringFromObj(transPtr, &len); - char *result = Tcl_Alloc(len+1); + char *result = (char *)ckalloc(len+1); memcpy(result, orig, len+1); TclDecrRefCount(transPtr); return result; } @@ -1722,22 +1705,21 @@ * This is a special path object which is the result of something like * 'file join' */ Tcl_Obj *dir, *copy; - size_t tailLen, cwdLen; - int pathType; + int tailLen, cwdLen, pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); if (dir == NULL) { return NULL; } /* TODO: Figure out why this is needed. */ TclGetString(pathPtr); - (void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { copy = Tcl_DuplicateObj(dir); } @@ -1798,27 +1780,18 @@ Tcl_IncrRefCount(fsPathPtr->cwdPtr); TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; - /* - * That's our reference to copy used. - */ - copy = NULL; - TclDecrRefCount(dir); TclDecrRefCount(origDir); } else { TclDecrRefCount(fsPathPtr->cwdPtr); fsPathPtr->cwdPtr = NULL; TclDecrRefCount(fsPathPtr->normPathPtr); fsPathPtr->normPathPtr = copy; - /* - * That's our reference to copy used. - */ - copy = NULL; TclDecrRefCount(dir); } PATHFLAGS(pathPtr) = 0; } @@ -1833,17 +1806,17 @@ if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { - size_t cwdLen; + int cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); - cwdLen += (TclGetString(copy)[cwdLen] == '/'); + cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end * of the previously normalized 'dir'. This should be much faster! */ @@ -1855,11 +1828,11 @@ } if (fsPathPtr->normPathPtr == NULL) { Tcl_Obj *useThisCwd = NULL; /* - * Since normPathPtr is NULL, but this is a valid path object, we know + * Since normPathPtr is NULL but this is a valid path object, we know * that the translatedPathPtr cannot be NULL. */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; const char *path = TclGetString(absolutePath); @@ -1955,23 +1928,27 @@ /* *--------------------------------------------------------------------------- * * Tcl_FSGetInternalRep -- * - * Extract the internal representation of a given path object, in the - * given filesystem. If the path object belongs to a different - * filesystem, we return NULL. + * Produces a native representation of a given path object in the given + * filesystem. * - * If the internal representation is currently NULL, we attempt to - * generate it, by calling the filesystem's - * 'Tcl_FSCreateInternalRepProc'. + * In the future it might be desirable to have separate versions + * of this function with different signatures, for example + * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since + * native paths are all string based, we use just one function. * * Results: - * NULL or a valid internal representation. + * + * The native handle for the path, or NULL if the path is not handled by + * the given filesystem * * Side effects: - * An attempt may be made to convert the object. + * + * Tcl_FSCreateInternalRepProc if needed to produce the native + * handle, which is then stored in the internal representation of pathPtr. * *--------------------------------------------------------------------------- */ ClientData @@ -1985,53 +1962,40 @@ return NULL; } srcFsPathPtr = PATHOBJ(pathPtr); /* - * We will only return the native representation for the caller's - * filesystem. Otherwise we will simply return NULL. This means that there - * must be a unique bi-directional mapping between paths and filesystems, - * and that this mapping will not allow 'remapped' files -- files which - * are in one filesystem but mapped into another. Another way of putting - * this is that 'stacked' filesystems are not allowed. We recognise that - * this is a potentially useful feature for the future. - * - * Even something simple like a 'pass through' filesystem which logs all - * activity and passes the calls onto the native system would be nice, but - * not easily achievable with the current implementation. - */ - - if (srcFsPathPtr->fsPtr == NULL) { - /* - * This only usually happens in wrappers like TclpStat which create a - * string object and pass it to TclpObjStat. Code which calls the - * Tcl_FS.. functions should always have a filesystem already set. - * Whether this code path is legal or not depends on whether we decide - * to allow external code to call the native filesystem directly. It - * is at least safer to allow this sub-optimal routing. - */ - - Tcl_FSGetFileSystemForPath(pathPtr); - - /* - * If we fail through here, then the path is probably not a valid path - * in the filesystsem, and is most likely to be a use of the empty - * path "" via a direct call to one of the objectified interfaces - * (e.g. from the Tcl testsuite). - */ - - srcFsPathPtr = PATHOBJ(pathPtr); - if (srcFsPathPtr->fsPtr == NULL) { + * Currently there must be a unique bi-directional mapping between a path + * and a filesystem, and therefore there is no way to "remap" a file, i.e., + * to map a file in one filesystem into another. Another way of putting + * this is that 'stacked' filesystems are not allowed. It could be useful + * in the future to redesign the system to allow that. + * + * Even something simple like a 'pass through' filesystem which logs all + * activity and passes the calls onto the native system would be nice, but + * not currently easily achievable. + */ + + if (srcFsPathPtr->fsPtr == NULL) { + Tcl_FSGetFileSystemForPath(pathPtr); + + srcFsPathPtr = PATHOBJ(pathPtr); + if (srcFsPathPtr->fsPtr == NULL) { + /* + * The path is probably not a valid path in the filesystsem, and is + * most likely to be a use of the empty path "" via a direct call + * to one of the objectified interfaces (e.g. from the Tcl + * testsuite). + */ return NULL; } } /* - * There is still one possibility we should consider; if the file belongs - * to a different filesystem, perhaps it is actually linked through to a - * file in our own filesystem which we do care about. The way we can check - * for this is we ask what filesystem this path belongs to. + * If the file belongs to a different filesystem, perhaps it is actually + * linked through to a file in the given filesystem. Check this by + * inspecting the filesystem associated with the given path. */ if (fsPtr != srcFsPathPtr->fsPtr) { const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2048,13 +2012,14 @@ proc = srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } - nativePathPtr = proc(pathPtr); + nativePathPtr = (char *)proc(pathPtr); srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; + srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } return srcFsPathPtr->nativePathPtr; } @@ -2061,19 +2026,19 @@ /* *--------------------------------------------------------------------------- * * TclFSEnsureEpochOk -- * - * This will ensure the pathPtr is up to date and can be converted into a - * "path" type, and that we are able to generate a complete normalized - * path which is used to determine the filesystem match. + * Ensure that the path is a valid path, and that it has a + * fsPathType internal representation that is not stale. * * Results: - * Standard Tcl return code. + * A standard Tcl return code. * * Side effects: - * An attempt may be made to convert the object. + * The internal representation of fsPtrPtr is converted to fsPathType if + * possible. * *--------------------------------------------------------------------------- */ int @@ -2087,18 +2052,15 @@ return TCL_OK; } srcFsPathPtr = PATHOBJ(pathPtr); - /* - * Check if the filesystem has changed in some way since this object's - * internal representation was calculated. - */ - if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) { /* - * We have to discard the stale representation and recalculate it. + * The filesystem has changed in some way since the internal + * representation for this object was calculated. Discard the stale + * representation and recalculate it. */ TclGetString(pathPtr); Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { @@ -2105,15 +2067,14 @@ return TCL_ERROR; } srcFsPathPtr = PATHOBJ(pathPtr); } - /* - * Check whether the object is already assigned to a fs. - */ - if (srcFsPathPtr->fsPtr != NULL) { + /* + * There is already a filesystem assigned to this path. + */ *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; } @@ -2178,12 +2139,11 @@ Tcl_FSEqualPaths( Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) { const char *firstStr, *secondStr; - size_t firstLen, secondLen; - int tempErrno; + int firstLen, secondLen, tempErrno; if (firstPtr == secondPtr) { return 1; } @@ -2218,15 +2178,16 @@ /* *--------------------------------------------------------------------------- * * SetFsPathFromAny -- * - * This function tries to convert the given Tcl_Obj to a valid Tcl path - * type. + * Attempt to convert the internal representation of pathPtr to + * fsPathType. * - * The filename may begin with "~" (to indicate current user's home - * directory) or "~" (to indicate any user's home directory). + * A tilde ("~") character at the beginnig of the filename indicates the + * current user's home directory, and "~" indicates a particular + * user's directory. * * Results: * Standard Tcl error code. * * Side effects: @@ -2238,14 +2199,14 @@ static int SetFsPathFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { - size_t len; + int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; - char *name; + const char *name; if (TclHasIntRep(pathPtr, &fsPathType)) { return TCL_OK; } @@ -2269,11 +2230,11 @@ * Handle tilde substitutions, if needed. */ if (len && name[0] == '~') { Tcl_DString temp; - size_t split; + int split; char separator = '/'; /* * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. * split becomes value 1 for '~/...' as well as for '~'. @@ -2306,11 +2267,11 @@ Tcl_DStringInit(&temp); Tcl_JoinPath(1, &dir, &temp); Tcl_DStringFree(&dirString); } else { /* - * We have a user name '~user' + * There is a '~user' */ const char *expandedUser; Tcl_DString userName; @@ -2357,12 +2318,11 @@ * Skip '~'. It's replaced by its expansion. */ objc--; objv++; while (objc--) { - TclpNativeJoinPath(transPtr, TclGetString(*objv)); - objv++; + TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); } TclDecrRefCount(parts); } else { Tcl_Obj *pair[2]; @@ -2384,11 +2344,11 @@ /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = Tcl_Alloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); if (transPtr == pathPtr) { transPtr = Tcl_DuplicateObj(pathPtr); fsPathPtr->filesystemEpoch = 0; } else { @@ -2435,20 +2395,20 @@ freeProc(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } - Tcl_Free(fsPathPtr); + ckfree(fsPathPtr); } static void DupFsPathInternalRep( Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */ Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = PATHOBJ(srcPtr); - FsPath *copyFsPathPtr = Tcl_Alloc(sizeof(FsPath)); + FsPath *copyFsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); SETPATHOBJ(copyPtr, copyFsPathPtr); copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; if (copyFsPathPtr->translatedPathPtr != NULL) { @@ -2501,14 +2461,14 @@ *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( - register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ + Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); - size_t cwdLen; + int cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); } @@ -2548,11 +2508,11 @@ */ int TclNativePathInFilesystem( Tcl_Obj *pathPtr, - ClientData *clientDataPtr) + TCL_UNUSED(ClientData *)) { /* * A special case is required to handle the empty path "". This is a valid * path (i.e. the user should be able to do 'file exists ""' without * throwing an error), but equally the path doesn't exist. Those are the @@ -2576,11 +2536,11 @@ * It is somewhat unusual to reach this code path without the object * being of fsPathType. However, we do our best to deal with the * situation. */ - size_t len; + int len; (void) TclGetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". Index: generic/tclPipe.c ================================================================== --- generic/tclPipe.c +++ generic/tclPipe.c @@ -181,16 +181,16 @@ Tcl_DetachPids( int numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { - register Detached *detPtr; + Detached *detPtr; int i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { - detPtr = Tcl_Alloc(sizeof(Detached)); + detPtr = (Detached *)ckalloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; } Tcl_MutexUnlock(&pipeMutex); @@ -217,11 +217,11 @@ */ void Tcl_ReapDetachedProcs(void) { - register Detached *detPtr; + Detached *detPtr; Detached *nextPtr, *prevPtr; int status, code; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { @@ -236,11 +236,11 @@ if (prevPtr == NULL) { detList = detPtr->nextPtr; } else { prevPtr->nextPtr = detPtr->nextPtr; } - Tcl_Free(detPtr); + ckfree(detPtr); detPtr = nextPtr; } Tcl_MutexUnlock(&pipeMutex); } @@ -334,11 +334,11 @@ Tcl_Obj *objPtr; Tcl_Seek(errorChan, 0, SEEK_SET); objPtr = Tcl_NewObj(); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); - if (count == -1) { + if (count < 0) { result = TCL_ERROR; Tcl_DecrRefCount(objPtr); Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error reading stderr output file: %s", @@ -411,11 +411,11 @@ * redirection in the command). The file id * with which to write to this pipe is stored * at *inPipePtr. NULL means command specified * its own input source. */ TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to - * a pipe, unless overriden by redirection in + * a pipe, unless overridden by redirection in * the command. The file id with which to read * frome this pipe is stored at *outPipePtr. * NULL means command specified its own output * sink. */ TclFile *errFilePtr) /* If non-NULL, all stderr output from the @@ -822,11 +822,11 @@ * Scan through the argc array, creating a process for each group of * arguments between the "|" characters. */ Tcl_ReapDetachedProcs(); - pidPtr = Tcl_Alloc(cmdCount * sizeof(Tcl_Pid)); + pidPtr = (Tcl_Pid *)ckalloc(cmdCount * sizeof(Tcl_Pid)); curInFile = inputFile; for (i = 0; i < argc; i = lastArg + 1) { int result, joinThisError; @@ -976,11 +976,11 @@ for (i = 0; i < numPids; i++) { if (pidPtr[i] != (Tcl_Pid) -1) { Tcl_DetachPids(1, &pidPtr[i]); } } - Tcl_Free(pidPtr); + ckfree(pidPtr); } numPids = -1; goto cleanup; } @@ -1080,11 +1080,11 @@ return channel; error: if (numPids > 0) { Tcl_DetachPids(numPids, pidPtr); - Tcl_Free(pidPtr); + ckfree(pidPtr); } if (inPipe != NULL) { TclpCloseFile(inPipe); } if (outPipe != NULL) { Index: generic/tclPkg.c ================================================================== --- generic/tclPkg.c +++ generic/tclPkg.c @@ -55,11 +55,11 @@ * record of the following type. These records are stored in the * "packageTable" hash table in the interpreter, keyed by package name such as * "Tk" (no version number). */ -typedef struct { +typedef struct Package { Tcl_Obj *version; PkgAvail *availPtr; /* First in list of all available versions of * this package. */ const void *clientData; /* Client data. */ } Package; @@ -109,11 +109,11 @@ /* * Helper macros. */ #define DupBlock(v,s,len) \ - ((v) = Tcl_Alloc(len), memcpy((v),(s),(len))) + ((v) = (char *)ckalloc(len), memcpy((v),(s),(len))) #define DupString(v,s) \ do { \ size_t local__len = strlen(s) + 1; \ DupBlock((v),(s),local__len); \ } while (0) @@ -173,17 +173,17 @@ if (CheckVersionAndConvert(interp, Tcl_GetString(pkgPtr->version), &pvi, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) { - Tcl_Free(pvi); + ckfree(pvi); return TCL_ERROR; } res = CompareVersions(pvi, vi, NULL); - Tcl_Free(pvi); - Tcl_Free(vi); + ckfree(pvi); + ckfree(vi); if (res == 0) { if (clientData != NULL) { pkgPtr->clientData = clientData; } @@ -224,31 +224,31 @@ */ static void PkgFilesCleanupProc( ClientData clientData, - Tcl_Interp *interp) + TCL_UNUSED(Tcl_Interp *)) { PkgFiles *pkgFiles = (PkgFiles *) clientData; Tcl_HashSearch search; Tcl_HashEntry *entry; while (pkgFiles->names) { PkgName *name = pkgFiles->names; pkgFiles->names = name->nextPtr; - Tcl_Free(name); + ckfree(name); } entry = Tcl_FirstHashEntry(&pkgFiles->table, &search); while (entry) { Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry); Tcl_DecrRefCount(obj); entry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&pkgFiles->table); - Tcl_Free(pkgFiles); + ckfree(pkgFiles); return; } void * TclInitPkgFiles( @@ -256,14 +256,14 @@ { /* * If assocdata "tclPkgFiles" doesn't exist yet, create it. */ - PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (!pkgFiles) { - pkgFiles = Tcl_Alloc(sizeof(PkgFiles)); + pkgFiles = (PkgFiles *)ckalloc(sizeof(PkgFiles)); pkgFiles->names = NULL; Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles); } return pkgFiles; @@ -278,20 +278,20 @@ Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (pkgFiles && pkgFiles->names) { const char *name = pkgFiles->names->name; Tcl_HashTable *table = &pkgFiles->table; - int new; - Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &new); + int isNew; + Tcl_HashEntry *entry = (Tcl_HashEntry *)Tcl_CreateHashEntry(table, name, &isNew); Tcl_Obj *list; - if (new) { + if (isNew) { list = Tcl_NewObj(); Tcl_SetHashValue(entry, list); Tcl_IncrRefCount(list); } else { - list = Tcl_GetHashValue(entry); + list = (Tcl_Obj *)Tcl_GetHashValue(entry); } Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1)); } } @@ -445,11 +445,11 @@ ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]) { - RequireProcArgs *args = clientData; + RequireProcArgs *args = (RequireProcArgs *)clientData; Tcl_NRAddCallback(interp, PkgRequireCore, (void *) args->name, INT2PTR(reqc), (void *) reqv, args->clientDataPtr); return TCL_OK; @@ -457,48 +457,48 @@ static int PkgRequireCore( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int)) { - const char *name = data[0]; + const char *name = (const char *)data[0]; int reqc = PTR2INT(data[1]); - Tcl_Obj *const *reqv = data[2]; + Tcl_Obj **reqv = (Tcl_Obj **)data[2]; int code = CheckAllRequirements(interp, reqc, reqv); Require *reqPtr; if (code != TCL_OK) { return code; } - reqPtr = Tcl_Alloc(sizeof(Require)); + reqPtr = (Require *)ckalloc(sizeof(Require)); Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL); reqPtr->clientDataPtr = data[3]; reqPtr->name = name; reqPtr->pkgPtr = FindPackage(interp, name); if (reqPtr->pkgPtr->version == NULL) { Tcl_NRAddCallback(interp, - SelectPackage, reqPtr, INT2PTR(reqc), (void *) reqv, - PkgRequireCoreStep1); + SelectPackage, reqPtr, INT2PTR(reqc), reqv, + (void *)PkgRequireCoreStep1); } else { Tcl_NRAddCallback(interp, - PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *) reqv,NULL); + PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), reqv, NULL); } return TCL_OK; } static int PkgRequireCoreStep1( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int)) { Tcl_DString command; char *script; - Require *reqPtr = data[0]; + Require *reqPtr = (Require *)data[0]; int reqc = PTR2INT(data[1]); - Tcl_Obj **const reqv = data[2]; + Tcl_Obj **const reqv = (Tcl_Obj **)data[2]; const char *name = reqPtr->name /* Name of desired package. */; /* * If we've got the package in the DB already, go on to actually loading * it. @@ -549,13 +549,13 @@ PkgRequireCoreStep2( ClientData data[], Tcl_Interp *interp, int result) { - Require *reqPtr = data[0]; + Require *reqPtr = (Require *)data[0]; int reqc = PTR2INT(data[1]); - Tcl_Obj **const reqv = data[2]; + Tcl_Obj **const reqv = (Tcl_Obj **)data[2]; const char *name = reqPtr->name; /* Name of desired package. */ if ((result != TCL_OK) && (result != TCL_ERROR)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad return code: %d", result)); @@ -573,24 +573,24 @@ * pkgPtr may now be invalid, so refresh it. */ reqPtr->pkgPtr = FindPackage(interp, name); Tcl_NRAddCallback(interp, - SelectPackage, reqPtr, INT2PTR(reqc), (void *) reqv, - PkgRequireCoreFinal); + SelectPackage, reqPtr, INT2PTR(reqc), reqv, + (void *)PkgRequireCoreFinal); return TCL_OK; } static int PkgRequireCoreFinal( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int)) { - Require *reqPtr = data[0]; + Require *reqPtr = (Require *)data[0]; int reqc = PTR2INT(data[1]), satisfies; - Tcl_Obj **const reqv = data[2]; + Tcl_Obj **const reqv = (Tcl_Obj **)data[2]; char *pkgVersionI; void *clientDataPtr = reqPtr->clientDataPtr; const char *name = reqPtr->name; /* Name of desired package. */ if (reqPtr->pkgPtr->version == NULL) { @@ -608,11 +608,11 @@ if (reqc != 0) { CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version), &pkgVersionI, NULL); satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); - Tcl_Free(pkgVersionI); + ckfree(pkgVersionI); if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "version conflict for package \"%s\": have %s, need", name, Tcl_GetString(reqPtr->pkgPtr->version))); @@ -633,30 +633,30 @@ } static int PkgRequireCoreCleanup( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { - Tcl_Free(data[0]); + ckfree(data[0]); return result; } static int SelectPackage( ClientData data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int)) { PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion, *bestStableVersion; /* Internal rep. of versions */ int availStable, satisfies; - Require *reqPtr = data[0]; + Require *reqPtr = (Require *)data[0]; int reqc = PTR2INT(data[1]); - Tcl_Obj **const reqv = data[2]; + Tcl_Obj **const reqv = (Tcl_Obj **)data[2]; const char *name = reqPtr->name; Package *pkgPtr = reqPtr->pkgPtr; Interp *iPtr = (Interp *) interp; /* @@ -705,11 +705,11 @@ */ if (reqc > 0) { satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); if (!satisfies) { - Tcl_Free(availVersion); + ckfree(availVersion); availVersion = NULL; continue; } } @@ -724,11 +724,11 @@ /* * The version of the package sought is better than the * currently selected version. */ - Tcl_Free(bestVersion); + ckfree(bestVersion); bestVersion = NULL; goto newbest; } } else { newbest: @@ -739,11 +739,11 @@ bestPtr = availPtr; CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL); } if (!availStable) { - Tcl_Free(availVersion); + ckfree(availVersion); availVersion = NULL; continue; } if (bestStablePtr != NULL) { @@ -757,11 +757,11 @@ /* * This stable version of the package sought is better than * the currently selected stable version. */ - Tcl_Free(bestStableVersion); + ckfree(bestStableVersion); bestStableVersion = NULL; goto newstable; } } else { newstable: @@ -773,25 +773,25 @@ bestStablePtr = availPtr; CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL); } - Tcl_Free(availVersion); + ckfree(availVersion); availVersion = NULL; } /* end for */ /* * Clean up memorized internal reps, if any. */ if (bestVersion != NULL) { - Tcl_Free(bestVersion); + ckfree(bestVersion); bestVersion = NULL; } if (bestStableVersion != NULL) { - Tcl_Free(bestStableVersion); + ckfree(bestStableVersion); bestStableVersion = NULL; } /* * Now choose a version among the two best. For 'latest' we simply take @@ -804,11 +804,11 @@ bestPtr = bestStablePtr; } if (bestPtr == NULL) { Tcl_NRAddCallback(interp, - data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL); + (Tcl_NRPostProc *)data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL); } else { /* * We found an ifneeded script for the package. Be careful while * executing it: this could cause reentrancy, so (a) protect the * script itself from deletion and (b) don't assume that bestPtr will @@ -820,17 +820,17 @@ PkgName *pkgName; Tcl_Preserve(versionToProvide); pkgPtr->clientData = versionToProvide; - pkgFiles = TclInitPkgFiles(interp); + pkgFiles = (PkgFiles *)TclInitPkgFiles(interp); /* * Push "ifneeded" package name in "tclPkgFiles" assocdata. */ - pkgName = Tcl_Alloc(sizeof(PkgName) + strlen(name)); + pkgName = (PkgName *)ckalloc(sizeof(PkgName) + strlen(name)); pkgName->nextPtr = pkgFiles->names; strcpy(pkgName->name, name); pkgFiles->names = pkgName; if (bestPtr->pkgIndex) { TclPkgFileSeen(interp, bestPtr->pkgIndex); @@ -849,24 +849,24 @@ SelectPackageFinal( ClientData data[], Tcl_Interp *interp, int result) { - Require *reqPtr = data[0]; + Require *reqPtr = (Require *)data[0]; int reqc = PTR2INT(data[1]); - Tcl_Obj **const reqv = data[2]; + Tcl_Obj **const reqv = (Tcl_Obj **)data[2]; const char *name = reqPtr->name; char *versionToProvide = reqPtr->versionToProvide; /* * Pop the "ifneeded" package name from "tclPkgFiles" assocdata */ - PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL); PkgName *pkgName = pkgFiles->names; pkgFiles->names = pkgName->nextPtr; - Tcl_Free(pkgName); + ckfree(pkgName); reqPtr->pkgPtr = FindPackage(interp, name); if (result == TCL_OK) { Tcl_ResetResult(interp); if (reqPtr->pkgPtr->version == NULL) { @@ -883,17 +883,17 @@ if (TCL_OK != CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version), &pvi, NULL)) { result = TCL_ERROR; } else if (CheckVersionAndConvert(interp, versionToProvide, &vi, NULL) != TCL_OK) { - Tcl_Free(pvi); + ckfree(pvi); result = TCL_ERROR; } else { int res = CompareVersions(pvi, vi, NULL); - Tcl_Free(pvi); - Tcl_Free(vi); + ckfree(pvi); + ckfree(vi); if (res != 0) { result = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to provide package %s %s failed:" " package %s %s provided instead", @@ -941,11 +941,11 @@ reqPtr->pkgPtr->clientData = NULL; return result; } Tcl_NRAddCallback(interp, - data[3], reqPtr, INT2PTR(reqc), (void *) reqv, NULL); + (Tcl_NRPostProc *)data[3], reqPtr, INT2PTR(reqc), (void *) reqv, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1002,11 +1002,11 @@ Tcl_HashEntry *hPtr; Package *pkgPtr; hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name); if (hPtr) { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { /* * At this point we know that the package is present. Make sure * that the provided version meets the current requirement by * calling Tcl_PkgRequireEx() to check for us. @@ -1050,22 +1050,21 @@ * *---------------------------------------------------------------------- */ int Tcl_PackageObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, clientData, objc, objv); } - /* ARGSUSED */ int TclNRPackageObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const pkgOptions[] = { @@ -1107,13 +1106,12 @@ Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; } pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (pkgFiles) { - Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table, - TclGetString(objv[2])); - + Tcl_HashEntry *entry = + Tcl_FindHashEntry(&pkgFiles->table, Tcl_GetString(objv[2])); if (entry) { Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry)); } } break; @@ -1126,21 +1124,21 @@ for (i = 2; i < objc; i++) { keyString = TclGetString(objv[i]); if (pkgFiles) { hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString); if (hPtr) { - Tcl_Obj *obj = Tcl_GetHashValue(hPtr); + Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); Tcl_DecrRefCount(obj); } } hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString); if (hPtr == NULL) { continue; } - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (pkgPtr->version != NULL) { Tcl_DecrRefCount(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { @@ -1150,19 +1148,18 @@ Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } - Tcl_Free(availPtr); + ckfree(availPtr); } - Tcl_Free(pkgPtr); + ckfree(pkgPtr); } break; } case PKG_IFNEEDED: { - size_t length; - int res; + int length, res; char *argv3i, *avi; if ((objc != 4) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?"); return TCL_ERROR; @@ -1173,33 +1170,33 @@ } argv2 = TclGetString(objv[2]); if (objc == 4) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr == NULL) { - Tcl_Free(argv3i); + ckfree(argv3i); return TCL_OK; } - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } argv3 = TclGetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert(interp, availPtr->version, &avi, NULL) != TCL_OK) { - Tcl_Free(argv3i); + ckfree(argv3i); return TCL_ERROR; } res = CompareVersions(avi, argv3i, NULL); - Tcl_Free(avi); + ckfree(avi); if (res == 0) { if (objc == 4) { - Tcl_Free(argv3i); + ckfree(argv3i); Tcl_SetObjResult(interp, Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); @@ -1208,17 +1205,17 @@ availPtr->pkgIndex = NULL; } break; } } - Tcl_Free(argv3i); + ckfree(argv3i); if (objc == 4) { return TCL_OK; } if (availPtr == NULL) { - availPtr = Tcl_Alloc(sizeof(PkgAvail)); + availPtr = (PkgAvail *)ckalloc(sizeof(PkgAvail)); availPtr->pkgIndex = NULL; DupBlock(availPtr->version, argv3, length + 1); if (prevPtr == NULL) { availPtr->nextPtr = pkgPtr->availPtr; @@ -1245,14 +1242,14 @@ resultObj = Tcl_NewObj(); tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj( - Tcl_GetHashKey(tablePtr, hPtr), -1)); + (char *)Tcl_GetHashKey(tablePtr, hPtr), -1)); } } Tcl_SetObjResult(interp, resultObj); } break; @@ -1274,11 +1271,11 @@ name = argv2; } hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name); if (hPtr != NULL) { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { goto require; } } @@ -1309,11 +1306,11 @@ } argv2 = TclGetString(objv[2]); if (objc == 3) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { Tcl_SetObjResult(interp, pkgPtr->version); } } return TCL_OK; @@ -1396,20 +1393,20 @@ newObjvPtr, NULL); return TCL_OK; } break; case PKG_UNKNOWN: { - size_t length; + int length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(iPtr->packageUnknown, -1)); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { - Tcl_Free(iPtr->packageUnknown); + ckfree(iPtr->packageUnknown); } argv2 = TclGetStringFromObj(objv[2], &length); if (argv2[0] == 0) { iPtr->packageUnknown = NULL; } else { @@ -1466,11 +1463,11 @@ argv3 = TclGetString(objv[3]); argv2 = TclGetString(objv[2]); if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK || CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) { if (iva != NULL) { - Tcl_Free(iva); + ckfree(iva); } /* * ivb cannot be set in this branch. */ @@ -1482,12 +1479,12 @@ * Comparison is done on the internal representation. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(CompareVersions(iva, ivb, NULL))); - Tcl_Free(iva); - Tcl_Free(ivb); + ckfree(iva); + ckfree(ivb); break; case PKG_VERSIONS: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; @@ -1495,11 +1492,11 @@ Tcl_Obj *resultObj = Tcl_NewObj(); argv2 = TclGetString(objv[2]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(availPtr->version, -1)); } @@ -1517,16 +1514,16 @@ argv2 = TclGetString(objv[2]); if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { - Tcl_Free(argv2i); + ckfree(argv2i); return TCL_ERROR; } satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3); - Tcl_Free(argv2i); + ckfree(argv2i); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies)); break; } default: @@ -1536,11 +1533,11 @@ } static int TclNRPackageObjCmdCleanup( ClientData data[], - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), int result) { TclDecrRefCount((Tcl_Obj *) data[0]); TclDecrRefCount((Tcl_Obj *) data[1]); return result; @@ -1574,17 +1571,17 @@ int isNew; Package *pkgPtr; hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew); if (isNew) { - pkgPtr = Tcl_Alloc(sizeof(Package)); + pkgPtr = (Package *)ckalloc(sizeof(Package)); pkgPtr->version = NULL; pkgPtr->availPtr = NULL; pkgPtr->clientData = NULL; Tcl_SetHashValue(hPtr, pkgPtr); } else { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); } return pkgPtr; } /* @@ -1613,11 +1610,11 @@ Tcl_HashEntry *hPtr; PkgAvail *availPtr; for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - pkgPtr = Tcl_GetHashValue(hPtr); + pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { Tcl_DecrRefCount(pkgPtr->version); } while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; @@ -1626,17 +1623,17 @@ Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } - Tcl_Free(availPtr); + ckfree(availPtr); } - Tcl_Free(pkgPtr); + ckfree(pkgPtr); } Tcl_DeleteHashTable(&iPtr->packageTable); if (iPtr->packageUnknown != NULL) { - Tcl_Free(iPtr->packageUnknown); + ckfree(iPtr->packageUnknown); } } /* *---------------------------------------------------------------------- @@ -1672,11 +1669,11 @@ int hasunstable = 0; /* * 4* assuming that each char is a separator (a,b become ' -x '). * 4+ to have spce for an additional -2 at the end */ - char *ibuf = Tcl_Alloc(4 + 4*strlen(string)); + char *ibuf = (char *)ckalloc(4 + 4*strlen(string)); char *ip = ibuf; /* * Basic rules * (1) First character has to be a digit. @@ -1740,20 +1737,20 @@ if (prevChar!='.' && prevChar!='a' && prevChar!='b') { *ip = '\0'; if (internal != NULL) { *internal = ibuf; } else { - Tcl_Free(ibuf); + ckfree(ibuf); } if (stable != NULL) { *stable = !hasunstable; } return TCL_OK; } error: - Tcl_Free(ibuf); + ckfree(ibuf); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected version number but got \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL); return TCL_ERROR; } @@ -1999,11 +1996,11 @@ * = version- */ char *dash = NULL, *buf; - dash = strchr(string, '-'); + dash = (char *)strchr(string, '-'); if (dash == NULL) { /* * No dash found, has to be a simple version. */ @@ -2023,11 +2020,11 @@ /* * Exactly one dash is present. Copy the string, split at the location of * dash and check that both parts are versions. Note that the max part can * be empty. Also note that the string allocated with strdup() must be - * freed with free() and not Tcl_Free(). + * freed with free() and not ckfree(). */ DupString(buf, string); dash = buf + (dash - string); *dash = '\0'; /* buf now <=> min part */ @@ -2034,15 +2031,15 @@ dash++; /* dash now <=> max part */ if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) || ((*dash != '\0') && (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) { - Tcl_Free(buf); + ckfree(buf); return TCL_ERROR; } - Tcl_Free(buf); + ckfree(buf); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -2067,12 +2064,11 @@ * version. */ Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { Tcl_Obj *result = Tcl_GetObjResult(interp); - int i; - size_t length; + int i, length; for (i = 0; i < reqc; i++) { const char *v = TclGetStringFromObj(reqv[i], &length); if ((length & 0x1) && (v[length/2] == '-') @@ -2188,11 +2184,11 @@ */ int satisfied, res; char *dash = NULL, *buf, *min, *max; - dash = strchr(req, '-'); + dash = (char *)strchr(req, '-'); if (dash == NULL) { /* * No dash found, is a simple version, fallback to regular check. The * 'CheckVersionAndConvert' cannot fail. We pad the requirement with * 'a0', i.e '-2' before doing the comparison to properly accept @@ -2204,11 +2200,11 @@ CheckVersionAndConvert(NULL, req, &reqi, NULL); strcat(reqi, " -2"); res = CompareVersions(havei, reqi, &thisIsMajor); satisfied = (res == 0) || ((res == 1) && !thisIsMajor); - Tcl_Free(reqi); + ckfree(reqi); return satisfied; } /* * Exactly one dash is present (Assumption of valid syntax). Copy the req, @@ -2228,12 +2224,12 @@ */ CheckVersionAndConvert(NULL, buf, &min, NULL); strcat(min, " -2"); satisfied = (CompareVersions(havei, min, NULL) >= 0); - Tcl_Free(min); - Tcl_Free(buf); + ckfree(min); + ckfree(buf); return satisfied; } /* * We have both min and max, and generate their internal reps. When @@ -2251,13 +2247,13 @@ strcat(max, " -2"); satisfied = ((CompareVersions(min, havei, NULL) <= 0) && (CompareVersions(havei, max, NULL) < 0)); } - Tcl_Free(min); - Tcl_Free(max); - Tcl_Free(buf); + ckfree(min); + ckfree(max); + ckfree(buf); return satisfied; } /* *---------------------------------------------------------------------- @@ -2282,11 +2278,11 @@ Tcl_PkgInitStubsCheck( Tcl_Interp *interp, const char * version, int exact) { - const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL); + const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); if ((exact&1) && actualVersion) { const char *p = version; int count = 0; @@ -2294,15 +2290,15 @@ count += !isdigit(UCHAR(*p++)); } if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ - Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); + Tcl_PkgPresent(interp, "Tcl", version, 1); return NULL; } } else { - return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); + return Tcl_PkgPresent(interp, "Tcl", version, 1); } } return actualVersion; } /* Index: generic/tclPlatDecls.h ================================================================== --- generic/tclPlatDecls.h +++ generic/tclPlatDecls.h @@ -50,40 +50,40 @@ * Exported function declarations: */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, size_t len, +EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); /* 1 */ -EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, size_t len, +EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, - size_t maxPathLen, char *libraryPath); + int maxPathLen, char *libraryPath); /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, - int hasResourceFile, size_t maxPathLen, + int hasResourceFile, int maxPathLen, char *libraryPath); #endif /* MACOSX */ typedef struct TclPlatStubs { int magic; void *hooks; #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - TCHAR * (*tcl_WinUtfToTChar) (const char *str, size_t len, Tcl_DString *dsPtr); /* 0 */ - char * (*tcl_WinTCharToUtf) (const TCHAR *str, size_t len, Tcl_DString *dsPtr); /* 1 */ + TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ + char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */ + int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ + int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ #endif /* MACOSX */ } TclPlatStubs; extern const TclPlatStubs *tclPlatStubsPtr; @@ -111,12 +111,27 @@ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ + +#ifdef MAC_OSX_TCL /* MACOSX */ +#undef Tcl_MacOSXOpenBundleResources +#define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e) +#endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#endif /* _TCLPLATDECLS */ +#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\ + && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8) +#undef Tcl_WinUtfToTChar +#undef Tcl_WinTCharToUtf +#ifdef _WIN32 +#define Tcl_WinUtfToTChar(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ + (TCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr))) +#define Tcl_WinTCharToUtf(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))) +#endif +#endif - +#endif /* _TCLPLATDECLS */ Index: generic/tclPreserve.c ================================================================== --- generic/tclPreserve.c +++ generic/tclPreserve.c @@ -35,13 +35,13 @@ * Global data structures used to hold the list of preserved data references. * These variables are protected by "preserveMutex". */ static Reference *refArray = NULL; /* First in array of references. */ -static size_t spaceAvl = 0; /* Total number of structures available at +static int spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ -static size_t inUse = 0; /* Count of structures currently in use in +static int inUse = 0; /* Count of structures currently in use in * refArray. */ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ #define INITIAL_SIZE 2 /* Initial number of reference slots to make */ @@ -51,11 +51,11 @@ * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism * is mainly used when we have lots of references to a few big, expensive * objects that we don't want to live any longer than necessary. */ -typedef struct { +typedef struct HandleStruct { void *ptr; /* Pointer to the memory block being tracked. * This field will become NULL when the memory * block is deleted. This field must be the * first in the structure. */ #ifdef TCL_MEM_DEBUG @@ -81,17 +81,16 @@ * Frees the storage of the reference array. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ void TclFinalizePreserve(void) { Tcl_MutexLock(&preserveMutex); if (spaceAvl != 0) { - Tcl_Free(refArray); + ckfree(refArray); refArray = NULL; inUse = 0; spaceAvl = 0; } Tcl_MutexUnlock(&preserveMutex); @@ -119,11 +118,11 @@ void Tcl_Preserve( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; - size_t i; + int i; /* * See if there is already a reference for this pointer. If so, just * increment its reference count. */ @@ -142,11 +141,11 @@ * if it is full. */ if (inUse == spaceAvl) { spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE; - refArray = Tcl_Realloc(refArray, spaceAvl * sizeof(Reference)); + refArray = (Reference *)ckrealloc(refArray, spaceAvl * sizeof(Reference)); } /* * Make a new entry for the new reference. */ @@ -182,11 +181,11 @@ void Tcl_Release( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; - size_t i; + int i; Tcl_MutexLock(&preserveMutex); for (i=0, refPtr=refArray ; iptr = ptr; #ifdef TCL_MEM_DEBUG handlePtr->ptr2 = ptr; #endif @@ -375,11 +374,11 @@ handlePtr, handlePtr->ptr2, handlePtr->ptr); } #endif handlePtr->ptr = NULL; if (handlePtr->refCount == 0) { - Tcl_Free(handlePtr); + ckfree(handlePtr); } } /* *--------------------------------------------------------------------------- @@ -458,11 +457,11 @@ Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p", handlePtr, handlePtr->ptr2, handlePtr->ptr); } #endif if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) { - Tcl_Free(handlePtr); + ckfree(handlePtr); } } /* * Local Variables: Index: generic/tclProc.c ================================================================== --- generic/tclProc.c +++ generic/tclProc.c @@ -32,12 +32,11 @@ */ static void DupLambdaInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void FreeLambdaInternalRep(Tcl_Obj *objPtr); -static int InitArgsAndLocals(Tcl_Interp *interp, - Tcl_Obj *procNameObj, int skip); +static int InitArgsAndLocals(Tcl_Interp *interp, int skip); static void InitResolvedLocals(Tcl_Interp *interp, ByteCode *codePtr, Var *defPtr, Namespace *nsPtr); static void InitLocalCache(Proc *procPtr); static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); @@ -79,11 +78,11 @@ #define ProcGetIntRep(objPtr, procPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclProcBodyType); \ - (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The [upvar]/[uplevel] level reference type. Uses the longValue field * to remember the integer value of a parsed # format. @@ -125,12 +124,12 @@ #define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &lambdaType); \ - (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ - (nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) /* *---------------------------------------------------------------------- @@ -147,19 +146,18 @@ * A new procedure gets created. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ProcObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; Proc *procPtr; const char *procName; const char *simpleName, *procArgs, *procBody; Namespace *nsPtr, *altNsPtr, *cxtNsPtr; Tcl_Command cmd; @@ -196,12 +194,12 @@ /* * Create the data structure to represent the procedure. */ - if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3], - &procPtr) != TCL_OK) { + if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, simpleName, objv[2], + objv[3], &procPtr) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (creating proc \""); Tcl_AddErrorInfo(interp, simpleName); Tcl_AddErrorInfo(interp, "\")"); return TCL_ERROR; } @@ -230,11 +228,11 @@ * processing. Find a way to factor the common elements into a single * function. */ if (iPtr->cmdFramePtr) { - CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *contextPtr = *iPtr->cmdFramePtr; if (contextPtr->type == TCL_LOCATION_BC) { /* * Retrieve source information from the bytecode, if possible. If @@ -261,15 +259,15 @@ if (contextPtr->line && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { int isNew; Tcl_HashEntry *hePtr; - CmdFrame *cfPtr = Tcl_Alloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = Tcl_Alloc(sizeof(int)); + cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = contextPtr->line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; @@ -287,19 +285,19 @@ * TclProcCleanupProc in this file. Currently it seems as * if only the procbodytest::proc command of the testsuite * is able to trigger this situation. */ - CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr); + CmdFrame *cfOldPtr = (CmdFrame *)Tcl_GetHashValue(hePtr); if (cfOldPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfOldPtr->data.eval.path); cfOldPtr->data.eval.path = NULL; } - Tcl_Free(cfOldPtr->line); + ckfree(cfOldPtr->line); cfOldPtr->line = NULL; - Tcl_Free(cfOldPtr); + ckfree(cfOldPtr); } Tcl_SetHashValue(hePtr, cfPtr); } /* @@ -327,11 +325,11 @@ * - could be enhanced to handle also non-empty bodies that contain only * comments; however, parsing the body will slow down the compilation * of all procs whose argument list is just _args_ */ - if (objv[3]->typePtr == &tclProcBodyType) { + if (TclHasIntRep(objv[3], &tclProcBodyType)) { goto done; } procArgs = TclGetString(objv[2]); @@ -338,11 +336,11 @@ while (*procArgs == ' ') { procArgs++; } if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) { - size_t numBytes; + int numBytes; procArgs +=4; while (*procArgs != '\0') { if (*procArgs != ' ') { goto done; @@ -395,21 +393,21 @@ */ int TclCreateProc( Tcl_Interp *interp, /* Interpreter containing proc. */ - Namespace *nsPtr, /* Namespace containing this proc. */ + TCL_UNUSED(Namespace *) /*nsPtr*/, const char *procName, /* Unqualified name of this proc. */ Tcl_Obj *argsPtr, /* Description of arguments. */ Tcl_Obj *bodyPtr, /* Command body. */ Proc **procPtrPtr) /* Returns: pointer to proc data. */ { Interp *iPtr = (Interp *) interp; - register Proc *procPtr = NULL; + Proc *procPtr = NULL; int i, result, numArgs; - register CompiledLocal *localPtr = NULL; + CompiledLocal *localPtr = NULL; Tcl_Obj **argArray; int precompiled = 0; ProcGetIntRep(bodyPtr, procPtr); if (procPtr != NULL) { @@ -444,11 +442,11 @@ * not want any bytecode internal representation. */ if (Tcl_IsShared(bodyPtr)) { const char *bytes; - size_t length; + int length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = TclGetStringFromObj(bodyPtr, &length); bodyPtr = Tcl_NewStringObj(bytes, length); @@ -467,11 +465,11 @@ * will be a reference to it in the Proc structure. */ Tcl_IncrRefCount(bodyPtr); - procPtr = Tcl_Alloc(sizeof(Proc)); + procPtr = (Proc *)ckalloc(sizeof(Proc)); procPtr->iPtr = iPtr; procPtr->refCount = 1; procPtr->bodyPtr = bodyPtr; procPtr->numArgs = 0; /* Actual argument count is set below. */ procPtr->numCompiledLocals = 0; @@ -507,12 +505,11 @@ procPtr->numCompiledLocals = numArgs; } for (i = 0; i < numArgs; i++) { const char *argname, *argnamei, *argnamelast; - int fieldCount; - size_t nameLength; + int fieldCount, nameLength; Tcl_Obj **fieldValues; /* * Now divide the specifier up into name and default. */ @@ -538,24 +535,24 @@ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } - argname = TclGetStringFromObj(fieldValues[0], &nameLength); + argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength); /* * Check that the formal parameter name is a scalar. */ argnamei = argname; - argnamelast = Tcl_UtfPrev(argname + nameLength, argname); + argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname; while (argnamei < argnamelast) { if (*argnamei == '(') { if (*argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", - TclGetString(fieldValues[0]))); + Tcl_GetString(fieldValues[0]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } } else if (*argnamei == ':' && *(argnamei+1) == ':') { @@ -566,11 +563,11 @@ Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } - argnamei = Tcl_UtfNext(argnamei); + argnamei++; } if (precompiled) { /* * Compare the parsed argument with the stored one. Note that the @@ -600,13 +597,14 @@ /* * Compare the default value if any. */ if (localPtr->defValuePtr != NULL) { - size_t tmpLength, valueLength; - const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); - const char *value = TclGetStringFromObj(fieldValues[1], &valueLength); + const char *tmpPtr = TclGetString(localPtr->defValuePtr); + size_t tmpLength = localPtr->defValuePtr->length; + const char *value = TclGetString(fieldValues[1]); + size_t valueLength = fieldValues[1]->length; if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0 ) { Tcl_Obj *errorObj = Tcl_ObjPrintf( @@ -632,11 +630,11 @@ /* * Allocate an entry in the runtime procedure frame's array of * local variables for the argument. */ - localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); + localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; @@ -677,13 +675,13 @@ if (localPtr->defValuePtr != NULL) { Tcl_DecrRefCount(localPtr->defValuePtr); } - Tcl_Free(localPtr); + ckfree(localPtr); } - Tcl_Free(procPtr); + ckfree(procPtr); } return TCL_ERROR; } /* @@ -759,11 +757,11 @@ Tcl_Interp *interp, /* Interpreter in which to find frame. */ Tcl_Obj *objPtr, /* Object describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; int curLevel, level, result; const Tcl_ObjIntRep *irPtr; const char *name = NULL; Tcl_WideInt w; @@ -806,23 +804,29 @@ result = 1; } } else { result = -1; } - } else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) { + } else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) { /* * If this were an integer, we'd have succeeded already. * Docs say we have to treat this as a 'bad level' error. */ result = -1; } } - if (result == 0) { - level = curLevel - 1; - } if (result != -1) { + /* if relative current level */ + if (result == 0) { + if (!curLevel) { + /* we are in top-level, so simply generate bad level */ + name = "1"; + goto badLevel; + } + level = curLevel - 1; + } if (level >= 0) { CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { @@ -830,13 +834,13 @@ return result; } } } } - +badLevel: if (name == NULL) { - name = TclGetString(objPtr); + name = objPtr ? TclGetString(objPtr) : "1" ; } Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); return -1; } @@ -862,11 +866,11 @@ Uplevel_Callback( ClientData data[], Tcl_Interp *interp, int result) { - CallFrame *savedVarFramePtr = data[0]; + CallFrame *savedVarFramePtr = (CallFrame *)data[0]; if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp))); } @@ -877,30 +881,29 @@ ((Interp *)interp)->varFramePtr = savedVarFramePtr; return result; } - /* ARGSUSED */ int Tcl_UplevelObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, clientData, objc, objv); } int TclNRUplevelObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; int result; CallFrame *savedVarFramePtr, *framePtr; Tcl_Obj *objPtr; @@ -1025,11 +1028,11 @@ if (origCmd != NULL) { cmdPtr = (Command *) origCmd; } if (cmdPtr->deleteProc == TclProcDeleteProc) { - return cmdPtr->objClientData; + return (Proc *)cmdPtr->objClientData; } return NULL; } static int @@ -1036,32 +1039,36 @@ ProcWrongNumArgs( Tcl_Interp *interp, int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; - register Proc *procPtr = framePtr->procPtr; + Proc *procPtr = framePtr->procPtr; int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; const char *final = NULL; /* * Build up desired argument list for Tcl_WrongNumArgs */ numArgs = framePtr->procPtr->numArgs; - desiredObjs = TclStackAlloc(interp, - (int) sizeof(Tcl_Obj *) * (numArgs+1)); + desiredObjs = (Tcl_Obj **)TclStackAlloc(interp, + sizeof(Tcl_Obj *) * (numArgs+1)); if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { +#ifdef AVOID_HACKS_FOR_ITCL desiredObjs[0] = framePtr->objv[skip-1]; +#else + desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); +#endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { - register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); + Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; Tcl_Obj *namePtr = localName(framePtr, i-1); @@ -1192,11 +1199,11 @@ for (; localPtr != NULL; localPtr = localPtr->nextPtr) { if (localPtr->resolveInfo) { if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { - Tcl_Free(localPtr->resolveInfo); + ckfree(localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } localPtr->flags &= ~VAR_RESOLVED; @@ -1248,11 +1255,11 @@ * should be used. */ resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { - register Var *resolvedVarPtr = (Var *) + Var *resolvedVarPtr = (Var *) resVarInfo->fetchProc(interp, resVarInfo); if (resolvedVarPtr) { if (TclIsVarInHash(resolvedVarPtr)) { VarHashRefCount(resolvedVarPtr)++; @@ -1271,18 +1278,18 @@ { int i; Tcl_Obj **namePtrPtr = &localCachePtr->varName0; for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { - register Tcl_Obj *objPtr = *namePtrPtr; + Tcl_Obj *objPtr = *namePtrPtr; if (objPtr) { /* TclReleaseLiteral calls Tcl_DecrRefCount for us */ TclReleaseLiteral(interp, objPtr); } } - Tcl_Free(localCachePtr); + ckfree(localCachePtr); } static void InitLocalCache( Proc *procPtr) @@ -1294,21 +1301,21 @@ Tcl_Obj **namePtr; Var *varPtr; LocalCache *localCachePtr; CompiledLocal *localPtr; - int new; + int isNew; ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); /* * Cache the names and initial values of local variables; store the * cache in both the framePtr for this execution and in the codePtr * for future calls. */ - localCachePtr = Tcl_Alloc(sizeof(LocalCache) + localCachePtr = (LocalCache *)ckalloc(sizeof(LocalCache) + (localCt - 1) * sizeof(Tcl_Obj *) + numArgs * sizeof(Var)); namePtr = &localCachePtr->varName0; varPtr = (Var *) (namePtr + localCt); @@ -1316,12 +1323,12 @@ while (localPtr) { if (TclIsVarTemporary(localPtr)) { *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ -1, - &new, /* nsPtr */ NULL, 0, NULL); + localPtr->nameLength, /* hash */ (unsigned int) -1, + &isNew, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } if (i < numArgs) { varPtr->flags = (localPtr->flags & VAR_IS_ARGS); @@ -1357,20 +1364,19 @@ *---------------------------------------------------------------------- */ static int InitArgsAndLocals( - register 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. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; - register Proc *procPtr = framePtr->procPtr; + Proc *procPtr = framePtr->procPtr; ByteCode *codePtr; - register Var *varPtr, *defPtr; + Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); @@ -1394,11 +1400,11 @@ * Create the "compiledLocals" array. Make sure it is large enough to hold * all the procedure's compiled local variables, including its formal * parameters. */ - varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var))); + varPtr = (Var *)TclStackAlloc(interp, localCt * sizeof(Var)); framePtr->compiledLocals = varPtr; framePtr->numCompiledLocals = localCt; /* * Match and assign the call's actual parameters to the procedure's formal @@ -1524,19 +1530,19 @@ int TclPushProcCallFrame( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register 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. */ Tcl_Obj *const objv[], /* Argument value objects. */ int isLambda) /* 1 if this is a call by ApplyObjCmd: it * needs special rules for error msg */ { - Proc *procPtr = clientData; + Proc *procPtr = (Proc *)clientData; Namespace *nsPtr = procPtr->cmdPtr->nsPtr; CallFrame *framePtr, **framePtrPtr; int result; ByteCode *codePtr; @@ -1616,11 +1622,11 @@ int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register 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. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1633,11 +1639,11 @@ int TclNRInterpProc( ClientData clientData, /* Record describing procedure to be * interpreted. */ - register 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. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1668,25 +1674,25 @@ *---------------------------------------------------------------------- */ int TclNRInterpProcCore( - register 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. */ int 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. */ { Interp *iPtr = (Interp *) interp; - register Proc *procPtr = iPtr->varFramePtr->procPtr; + Proc *procPtr = iPtr->varFramePtr->procPtr; int result; CallFrame *freePtr; ByteCode *codePtr; - result = InitArgsAndLocals(interp, procNameObj, skip); + result = InitArgsAndLocals(interp, skip); if (result != TCL_OK) { freePtr = iPtr->framePtr; Tcl_PopCallFrame(interp); /* Pop but do not free. */ TclStackFree(interp, freePtr->compiledLocals); /* Free compiledLocals. */ @@ -1694,12 +1700,12 @@ return TCL_ERROR; } #if defined(TCL_COMPILE_DEBUG) if (tclTraceExec >= 1) { - register CallFrame *framePtr = iPtr->varFramePtr; - register int i; + CallFrame *framePtr = iPtr->varFramePtr; + int i; if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { fprintf(stdout, "Calling lambda "); } else { fprintf(stdout, "Calling proc "); @@ -1772,11 +1778,11 @@ int result) { Interp *iPtr = (Interp *) interp; Proc *procPtr = iPtr->varFramePtr->procPtr; CallFrame *freePtr; - Tcl_Obj *procNameObj = data[0]; + Tcl_Obj *procNameObj = (Tcl_Obj *)data[0]; ProcErrorProc *errorProc = (ProcErrorProc *)data[1]; if (TCL_DTRACE_PROC_RETURN_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; @@ -1841,13 +1847,11 @@ "invoked \"%s\" outside of a loop", ((result == TCL_BREAK) ? "break" : "continue"))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL); result = TCL_ERROR; - /* - * Fall through to the TCL_ERROR handling code. - */ + /* FALLTHRU */ case TCL_ERROR: /* * Now it _must_ be an error, so we need to log it as such. This means * filling out the error trace. Luckily, we just hand this off to the @@ -1951,10 +1955,13 @@ Tcl_AppendStringsToObj(message, description, " \"", NULL); Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL); fprintf(stdout, "%s\"\n", TclGetString(message)); Tcl_DecrRefCount(message); } +#else + (void)description; + (void)procName; #endif /* * Plug the current procPtr into the interpreter and coerce the code * body to byte codes. The interpreter needs to know which proc it's @@ -1989,14 +1996,14 @@ clPtr = clPtr->nextPtr; if (toFree->resolveInfo) { if (toFree->resolveInfo->deleteProc) { toFree->resolveInfo->deleteProc(toFree->resolveInfo); } else { - Tcl_Free(toFree->resolveInfo); + ckfree(toFree->resolveInfo); } } - Tcl_Free(toFree); + ckfree(toFree); } procPtr->numCompiledLocals = procPtr->numArgs; } (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, @@ -2012,11 +2019,11 @@ /* * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. */ iPtr->invokeWord = 0; - iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL); + iPtr->invokeCmdFramePtr = hePtr ? (CmdFrame *)Tcl_GetHashValue(hePtr) : NULL; TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL); iPtr->invokeCmdFramePtr = NULL; TclPopStackFrame(interp); } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) { /* @@ -2053,18 +2060,17 @@ Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - unsigned int overflow, limit = 60; - size_t nameLen; + int overflow, limit = 60, nameLen; const char *procName = TclGetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", - (int)(overflow ? limit :nameLen), procName, + (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* *---------------------------------------------------------------------- @@ -2088,11 +2094,11 @@ void TclProcDeleteProc( ClientData clientData) /* Procedure to be deleted. */ { - Proc *procPtr = clientData; + Proc *procPtr = (Proc *)clientData; if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } } @@ -2114,13 +2120,13 @@ *---------------------------------------------------------------------- */ void TclProcCleanupProc( - register Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { - register CompiledLocal *localPtr; + CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; Tcl_HashEntry *hePtr = NULL; CmdFrame *cfPtr = NULL; @@ -2135,22 +2141,22 @@ resVarInfo = localPtr->resolveInfo; if (resVarInfo) { if (resVarInfo->deleteProc) { resVarInfo->deleteProc(resVarInfo); } else { - Tcl_Free(resVarInfo); + ckfree(resVarInfo); } } if (localPtr->defValuePtr != NULL) { defPtr = localPtr->defValuePtr; Tcl_DecrRefCount(defPtr); } - Tcl_Free(localPtr); + ckfree(localPtr); localPtr = nextPtr; } - Tcl_Free(procPtr); + ckfree(procPtr); /* * TIP #280: Release the location data associated with this Proc * structure, if any. The interpreter may not exist (For example for * procbody structures created by tbcload. @@ -2163,20 +2169,20 @@ hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); if (!hePtr) { return; } - cfPtr = Tcl_GetHashValue(hePtr); + cfPtr = (CmdFrame *)Tcl_GetHashValue(hePtr); if (cfPtr) { if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); cfPtr->data.eval.path = NULL; } - Tcl_Free(cfPtr->line); + ckfree(cfPtr->line); cfPtr->line = NULL; - Tcl_Free(cfPtr); + ckfree(cfPtr); } Tcl_DeleteHashEntry(hePtr); } /* @@ -2365,11 +2371,11 @@ */ static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; LambdaGetIntRep(srcPtr, procPtr, nsObjPtr); @@ -2380,11 +2386,11 @@ LambdaSetIntRep(copyPtr, procPtr, nsObjPtr); } static void FreeLambdaInternalRep( - register Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2398,11 +2404,11 @@ } static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int isNew, objc, result; @@ -2420,11 +2426,11 @@ result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", - TclGetString(objPtr))); + Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL); return TCL_ERROR; } argsPtr = objv[0]; @@ -2470,11 +2476,11 @@ * previous paragraph to track into the list. Find a way to factor the * common elements into a single function. */ if (iPtr->cmdFramePtr) { - CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); *contextPtr = *iPtr->cmdFramePtr; if (contextPtr->type == TCL_LOCATION_BC) { /* * Retrieve the source context from the bytecode. This call @@ -2506,16 +2512,16 @@ /* * Move from approximation (line of list cmd word) to actual * location (line of 2nd list element). */ - cfPtr = Tcl_Alloc(sizeof(CmdFrame)); + cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = Tcl_Alloc(sizeof(int)); + cfPtr->line = (int *)ckalloc(sizeof(int)); cfPtr->line[0] = buf[1]; cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; @@ -2610,21 +2616,21 @@ *---------------------------------------------------------------------- */ int Tcl_ApplyObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, clientData, objc, objv); } int TclNRApplyObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Proc *procPtr = NULL; @@ -2658,11 +2664,11 @@ result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); if (result != TCL_OK) { return TCL_ERROR; } - extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData)); + extraPtr = (ApplyExtraData *)TclStackAlloc(interp, sizeof(ApplyExtraData)); memset(&extraPtr->cmd, 0, sizeof(Command)); procPtr->cmdPtr = &extraPtr->cmd; extraPtr->cmd.nsPtr = (Namespace *) nsPtr; /* @@ -2693,11 +2699,11 @@ ApplyNR2( ClientData data[], Tcl_Interp *interp, int result) { - ApplyExtraData *extraPtr = data[0]; + ApplyExtraData *extraPtr = (ApplyExtraData *)data[0]; TclStackFree(interp, extraPtr); return result; } @@ -2724,18 +2730,17 @@ Tcl_Interp *interp, /* The interpreter in which the procedure was * called. */ Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - unsigned int overflow, limit = 60; - size_t nameLen; + int overflow, limit = 60, nameLen; const char *procName = TclGetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", - (int)(overflow ? limit : nameLen), procName, + (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* *---------------------------------------------------------------------- Index: generic/tclProcess.c ================================================================== --- generic/tclProcess.c +++ generic/tclProcess.c @@ -45,11 +45,11 @@ static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, int resolvedPid); static void FreeProcessInfo(ProcessInfo *info); static int RefreshProcessInfo(ProcessInfo *info, int options); -static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, size_t resolvedPid, +static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, Tcl_Obj **errorObjPtr); static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); static int ProcessListObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -128,11 +128,11 @@ /* * Free allocated structure. */ - Tcl_Free(info); + ckfree(info); } /* *---------------------------------------------------------------------- * @@ -191,11 +191,11 @@ */ TclProcessWaitStatus WaitProcessStatus( Tcl_Pid pid, /* Process id. */ - size_t resolvedPid, /* Resolved process id. */ + int resolvedPid, /* Resolved process id. */ int options, /* Options passed to Tcl_WaitPid. */ int *codePtr, /* If non-NULL, will receive either: * - 0 for normal exit. * - errno in case of error. * - non-zero exit code for abormal exit. @@ -400,11 +400,11 @@ *---------------------------------------------------------------------- */ static int ProcessListObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *list; @@ -451,11 +451,11 @@ *---------------------------------------------------------------------- */ static int ProcessStatusObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *dict; @@ -599,11 +599,11 @@ *---------------------------------------------------------------------- */ static int ProcessPurgeObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_HashEntry *entry; @@ -699,15 +699,16 @@ *---------------------------------------------------------------------- */ static int ProcessAutopurgeObjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "?flag?"); return TCL_ERROR; } @@ -797,11 +798,11 @@ void TclProcessCreated( Tcl_Pid pid) /* Process id. */ { - size_t resolvedPid; + int resolvedPid; Tcl_HashEntry *entry, *entry2; int isNew; ProcessInfo *info; /* @@ -831,11 +832,11 @@ /* * Allocate and initialize info structure. */ - info = (ProcessInfo *) Tcl_Alloc(sizeof(ProcessInfo)); + info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo)); InitProcessInfo(info, pid, resolvedPid); /* * Add entry to tables. */ Index: generic/tclRegexp.c ================================================================== --- generic/tclRegexp.c +++ generic/tclRegexp.c @@ -68,11 +68,11 @@ typedef struct { int initialized; /* Set to 1 when the module is initialized. */ char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this * slot isn't used. Malloc-ed. */ - size_t patLengths[NUM_REGEXPS];/* Number of non-null characters in + int patLengths[NUM_REGEXPS];/* Number of non-null characters in * corresponding entry in patterns. -1 means * entry isn't used. */ struct TclRegexp *regexps[NUM_REGEXPS]; /* Compiled forms of above strings. Also * malloc-ed, or NULL if not in use yet. */ @@ -83,19 +83,19 @@ /* * Declarations for functions used only in this file. */ static TclRegexp * CompileRegexp(Tcl_Interp *interp, const char *pattern, - size_t length, int flags); + int length, int flags); static void DupRegexpInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FinalizeRegexp(ClientData clientData); static void FreeRegexp(TclRegexp *regexpPtr); static void FreeRegexpInternalRep(Tcl_Obj *objPtr); static int RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re, - const Tcl_UniChar *uniString, size_t numChars, - size_t nmatches, int flags); + const Tcl_UniChar *uniString, int numChars, + int nmatches, int flags); static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* * The regular expression Tcl object type. This serves as a cache of the * compiled form of the regular expression. @@ -120,11 +120,11 @@ #define RegexpGetIntRep(objPtr, rePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclRegexpType); \ - (rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* *---------------------------------------------------------------------- @@ -188,12 +188,11 @@ const char *text, /* Text against which to match re. */ const char *start) /* If text is part of a larger string, this * identifies beginning of larger string, so * that "^" won't match. */ { - int flags, result; - size_t numChars; + int flags, result, numChars; TclRegexp *regexp = (TclRegexp *) re; Tcl_DString ds; const Tcl_UniChar *ustr; /* @@ -249,11 +248,11 @@ void Tcl_RegExpRange( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - size_t index, /* 0 means give the range of the entire match, + int index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange. */ const char **startPtr, /* Store address of first character in * (sub-)range here. */ const char **endPtr) /* Store address of character just after last @@ -260,11 +259,11 @@ * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; - if (index > regexpPtr->re.re_nsub) { + if ((size_t) index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) { *startPtr = *endPtr = NULL; } else { if (regexpPtr->objPtr) { @@ -301,25 +300,27 @@ RegExpExecUniChar( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tcl_RegExp re, /* Compiled regular expression; returned by a * 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 + int numChars, /* Length of Tcl_UniChar string (must be + * >=0). */ + int nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ { int status; TclRegexp *regexpPtr = (TclRegexp *) re; size_t last = regexpPtr->re.re_nsub + 1; + size_t nm = last; - if (nm >= last) { - nm = last; + if (nmatches >= 0 && (size_t) nmatches < nm) { + nm = (size_t) nmatches; } - status = TclReExec(®expPtr->re, wString, numChars, + status = TclReExec(®expPtr->re, wString, (size_t) numChars, ®expPtr->details, nm, regexpPtr->matches, flags); /* * Check for errors. */ @@ -359,25 +360,25 @@ void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - size_t index, /* 0 means give the range of the entire match, + int index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange, TCL_INDEX_NONE means the range of the * rm_extend field. */ - size_t *startPtr, /* Store address of first character in + int *startPtr, /* Store address of first character in * (sub-)range here. */ - size_t *endPtr) /* Store address of character just after last + int *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; if ((regexpPtr->flags®_EXPECT) && (index == TCL_INDEX_NONE)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; - } else if (index + 1 > regexpPtr->re.re_nsub + 1) { + } else if ((size_t) index > regexpPtr->re.re_nsub) { *startPtr = TCL_INDEX_NONE; *endPtr = TCL_INDEX_NONE; } else { *startPtr = regexpPtr->matches[index].rm_so; *endPtr = regexpPtr->matches[index].rm_eo; @@ -439,20 +440,20 @@ Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tcl_RegExp re, /* Compiled regular expression; must have been * returned by previous call to * Tcl_GetRegExpFromObj. */ Tcl_Obj *textObj, /* Text against which to match re. */ - size_t offset, /* Character index that marks where matching + int offset, /* Character index that marks where matching * should begin. */ - size_t nmatches, /* How many subexpression matches (counting + int 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. */ { TclRegexp *regexpPtr = (TclRegexp *) re; Tcl_UniChar *udata; - size_t length; + int length; int reflags = regexpPtr->flags; #define TCL_REG_GLOBOK_FLAGS \ (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE) /* @@ -479,11 +480,11 @@ */ regexpPtr->string = NULL; regexpPtr->objPtr = textObj; - udata = TclGetUnicodeFromObj(textObj, &length); + udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; } udata += offset; @@ -591,11 +592,11 @@ * expression pattern. Internal rep will be * changed to compiled form of this regular * expression. */ int flags) /* Regular expression compilation flags. */ { - size_t length; + int length; TclRegexp *regexpPtr; const char *pattern; RegexpGetIntRep(objPtr, regexpPtr); @@ -675,11 +676,11 @@ * well and Tcl has other limits that constrain things as well... */ resultObj = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultObj, - TclNewWideIntObjFromSize(regexpPtr->re.re_nsub)); + Tcl_NewWideIntObj((Tcl_WideInt) regexpPtr->re.re_nsub)); /* * Now append a list of all the bit-flags set for the RE. */ @@ -722,16 +723,16 @@ char cbuf[TCL_INTEGER_SPACE]; size_t n; const char *p; Tcl_ResetResult(interp); - n = TclReError(status, NULL, buf, sizeof(buf)); + n = TclReError(status, buf, sizeof(buf)); p = (n > sizeof(buf)) ? "..." : ""; Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); sprintf(cbuf, "%d", status); - (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf)); + (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf)); Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL); } /* *---------------------------------------------------------------------- @@ -855,11 +856,11 @@ 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. */ + int length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; const Tcl_UniChar *uniString; int numChars, status, i, exact; @@ -913,11 +914,11 @@ /* * This is a new expression, so compile it and add it to the cache. */ - regexpPtr = Tcl_Alloc(sizeof(TclRegexp)); + regexpPtr = (TclRegexp*)ckalloc(sizeof(TclRegexp)); regexpPtr->objPtr = NULL; regexpPtr->string = NULL; regexpPtr->details.rm_extend.rm_so = -1; regexpPtr->details.rm_extend.rm_eo = -1; @@ -940,11 +941,11 @@ if (status != REG_OKAY) { /* * Clean up and report errors in the interpreter, if possible. */ - Tcl_Free(regexpPtr); + ckfree(regexpPtr); if (interp) { TclRegError(interp, "couldn't compile regular expression pattern: ", status); } return NULL; @@ -968,11 +969,11 @@ * Allocate enough space for all of the subexpressions, plus one extra for * the entire pattern. */ regexpPtr->matches = - Tcl_Alloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); + (regmatch_t*)ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); /* * Initialize the refcount to one initially, since it is in the cache. */ @@ -987,18 +988,18 @@ TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1]; if (oldRegexpPtr->refCount-- <= 1) { FreeRegexp(oldRegexpPtr); } - Tcl_Free(tsdPtr->patterns[NUM_REGEXPS-1]); + ckfree(tsdPtr->patterns[NUM_REGEXPS-1]); } for (i = NUM_REGEXPS - 2; i >= 0; i--) { tsdPtr->patterns[i+1] = tsdPtr->patterns[i]; tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i]; tsdPtr->regexps[i+1] = tsdPtr->regexps[i]; } - tsdPtr->patterns[0] = Tcl_Alloc(length + 1); + tsdPtr->patterns[0] = (char *)ckalloc(length + 1); memcpy(tsdPtr->patterns[0], string, length + 1); tsdPtr->patLengths[0] = length; tsdPtr->regexps[0] = regexpPtr; return regexpPtr; @@ -1027,13 +1028,13 @@ TclReFree(®expPtr->re); if (regexpPtr->globObjPtr) { TclDecrRefCount(regexpPtr->globObjPtr); } if (regexpPtr->matches) { - Tcl_Free(regexpPtr->matches); + ckfree(regexpPtr->matches); } - Tcl_Free(regexpPtr); + ckfree(regexpPtr); } /* *---------------------------------------------------------------------- * @@ -1050,11 +1051,11 @@ *---------------------------------------------------------------------- */ static void FinalizeRegexp( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { int i; TclRegexp *regexpPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -1061,11 +1062,11 @@ for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) { regexpPtr = tsdPtr->regexps[i]; if (regexpPtr->refCount-- <= 1) { FreeRegexp(regexpPtr); } - Tcl_Free(tsdPtr->patterns[i]); + ckfree(tsdPtr->patterns[i]); tsdPtr->patterns[i] = NULL; } /* * We may find ourselves reinitialized if another finalization routine Index: generic/tclResolve.c ================================================================== --- generic/tclResolve.c +++ generic/tclResolve.c @@ -99,13 +99,13 @@ /* * Otherwise, this is a new scheme. Add it to the FRONT of the linked * list, so that it overrides existing schemes. */ - resPtr = Tcl_Alloc(sizeof(ResolverScheme)); + resPtr = (ResolverScheme *)ckalloc(sizeof(ResolverScheme)); len = strlen(name) + 1; - resPtr->name = Tcl_Alloc(len); + resPtr->name = (char *)ckalloc(len); memcpy(resPtr->name, name, len); resPtr->cmdResProc = cmdProc; resPtr->varResProc = varProc; resPtr->compiledVarResProc = compiledVarProc; resPtr->nextPtr = iPtr->resolverPtr; @@ -223,12 +223,12 @@ if (resPtr->cmdResProc) { BumpCmdRefEpochs(iPtr->globalNsPtr); } *prevPtrPtr = resPtr->nextPtr; - Tcl_Free(resPtr->name); - Tcl_Free(resPtr); + ckfree(resPtr->name); + ckfree(resPtr); return 1; } return 0; } @@ -263,11 +263,11 @@ nsPtr->cmdRefEpoch++; #ifndef BREAK_NAMESPACE_COMPAT for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { - Namespace *childNsPtr = Tcl_GetHashValue(entry); + Namespace *childNsPtr = (Namespace *)Tcl_GetHashValue(entry); BumpCmdRefEpochs(childNsPtr); } #else if (nsPtr->childTablePtr != NULL) { Index: generic/tclResult.c ================================================================== --- generic/tclResult.c +++ generic/tclResult.c @@ -25,10 +25,13 @@ */ static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); +#ifndef TCL_NO_DEPRECATED +static void SetupAppendBuffer(Interp *iPtr, int newSpace); +#endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in * Tcl_SaveInterpState. You can snapshot the state, execute a command, and * then back up to the result or the error that was previously in progress. @@ -72,11 +75,11 @@ Tcl_SaveInterpState( Tcl_Interp *interp, /* Interpreter's state to be saved */ int status) /* status code for current operation */ { Interp *iPtr = (Interp *) interp; - InterpState *statePtr = Tcl_Alloc(sizeof(InterpState)); + InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState)); statePtr->status = status; statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED; statePtr->returnLevel = iPtr->returnLevel; statePtr->returnCode = iPtr->returnCode; @@ -202,12 +205,302 @@ } if (statePtr->errorStack) { Tcl_DecrRefCount(statePtr->errorStack); } Tcl_DecrRefCount(statePtr->objResult); - Tcl_Free(statePtr); + ckfree(statePtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SaveResult -- + * + * Takes a snapshot of the current result state of the interpreter. The + * snapshot can be restored at any point by Tcl_RestoreResult. Note that + * this routine does not preserve the errorCode, errorInfo, or flags + * fields so it should not be used if an error is in progress. + * + * Once a snapshot is saved, it must be restored by calling + * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult. + * + * Results: + * None. + * + * Side effects: + * Resets the interpreter result. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_SaveResult +void +Tcl_SaveResult( + Tcl_Interp *interp, /* Interpreter to save. */ + Tcl_SavedResult *statePtr) /* Pointer to state structure. */ +{ + Interp *iPtr = (Interp *) interp; + + /* + * Move the result object into the save state. Note that we don't need to + * change its refcount because we're moving it, not adding a new + * reference. Put an empty object into the interpreter. + */ + + statePtr->objResultPtr = iPtr->objResultPtr; + iPtr->objResultPtr = Tcl_NewObj(); + Tcl_IncrRefCount(iPtr->objResultPtr); + + /* + * Save the string result. + */ + + statePtr->freeProc = iPtr->freeProc; + if (iPtr->result == iPtr->resultSpace) { + /* + * Copy the static string data out of the interp buffer. + */ + + statePtr->result = statePtr->resultSpace; + strcpy(statePtr->result, iPtr->result); + statePtr->appendResult = NULL; + } else if (iPtr->result == iPtr->appendResult) { + /* + * Move the append buffer out of the interp. + */ + + statePtr->appendResult = iPtr->appendResult; + statePtr->appendAvl = iPtr->appendAvl; + statePtr->appendUsed = iPtr->appendUsed; + statePtr->result = statePtr->appendResult; + iPtr->appendResult = NULL; + iPtr->appendAvl = 0; + iPtr->appendUsed = 0; + } else { + /* + * Move the dynamic or static string out of the interpreter. + */ + + statePtr->result = iPtr->result; + statePtr->appendResult = NULL; + } + + iPtr->result = iPtr->resultSpace; + iPtr->resultSpace[0] = 0; + iPtr->freeProc = 0; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_RestoreResult -- + * + * Restores the state of the interpreter to a snapshot taken by + * Tcl_SaveResult. After this call, the token for the interpreter state + * is no longer valid. + * + * Results: + * None. + * + * Side effects: + * Restores the interpreter result. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_RestoreResult +void +Tcl_RestoreResult( + Tcl_Interp *interp, /* Interpreter being restored. */ + Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ +{ + Interp *iPtr = (Interp *) interp; + + Tcl_ResetResult(interp); + + /* + * Restore the string result. + */ + + iPtr->freeProc = statePtr->freeProc; + if (statePtr->result == statePtr->resultSpace) { + /* + * Copy the static string data into the interp buffer. + */ + + iPtr->result = iPtr->resultSpace; + strcpy(iPtr->result, statePtr->result); + } else if (statePtr->result == statePtr->appendResult) { + /* + * Move the append buffer back into the interp. + */ + + if (iPtr->appendResult != NULL) { + ckfree(iPtr->appendResult); + } + + iPtr->appendResult = statePtr->appendResult; + iPtr->appendAvl = statePtr->appendAvl; + iPtr->appendUsed = statePtr->appendUsed; + iPtr->result = iPtr->appendResult; + } else { + /* + * Move the dynamic or static string back into the interpreter. + */ + + iPtr->result = statePtr->result; + } + + /* + * Restore the object result. + */ + + Tcl_DecrRefCount(iPtr->objResultPtr); + iPtr->objResultPtr = statePtr->objResultPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_DiscardResult -- + * + * Frees the memory associated with an interpreter snapshot taken by + * Tcl_SaveResult. If the snapshot is not restored, this function must be + * called to discard it, or the memory will be lost. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_DiscardResult +void +Tcl_DiscardResult( + Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ +{ + TclDecrRefCount(statePtr->objResultPtr); + + if (statePtr->result == statePtr->appendResult) { + ckfree(statePtr->appendResult); + } else if (statePtr->freeProc == TCL_DYNAMIC) { + ckfree(statePtr->result); + } else if (statePtr->freeProc) { + statePtr->freeProc(statePtr->result); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetResult -- + * + * Arrange for "result" to be the Tcl return value. + * + * Results: + * None. + * + * Side effects: + * interp->result is left pointing either to "result" or to a copy of it. + * Also, the object result is reset. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetResult( + Tcl_Interp *interp, /* Interpreter with which to associate the + * return value. */ + char *result, /* Value to be returned. If NULL, the result + * is set to an empty string. */ + Tcl_FreeProc *freeProc) /* Gives information about the string: + * TCL_STATIC, TCL_VOLATILE, or the address of + * a Tcl_FreeProc such as free. */ +{ + Interp *iPtr = (Interp *) interp; + Tcl_FreeProc *oldFreeProc = iPtr->freeProc; + char *oldResult = iPtr->result; + + if (result == NULL) { + iPtr->resultSpace[0] = 0; + iPtr->result = iPtr->resultSpace; + iPtr->freeProc = 0; + } else if (freeProc == TCL_VOLATILE) { + int length = strlen(result); + + if (length > TCL_RESULT_SIZE) { + iPtr->result = (char *)ckalloc(length + 1); + iPtr->freeProc = TCL_DYNAMIC; + } else { + iPtr->result = iPtr->resultSpace; + iPtr->freeProc = 0; + } + memcpy(iPtr->result, result, length+1); + } else { + iPtr->result = (char *) result; + iPtr->freeProc = freeProc; + } + + /* + * If the old result was dynamically-allocated, free it up. Do it here, + * rather than at the beginning, in case the new result value was part of + * the old result value. + */ + + if (oldFreeProc != 0) { + if (oldFreeProc == TCL_DYNAMIC) { + ckfree(oldResult); + } else { + oldFreeProc(oldResult); + } + } + + /* + * Reset the object result since we just set the string result. + */ + + ResetObjResult(iPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetStringResult -- + * + * Returns an interpreter's result value as a string. + * + * Results: + * The interpreter's result as a string. + * + * Side effects: + * If the string result is empty, the object result is moved to the + * string result, then the object result is reset. + * + *---------------------------------------------------------------------- + */ + +const char * +Tcl_GetStringResult( + Tcl_Interp *interp)/* Interpreter whose result to return. */ +{ + Interp *iPtr = (Interp *) interp; + /* + * If the string result is empty, move the object result to the string + * result, then reset the object result. + */ + + if (*(iPtr->result) == 0) { + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); + } + return iPtr->result; } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_SetObjResult -- @@ -228,15 +521,15 @@ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ - register Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj + Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj * result is made an empty string object. */ { - register Interp *iPtr = (Interp *) interp; - register Tcl_Obj *oldObjResult = iPtr->objResultPtr; + Interp *iPtr = (Interp *) interp; + Tcl_Obj *oldObjResult = iPtr->objResultPtr; iPtr->objResultPtr = objPtr; Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ /* @@ -243,10 +536,27 @@ * We wait until the end to release the old object result, in case we are * setting the result to itself. */ TclDecrRefCount(oldObjResult); + +#ifndef TCL_NO_DEPRECATED + /* + * Reset the string result since we just set the result object. + */ + + if (iPtr->freeProc != NULL) { + if (iPtr->freeProc == TCL_DYNAMIC) { + ckfree(iPtr->result); + } else { + iPtr->freeProc(iPtr->result); + } + iPtr->freeProc = 0; + } + iPtr->result = iPtr->resultSpace; + iPtr->resultSpace[0] = 0; +#endif } /* *---------------------------------------------------------------------- * @@ -270,14 +580,76 @@ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; +#ifndef TCL_NO_DEPRECATED + Tcl_Obj *objResultPtr; + int length; + /* + * If the string result is non-empty, move the string result to the object + * result, then reset the string result. + */ + + if (iPtr->result[0] != 0) { + ResetObjResult(iPtr); + + objResultPtr = iPtr->objResultPtr; + length = strlen(iPtr->result); + TclInitStringRep(objResultPtr, iPtr->result, length); + + if (iPtr->freeProc != NULL) { + if (iPtr->freeProc == TCL_DYNAMIC) { + ckfree(iPtr->result); + } else { + iPtr->freeProc(iPtr->result); + } + iPtr->freeProc = 0; + } + iPtr->result = iPtr->resultSpace; + iPtr->result[0] = 0; + } +#endif /* !TCL_NO_DEPRECATED */ return iPtr->objResultPtr; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendResultVA -- + * + * Append a variable number of strings onto the interpreter's result. + * + * Results: + * None. + * + * Side effects: + * The result of the interpreter given by the first argument is extended + * by the strings in the va_list (up to a terminating NULL argument). + * + * If the string result is non-empty, the object result forced to be a + * duplicate of it first. There will be a string result afterwards. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AppendResultVA( + Tcl_Interp *interp, /* Interpreter with which to associate the + * return value. */ + va_list argList) /* Variable argument list. */ +{ + Tcl_Obj *objPtr = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(objPtr)) { + objPtr = Tcl_DuplicateObj(objPtr); + } + Tcl_AppendStringsToObjVA(objPtr, argList); + Tcl_SetObjResult(interp, objPtr); +} /* *---------------------------------------------------------------------- * * Tcl_AppendResult -- @@ -301,27 +673,13 @@ void Tcl_AppendResult( Tcl_Interp *interp, ...) { va_list argList; - Tcl_Obj *objPtr; va_start(argList, interp); - objPtr = Tcl_GetObjResult(interp); - - if (Tcl_IsShared(objPtr)) { - objPtr = Tcl_DuplicateObj(objPtr); - } - while (1) { - const char *bytes = va_arg(argList, char *); - - if (bytes == NULL) { - break; - } - Tcl_AppendToObj(objPtr, bytes, -1); - } - Tcl_SetObjResult(interp, objPtr); + Tcl_AppendResultVA(interp, argList); va_end(argList); } /* *---------------------------------------------------------------------- @@ -352,56 +710,202 @@ * extended. */ const char *element) /* String to convert to list element and add * to result. */ { Interp *iPtr = (Interp *) interp; +#ifdef TCL_NO_DEPRECATED Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; - size_t length; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); } - bytes = TclGetStringFromObj(iPtr->objResultPtr, &length); - if (TclNeedSpace(bytes, bytes + length)) { + bytes = TclGetString(iPtr->objResultPtr); + if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) { Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); +#else + char *dst; + int size; + int flags; + int quoteHash = 1; + + /* + * If the string result is empty, move the object result to the string + * result, then reset the object result. + */ + + (void) Tcl_GetStringResult(interp); + + /* + * See how much space is needed, and grow the append buffer if needed to + * accommodate the list element. + */ + + size = Tcl_ScanElement(element, &flags) + 1; + if ((iPtr->result != iPtr->appendResult) + || (iPtr->appendResult[iPtr->appendUsed] != 0) + || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { + SetupAppendBuffer(iPtr, size+iPtr->appendUsed); + } + + /* + * Convert the string into a list element and copy it to the buffer that's + * forming, with a space separator if needed. + */ + + dst = iPtr->appendResult + iPtr->appendUsed; + if (TclNeedSpace(iPtr->appendResult, dst)) { + iPtr->appendUsed++; + *dst = ' '; + dst++; + + /* + * If we need a space to separate this element from preceding stuff, + * then this element will not lead a list, and need not have it's + * leading '#' quoted. + */ + quoteHash = 0; + } else { + while ((--dst >= iPtr->appendResult) && TclIsSpaceProcM(*dst)) { + } + quoteHash = !TclNeedSpace(iPtr->appendResult, dst+1); + } + dst = iPtr->appendResult + iPtr->appendUsed; + if (!quoteHash) { + flags |= TCL_DONT_QUOTE_HASH; + } + + iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); +#endif /* !TCL_NO_DEPRECATED */ +} + +/* + *---------------------------------------------------------------------- + * + * SetupAppendBuffer -- + * + * This function makes sure that there is an append buffer properly + * initialized, if necessary, from the interpreter's result, and that it + * has at least enough room to accommodate newSpace new bytes of + * information. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +static void +SetupAppendBuffer( + Interp *iPtr, /* Interpreter whose result is being set up. */ + int newSpace) /* Make sure that at least this many bytes of + * new information may be added. */ +{ + int totalSpace; + + /* + * Make the append buffer larger, if that's necessary, then copy the + * result into the append buffer and make the append buffer the official + * Tcl result. + */ + + if (iPtr->result != iPtr->appendResult) { + /* + * If an oversized buffer was used recently, then free it up so we go + * back to a smaller buffer. This avoids tying up memory forever after + * a large operation. + */ + + if (iPtr->appendAvl > 500) { + ckfree(iPtr->appendResult); + iPtr->appendResult = NULL; + iPtr->appendAvl = 0; + } + iPtr->appendUsed = strlen(iPtr->result); + } else if (iPtr->result[iPtr->appendUsed] != 0) { + /* + * Most likely someone has modified a result created by + * Tcl_AppendResult et al. so that it has a different size. Just + * recompute the size. + */ + + iPtr->appendUsed = strlen(iPtr->result); + } + + totalSpace = newSpace + iPtr->appendUsed; + if (totalSpace >= iPtr->appendAvl) { + char *newSpace; + + if (totalSpace < 100) { + totalSpace = 200; + } else { + totalSpace *= 2; + } + newSpace = (char *)ckalloc(totalSpace); + strcpy(newSpace, iPtr->result); + if (iPtr->appendResult != NULL) { + ckfree(iPtr->appendResult); + } + iPtr->appendResult = newSpace; + iPtr->appendAvl = totalSpace; + } else if (iPtr->result != iPtr->appendResult) { + strcpy(iPtr->appendResult, iPtr->result); + } + + Tcl_FreeResult((Tcl_Interp *) iPtr); + iPtr->result = iPtr->appendResult; } /* *---------------------------------------------------------------------- * * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * result, resetting the interpreter's result object. Tcl_FreeResult is - * most commonly used when a function is about to replace one result - * value with another. + * string result. It also resets the interpreter's result object. + * Tcl_FreeResult is most commonly used when a function is about to + * replace one result value with another. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's result but does not change - * any part of the error dictionary (i.e., the errorinfo and errorcode - * remain the same). + * Frees the memory associated with interp's string result and sets + * interp->freeProc to zero, but does not change interp->result or clear + * error state. Resets interp's result object to an unshared empty + * object. * *---------------------------------------------------------------------- */ void Tcl_FreeResult( - register Tcl_Interp *interp)/* Interpreter for which to free result. */ + Tcl_Interp *interp)/* Interpreter for which to free result. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; + + if (iPtr->freeProc != NULL) { + if (iPtr->freeProc == TCL_DYNAMIC) { + ckfree(iPtr->result); + } else { + iPtr->freeProc(iPtr->result); + } + iPtr->freeProc = 0; + } ResetObjResult(iPtr); } - +#endif /* !TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_ResetResult -- * @@ -419,15 +923,27 @@ *---------------------------------------------------------------------- */ void Tcl_ResetResult( - register Tcl_Interp *interp)/* Interpreter for which to clear result. */ + Tcl_Interp *interp)/* Interpreter for which to clear result. */ { - register Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); +#ifndef TCL_NO_DEPRECATED + if (iPtr->freeProc != NULL) { + if (iPtr->freeProc == TCL_DYNAMIC) { + ckfree(iPtr->result); + } else { + iPtr->freeProc(iPtr->result); + } + iPtr->freeProc = 0; + } + iPtr->result = iPtr->resultSpace; + iPtr->resultSpace[0] = 0; +#endif /* !TCL_NO_DEPRECATED */ if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); @@ -472,31 +988,73 @@ *---------------------------------------------------------------------- */ static void ResetObjResult( - register Interp *iPtr) /* Points to the interpreter whose result + Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { - register Tcl_Obj *objResultPtr = iPtr->objResultPtr; + Tcl_Obj *objResultPtr = iPtr->objResultPtr; if (Tcl_IsShared(objResultPtr)) { TclDecrRefCount(objResultPtr); TclNewObj(objResultPtr); Tcl_IncrRefCount(objResultPtr); iPtr->objResultPtr = objResultPtr; } else { if (objResultPtr->bytes != &tclEmptyString) { if (objResultPtr->bytes) { - Tcl_Free(objResultPtr->bytes); + ckfree(objResultPtr->bytes); } objResultPtr->bytes = &tclEmptyString; objResultPtr->length = 0; } TclFreeIntRep(objResultPtr); } } + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetErrorCodeVA -- + * + * This function is called to record machine-readable information about + * an error that is about to be returned. + * + * Results: + * None. + * + * Side effects: + * The errorCode field of the interp is modified to hold all of the + * arguments to this function, in a list form with each argument becoming + * one element of the list. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetErrorCodeVA( + Tcl_Interp *interp, /* Interpreter in which to set errorCode */ + va_list argList) /* Variable argument list. */ +{ + Tcl_Obj *errorObj = Tcl_NewObj(); + + /* + * Scan through the arguments one at a time, appending them to the + * errorCode field as list elements. + */ + + while (1) { + char *elem = va_arg(argList, char *); + + if (elem == NULL) { + break; + } + Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); + } + Tcl_SetObjErrorCode(interp, errorObj); +} /* *---------------------------------------------------------------------- * * Tcl_SetErrorCode -- @@ -518,34 +1076,18 @@ void Tcl_SetErrorCode( Tcl_Interp *interp, ...) { va_list argList; - Tcl_Obj *errorObj; /* * Scan through the arguments one at a time, appending them to the * errorCode field as list elements. */ va_start(argList, interp); - errorObj = Tcl_NewObj(); - - /* - * Scan through the arguments one at a time, appending them to the - * errorCode field as list elements. - */ - - while (1) { - char *elem = va_arg(argList, char *); - - if (elem == NULL) { - break; - } - Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); - } - Tcl_SetObjErrorCode(interp, errorObj); + Tcl_SetErrorCodeVA(interp, argList); va_end(argList); } /* *---------------------------------------------------------------------- @@ -587,10 +1129,11 @@ * Returns the line number associated with the current error. * *---------------------------------------------------------------------- */ +#undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) { return ((Interp *) interp)->errorLine; @@ -604,10 +1147,11 @@ * Sets the line number associated with the current error. * *---------------------------------------------------------------------- */ +#undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, int value) { @@ -637,12 +1181,12 @@ static Tcl_Obj ** GetKeys(void) { static Tcl_ThreadDataKey returnKeysKey; - Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey, - (int) (KEY_LAST * sizeof(Tcl_Obj *))); + Tcl_Obj **keys = (Tcl_Obj **)Tcl_GetThreadData(&returnKeysKey, + KEY_LAST * sizeof(Tcl_Obj *)); if (keys[0] == NULL) { /* * First call in this thread, create the keys... */ @@ -689,11 +1233,11 @@ static void ReleaseKeys( ClientData clientData) { - Tcl_Obj **keys = clientData; + Tcl_Obj **keys = (Tcl_Obj **)clientData; int i; for (i = KEY_CODE; i < KEY_LAST; i++) { Tcl_DecrRefCount(keys[i]); keys[i] = NULL; @@ -749,14 +1293,12 @@ iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { - size_t length; - - (void) TclGetStringFromObj(valuePtr, &length); - if (length) { + (void) TclGetString(valuePtr); + if (valuePtr->length) { iPtr->errorInfo = valuePtr; Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; } } @@ -1153,43 +1695,37 @@ /* *------------------------------------------------------------------------- * * Tcl_TransferResult -- * - * Copy the result (and error information) from one interp to another. + * Transfer the result (and error information) from one interp to another. * Used when one interp has caused another interp to evaluate a script * and then wants to transfer the results back to itself. * - * This routine copies the string reps of the result and error - * information. It does not simply increment the refcounts of the result - * and error information objects themselves. It is not legal to exchange - * objects between interps, because an object may be kept alive by one - * interp, but have an internal rep that is only valid while some other - * interp is alive. - * * Results: - * The target interp's result is set to a copy of the source interp's - * result. The source's errorInfo field may be transferred to the - * target's errorInfo field, and the source's errorCode field may be - * transferred to the target's errorCode field. + * The result of targetInterp is set to the result read from sourceInterp. + * The return options dictionary of sourceInterp is transferred to + * targetInterp as appropriate for the return code value code. * * Side effects: * None. * *------------------------------------------------------------------------- */ void Tcl_TransferResult( - Tcl_Interp *sourceInterp, /* Interp whose result and error information + Tcl_Interp *sourceInterp, /* Interp whose result and return options * should be moved to the target interp. * After moving result, this interp's result * is reset. */ - int result, /* TCL_OK if just the result should be copied, - * TCL_ERROR if both the result and error - * information should be copied. */ - Tcl_Interp *targetInterp) /* Interp where result and error information + int code, /* The return code value active in + * sourceInterp. Controls how the return options + * dictionary is retrieved from sourceInterp, + * same as in Tcl_GetReturnOptions, to then be + * transferred to targetInterp. */ + Tcl_Interp *targetInterp) /* Interp where result and return options * should be stored. If source and target are * the same, nothing is done. */ { Interp *tiPtr = (Interp *) targetInterp; Interp *siPtr = (Interp *) sourceInterp; @@ -1196,11 +1732,11 @@ if (sourceInterp == targetInterp) { return; } - if (result == TCL_OK && siPtr->returnOpts == NULL) { + if (code == TCL_OK && siPtr->returnOpts == NULL) { /* * Special optimization for the common case of normal command return * code and no explicit return options. */ @@ -1208,11 +1744,11 @@ Tcl_DecrRefCount(tiPtr->returnOpts); tiPtr->returnOpts = NULL; } } else { Tcl_SetReturnOptions(targetInterp, - Tcl_GetReturnOptions(sourceInterp, result)); + Tcl_GetReturnOptions(sourceInterp, code)); tiPtr->flags &= ~(ERR_ALREADY_LOGGED); } Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp)); Tcl_ResetResult(sourceInterp); } Index: generic/tclScan.c ================================================================== --- generic/tclScan.c +++ generic/tclScan.c @@ -8,11 +8,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" /* * Flag values used by Tcl_ScanObjCmd. */ @@ -28,18 +28,20 @@ * The following structure contains the information associated with a * character set. */ typedef struct { + Tcl_UniChar start; + Tcl_UniChar end; +} Range; + +typedef struct CharSet { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; int nranges; - struct Range { - Tcl_UniChar start; - Tcl_UniChar end; - } *ranges; + Range *ranges; } CharSet; /* * Declarations for functions used only in this file. */ @@ -100,13 +102,13 @@ nranges++; } end += TclUtfToUniChar(end, &ch); } - cset->chars = Tcl_Alloc(sizeof(Tcl_UniChar) * (end - format - 1)); + cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { - cset->ranges = Tcl_Alloc(sizeof(struct Range) * nranges); + cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges); } else { cset->ranges = NULL; } /* @@ -222,13 +224,13 @@ static void ReleaseCharSet( CharSet *cset) { - Tcl_Free(cset->chars); + ckfree(cset->chars); if (cset->ranges) { - Tcl_Free(cset->ranges); + ckfree(cset->ranges); } } /* *---------------------------------------------------------------------- @@ -258,16 +260,16 @@ { int gotXpg, gotSequential, value, i, flags; char *end; Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; - int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); - char buf[TCL_UTF_MAX + 1] = ""; + int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ + char buf[5] = ""; /* * Initialize an array that records the number of times a variable is * assigned to by the format string. We use this to detect if a variable * is multiply assigned or left unassigned. @@ -361,12 +363,14 @@ flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } + /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; + /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) { @@ -384,13 +388,11 @@ "field width may not be specified in %c conversion", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } - /* - * Fall through! - */ + /* FALLTHRU */ case 'n': case 's': if (flags & (SCAN_LONGER|SCAN_BIG)) { invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; @@ -475,11 +477,11 @@ if (xpgSize) { nspace = xpgSize; } else { nspace += 16; /* formerly STATIC_LIST_SIZE */ } - nassign = TclStackRealloc(interp, nassign, + nassign = (int *)TclStackRealloc(interp, nassign, nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; } } @@ -558,14 +560,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ScanObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *format; @@ -577,21 +578,18 @@ int width, underflow = 0; Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; - char buf[513]; /* Temporary buffer to hold scanned number - * strings before they are passed to - * strtoul. */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "string format ?varName ...?"); return TCL_ERROR; } - format = TclGetString(objv[2]); + format = Tcl_GetString(objv[2]); numVars = objc-3; /* * Check for errors in the format string. */ @@ -603,17 +601,17 @@ /* * Allocate space for the result objects. */ if (totalVars > 0) { - objs = Tcl_Alloc(sizeof(Tcl_Obj *) * totalVars); + objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } } - string = TclGetString(objv[1]); + string = Tcl_GetString(objv[1]); baseString = string; /* * Iterate over the format string filling in the result objects until we * reach the end of input, the end of the format string, or there is a @@ -701,15 +699,14 @@ flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } + /* FALLTHRU */ case 'L': flags |= SCAN_LONGER; - /* - * Fall through so we skip to the next character. - */ + /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } /* @@ -877,18 +874,11 @@ case 'c': /* * Scan a single Unicode character. */ - offset = TclUtfToUniChar(string, &sch); - i = (int)sch; -#if TCL_UTF_MAX <= 4 - if ((sch >= 0xD800) && (offset < 3)) { - offset += TclUtfToUniChar(string+offset, &sch); - i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF); - } -#endif + offset = TclUtfToUCS4(string, &i); string += offset; if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewWideIntObj(i); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); @@ -904,11 +894,11 @@ Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, - &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) { + &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { underflow = 1; } @@ -930,30 +920,37 @@ if (TclGetString(objPtr)[0] == '-') { wideValue = WIDE_MIN; } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { - sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue); - Tcl_SetStringObj(objPtr, buf, -1); + mp_int big; + if (mp_init_u64(&big, (Tcl_WideUInt)wideValue) != MP_OKAY) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "insufficient memory to create bignum", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + return TCL_ERROR; + } else { + Tcl_SetBignumObj(objPtr, &big); + } } else { TclSetIntObj(objPtr, wideValue); } } else if (flags & SCAN_BIG) { if (flags & SCAN_UNSIGNED) { mp_int big; int code = Tcl_GetBignumFromObj(interp, objPtr, &big); if (code == TCL_OK) { - if (big.sign != MP_ZPOS) { + if (mp_isneg(&big)) { code = TCL_ERROR; } mp_clear(&big); } if (code == TCL_ERROR) { if (objs != NULL) { - Tcl_Free(objs); + ckfree(objs); } Tcl_DecrRefCount(objPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( "unsigned bignum scans are invalid", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", @@ -968,12 +965,23 @@ } else { value = LONG_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ - Tcl_SetStringObj(objPtr, buf, -1); +#ifdef TCL_WIDE_INT_IS_LONG + mp_int big; + if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "insufficient memory to create bignum", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + return TCL_ERROR; + } else { + Tcl_SetBignumObj(objPtr, &big); + } +#else + Tcl_SetWideIntObj(objPtr, (unsigned long)value); +#endif } else { TclSetIntObj(objPtr, value); } } objs[objIndex++] = objPtr; @@ -988,11 +996,11 @@ Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, - &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) { + &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { underflow = 1; } @@ -1074,11 +1082,11 @@ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj()); } } } if (objs != NULL) { - Tcl_Free(objs); + ckfree(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { if (numVars) { objPtr = Tcl_NewWideIntObj(-1); Index: generic/tclStrToD.c ================================================================== --- generic/tclStrToD.c +++ generic/tclStrToD.c @@ -12,12 +12,17 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" +#include #include + +#ifdef _WIN32 +#define copysign _copysign +#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 * uniquely determined by radix and by the widths of significand and exponent. @@ -43,11 +48,11 @@ #if defined(__GNUC__) typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); #define _FPU_GETCW(cw) __asm__ __volatile__ ("fnstcw %0" : "=m" (*&cw)) #define _FPU_SETCW(cw) __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw)) -# define FPU_IEEE_ROUNDING 0x027f +# define FPU_IEEE_ROUNDING 0x027F # define ADJUST_FPU_CONTROL_WORD #define TCL_IEEE_DOUBLE_ROUNDING \ fpu_control_t roundTo53Bits = FPU_IEEE_ROUNDING; \ fpu_control_t oldRoundingMode; \ _FPU_GETCW(oldRoundingMode); \ @@ -92,14 +97,14 @@ * HP's PA_RISC architecture uses 7ff4000000000000 to represent a quiet NaN. * Everyone else uses 7ff8000000000000. (Why, HP, why?) */ #ifdef __hppa -# define NAN_START 0x7ff4 +# define NAN_START 0x7FF4 # define NAN_MASK (((Tcl_WideUInt) 1) << 50) #else -# define NAN_START 0x7ff8 +# define NAN_START 0x7FF8 # define NAN_MASK (((Tcl_WideUInt) 1) << 51) #endif /* * Constants used by this file (most of which are only ever calculated at @@ -117,37 +122,37 @@ */ #define SIGN_BIT 0x80000000 /* Mask for the sign bit in the first word of * a double. */ -#define EXP_MASK 0x7ff00000 +#define EXP_MASK 0x7FF00000 /* Mask for the exponent field in the first * word of a double. */ #define EXP_SHIFT 20 /* Shift count to make the exponent an * integer. */ #define HIDDEN_BIT (((Tcl_WideUInt) 0x00100000) << 32) /* Hidden 1 bit for the significand. */ -#define HI_ORDER_SIG_MASK 0x000fffff +#define HI_ORDER_SIG_MASK 0x000FFFFF /* Mask for the high-order part of the * significand in the first word of a * double. */ #define SIG_MASK (((Tcl_WideUInt) HI_ORDER_SIG_MASK << 32) \ - | 0xffffffff) + | 0xFFFFFFFF) /* Mask for the 52-bit significand. */ #define FP_PRECISION 53 /* Number of bits of significand plus the * hidden bit. */ -#define EXPONENT_BIAS 0x3ff /* Bias of the exponent 0. */ +#define EXPONENT_BIAS 0x3FF /* Bias of the exponent 0. */ /* * Derived quantities. */ #define TEN_PMAX 22 /* floor(FP_PRECISION*log(2)/log(5)) */ #define QUICK_MAX 14 /* floor((FP_PRECISION-1)*log(2)/log(10))-1 */ #define BLETCH 0x10 /* Highest power of two that is greater than * DBL_MAX_10_EXP, divided by 16. */ -#define DIGIT_GROUP 8 /* floor(DIGIT_BIT*log(2)/log(10)) */ +#define DIGIT_GROUP 8 /* floor(MP_DIGIT_BIT*log(2)/log(10)) */ /* * Union used to dismantle floating point numbers. */ @@ -287,20 +292,20 @@ */ static int AccumulateDecimalDigit(unsigned, int, Tcl_WideUInt *, mp_int *, int); static double MakeHighPrecisionDouble(int signum, - mp_int *significand, int nSigDigs, int exponent); + mp_int *significand, int nSigDigs, long exponent); static double MakeLowPrecisionDouble(int signum, Tcl_WideUInt significand, int nSigDigs, - int exponent); + long exponent); #ifdef IEEE_FLOATING_POINT static double MakeNaN(int signum, Tcl_WideUInt tag); #endif static double RefineApproximation(double approx, mp_int *exactSignificand, int exponent); -static void MulPow5(mp_int *, unsigned, mp_int *); +static mp_err MulPow5(mp_int *, unsigned, mp_int *) MP_WUR; static int NormalizeRightward(Tcl_WideUInt *); static int RequiredPrecision(Tcl_WideUInt); static void DoubleToExpAndSig(double, Tcl_WideUInt *, int *, int *); static void TakeAbsoluteValue(Double *, int *); @@ -321,11 +326,11 @@ int *, char **); static void CastOutPowersOf2(int *, int *, int *); static char * ShorteningInt64Conversion(Double *, Tcl_WideUInt, int, int, int, int, int, int, int, int, int, int, int, int *, char **); -static char * StrictInt64Conversion(Double *, Tcl_WideUInt, +static char * StrictInt64Conversion(Tcl_WideUInt, int, int, int, int, int, int, int, int, int *, char **); static int ShouldBankerRoundUpPowD(mp_int *, int, int); static int ShouldBankerRoundUpToNextPowD(mp_int *, mp_int *, int, int, mp_int *); @@ -333,11 +338,11 @@ Tcl_WideUInt bw, int b2, int b5, int m2plus, int m2minus, int m5, int sd, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); -static char * StrictBignumConversionPowD(Double *dPtr, +static char * StrictBignumConversionPowD( Tcl_WideUInt bw, int b2, int b5, int sd, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static int ShouldBankerRoundUp(mp_int *, mp_int *, int); @@ -347,11 +352,11 @@ Tcl_WideUInt bw, int b2, int m2plus, int m2minus, int s2, int s5, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); -static char * StrictBignumConversion(Double *dPtr, +static char * StrictBignumConversion( Tcl_WideUInt bw, int b2, int s2, int s5, int k, int len, int ilim, int ilim1, int *decpt, char **endPtr); static double BignumToBiasedFrExp(const mp_int *big, int *machexp); @@ -472,20 +477,20 @@ const char *expected, /* Description of the type of number the * caller expects to be able to parse * ("integer", "boolean value", etc.). */ const char *bytes, /* Pointer to the start of the string to * scan. */ - size_t numBytes, /* Maximum number of bytes to scan, see + int numBytes, /* Maximum number of bytes to scan, see * above. */ const char **endPtrPtr, /* Place to store pointer to the character * that terminated the scan. */ int flags) /* Flags governing the parse. */ { enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, ZERO_D, BINARY, - HEXADECIMAL, OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY #ifdef IEEE_FLOATING_POINT , sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH @@ -526,10 +531,14 @@ * point. */ int status = TCL_OK; /* Status to return to caller. */ char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ + int explicitOctal = 0; + mp_err err = MP_OKAY; + int under = 0; /* Flag trailing '_' as error if true once + * number is accepted. */ #define ALL_BITS ((Tcl_WideUInt)-1) #define MOST_BITS (ALL_BITS >> 1) /* @@ -567,11 +576,11 @@ /* * Initial state. Acceptable characters are +, -, digits, period, * I, N, and whitespace. */ - if (TclIsSpaceProc(c)) { + if (TclIsSpaceProcM(c)) { if (flags & TCL_PARSE_NO_WHITESPACE) { goto endgame; } break; } else if (c == '+') { @@ -634,11 +643,11 @@ acceptState = state; acceptPoint = p; acceptLen = len; if (c == 'x' || c == 'X') { - if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) { + if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY) || under) { goto endgame; } state = ZERO_X; break; } @@ -647,28 +656,38 @@ } if (flags & TCL_PARSE_SCAN_PREFIXES) { goto zeroo; } if (c == 'b' || c == 'B') { - if (flags & TCL_PARSE_OCTAL_ONLY) { + if ((flags & TCL_PARSE_OCTAL_ONLY) || under) { goto endgame; } state = ZERO_B; break; } if (flags & TCL_PARSE_BINARY_ONLY) { goto zerob; } if (c == 'o' || c == 'O') { + if (under) { + goto endgame; + } + explicitOctal = 1; state = ZERO_O; break; } if (c == 'd' || c == 'D') { + if (under) { + goto endgame; + } state = ZERO_D; break; } +#ifdef TCL_NO_DEPRECATED goto decimal; +#endif + /* FALLTHROUGH */ case OCTAL: /* * Scanned an optional + or -, followed by a string of octal * digits. Acceptable inputs are more digits, period, or E. If 8 @@ -681,13 +700,15 @@ /* FALLTHROUGH */ case ZERO_O: zeroo: if (c == '0') { numTrailZeros++; + under = 0; state = OCTAL; break; } else if (c >= '1' && c <= '7') { + under = 0; if (objPtr != NULL) { shift = 3 * (numTrailZeros + 1); significandOverflow = AccumulateDecimalDigit( (unsigned)(c-'0'), numTrailZeros, &significandWide, &significandBig, @@ -704,22 +725,29 @@ && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > ((Tcl_WideUInt)-1 >> shift)))) { octalSignificandOverflow = 1; - TclInitBignumFromWideUInt(&octalSignificandBig, + err = mp_init_u64(&octalSignificandBig, octalSignificandWide); } } if (!octalSignificandOverflow) { octalSignificandWide = (octalSignificandWide << shift) + (c - '0'); } else { - mp_mul_2d(&octalSignificandBig, shift, - &octalSignificandBig); - mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'), - &octalSignificandBig); + if (err == MP_OKAY) { + err = mp_mul_2d(&octalSignificandBig, shift, + &octalSignificandBig); + } + if (err == MP_OKAY) { + err = mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'), + &octalSignificandBig); + } + } + if (err != MP_OKAY) { + return TCL_ERROR; } } if (numSigDigs != 0) { numSigDigs += numTrailZeros+1; } else { @@ -726,11 +754,71 @@ numSigDigs = 1; } numTrailZeros = 0; state = OCTAL; break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } + /* FALLTHROUGH */ + + case BAD_OCTAL: + if (explicitOctal) { + /* + * No forgiveness for bad digits in explicitly octal numbers. + */ + + goto endgame; + } + if (flags & TCL_PARSE_INTEGER_ONLY) { + /* + * No seeking floating point when parsing only integer. + */ + + goto endgame; + } +#ifndef TCL_NO_DEPRECATED + + /* + * Scanned a number with a leading zero that contains an 8, 9, + * radix point or E. This is an invalid octal number, but might + * still be floating point. + */ + + if (c == '0') { + numTrailZeros++; + under = 0; + state = BAD_OCTAL; + break; + } else if (isdigit(UCHAR(c))) { + if (objPtr != NULL) { + significandOverflow = AccumulateDecimalDigit( + (unsigned)(c-'0'), numTrailZeros, + &significandWide, &significandBig, + significandOverflow); + } + if (numSigDigs != 0) { + numSigDigs += (numTrailZeros + 1); + } else { + numSigDigs = 1; + } + numTrailZeros = 0; + under = 0; + state = BAD_OCTAL; + break; + } else if (c == '.') { + under = 0; + state = FRACTION; + break; + } else if (c == 'E' || c == 'e') { + under = 0; + state = EXPONENT_START; + break; + } +#endif goto endgame; /* * Scanned 0x. If state is HEXADECIMAL, scanned at least one * character following the 0x. The only acceptable inputs are @@ -745,18 +833,26 @@ case ZERO_X: zerox: if (c == '0') { numTrailZeros++; + under = 0; state = HEXADECIMAL; break; } else if (isdigit(UCHAR(c))) { + under = 0; d = (c-'0'); } else if (c >= 'A' && c <= 'F') { + under = 0; d = (c-'A'+10); } else if (c >= 'a' && c <= 'f') { + under = 0; d = (c-'a'+10); + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } else { goto endgame; } if (objPtr != NULL) { shift = 4 * (numTrailZeros + 1); @@ -769,35 +865,46 @@ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > ((Tcl_WideUInt)-1 >> shift))) { significandOverflow = 1; - TclInitBignumFromWideUInt(&significandBig, + err = mp_init_u64(&significandBig, significandWide); } } if (!significandOverflow) { significandWide = (significandWide << shift) + d; - } else { - mp_mul_2d(&significandBig, shift, &significandBig); - mp_add_d(&significandBig, (mp_digit) d, &significandBig); + } else if (err == MP_OKAY) { + err = mp_mul_2d(&significandBig, shift, &significandBig); + if (err == MP_OKAY) { + err = mp_add_d(&significandBig, (mp_digit) d, &significandBig); + } } + } + if (err != MP_OKAY) { + return TCL_ERROR; } numTrailZeros = 0; state = HEXADECIMAL; break; case BINARY: acceptState = state; acceptPoint = p; acceptLen = len; + /* FALLTHRU */ case ZERO_B: zerob: if (c == '0') { numTrailZeros++; + under = 0; state = BINARY; break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } else if (c != '1') { goto endgame; } if (objPtr != NULL) { shift = numTrailZeros + 1; @@ -810,31 +917,43 @@ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > ((Tcl_WideUInt)-1 >> shift))) { significandOverflow = 1; - TclInitBignumFromWideUInt(&significandBig, + err = mp_init_u64(&significandBig, significandWide); } } if (!significandOverflow) { significandWide = (significandWide << shift) + 1; - } else { - mp_mul_2d(&significandBig, shift, &significandBig); - mp_add_d(&significandBig, (mp_digit) 1, &significandBig); + } else if (err == MP_OKAY) { + err = mp_mul_2d(&significandBig, shift, &significandBig); + if (err == MP_OKAY) { + err = mp_add_d(&significandBig, (mp_digit) 1, &significandBig); + } } + } + if (err != MP_OKAY) { + return TCL_ERROR; } numTrailZeros = 0; state = BINARY; break; case ZERO_D: if (c == '0') { + under = 0; numTrailZeros++; } else if ( ! isdigit(UCHAR(c))) { + if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; + } goto endgame; } + under = 0; state = DECIMAL; flags |= TCL_PARSE_INTEGER_ONLY; /* FALLTHROUGH */ case DECIMAL: @@ -841,16 +960,19 @@ /* * Scanned an optional + or - followed by a string of decimal * digits. */ +#ifdef TCL_NO_DEPRECATED decimal: +#endif acceptState = state; acceptPoint = p; acceptLen = len; if (c == '0') { numTrailZeros++; + under = 0; state = DECIMAL; break; } else if (isdigit(UCHAR(c))) { if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( @@ -858,18 +980,25 @@ &significandWide, &significandBig, significandOverflow); } numSigDigs += numTrailZeros+1; numTrailZeros = 0; + under = 0; state = DECIMAL; break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } else if (flags & TCL_PARSE_INTEGER_ONLY) { goto endgame; } else if (c == '.') { + under = 0; state = FRACTION; break; } else if (c == 'E' || c == 'e') { + under = 0; state = EXPONENT_START; break; } goto endgame; @@ -891,10 +1020,11 @@ case LEADING_RADIX_POINT: if (c == '0') { numDigitsAfterDp++; numTrailZeros++; + under = 0; state = FRACTION; break; } else if (isdigit(UCHAR(c))) { numDigitsAfterDp++; if (objPtr != NULL) { @@ -907,12 +1037,17 @@ numSigDigs += numTrailZeros+1; } else { numSigDigs = 1; } numTrailZeros = 0; + under = 0; state = FRACTION; break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } goto endgame; case EXPONENT_START: /* @@ -920,14 +1055,16 @@ * character follows before using the C library strtol routine, * which allows whitespace. */ if (c == '+') { + under = 0; state = EXPONENT_SIGNUM; break; } else if (c == '-') { exponentSignum = 1; + under = 0; state = EXPONENT_SIGNUM; break; } /* FALLTHROUGH */ @@ -937,12 +1074,17 @@ * character. */ if (isdigit(UCHAR(c))) { exponent = c - '0'; + under = 0; state = EXPONENT; break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } goto endgame; case EXPONENT: /* @@ -957,12 +1099,17 @@ if (exponent < (LONG_MAX - 9) / 10) { exponent = 10 * exponent + (c - '0'); } else { exponent = LONG_MAX; } + under = 0; state = EXPONENT; break; + } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) { + /* Ignore numeric "white space" */ + under = 1; + break; } goto endgame; /* * Parse out INFINITY by simply spelling it out. INF is accepted @@ -969,49 +1116,56 @@ * as an abbreviation; other prefices are not. */ case sI: if (c == 'n' || c == 'N') { + under = 0; state = sIN; break; } goto endgame; case sIN: if (c == 'f' || c == 'F') { + under = 0; state = sINF; break; } goto endgame; case sINF: acceptState = state; acceptPoint = p; acceptLen = len; + under = 0; if (c == 'i' || c == 'I') { state = sINFI; break; } goto endgame; case sINFI: if (c == 'n' || c == 'N') { + under = 0; state = sINFIN; break; } goto endgame; case sINFIN: if (c == 'i' || c == 'I') { + under = 0; state = sINFINI; break; } goto endgame; case sINFINI: if (c == 't' || c == 'T') { + under = 0; state = sINFINIT; break; } goto endgame; case sINFINIT: if (c == 'y' || c == 'Y') { + under = 0; state = sINFINITY; break; } goto endgame; @@ -1019,25 +1173,28 @@ * Parse NaN's. */ #ifdef IEEE_FLOATING_POINT case sN: if (c == 'a' || c == 'A') { + under = 0; state = sNA; break; } goto endgame; case sNA: if (c == 'n' || c == 'N') { + under = 0; state = sNAN; break; } goto endgame; case sNAN: acceptState = state; acceptPoint = p; acceptLen = len; if (c == '(') { + under = 0; state = sNANPAREN; break; } goto endgame; @@ -1044,16 +1201,18 @@ /* * Parse NaN(hexdigits) */ case sNANHEX: if (c == ')') { + under = 0; state = sNANFINISH; break; } /* FALLTHROUGH */ case sNANPAREN: - if (TclIsSpaceProc(c)) { + if (TclIsSpaceProcM(c)) { + under = 0; break; } if (numSigDigs < 13) { if (c >= '0' && c <= '9') { d = c - '0'; @@ -1064,10 +1223,11 @@ } else { goto endgame; } numSigDigs++; significandWide = (significandWide << 4) + d; + under = 0; state = sNANHEX; break; } goto endgame; case sNANFINISH: @@ -1076,10 +1236,11 @@ case sINFINITY: acceptState = state; acceptPoint = p; acceptLen = len; goto endgame; + } p++; len--; } @@ -1094,26 +1255,29 @@ *endPtrPtr = p; } } else { /* * Back up to the last accepting state in the lexer. + * If the last char seen is the numeric whitespace character '_', + * backup to that. */ - p = acceptPoint; - len = acceptLen; + p = under ? acceptPoint-1 : acceptPoint; + len = under ? acceptLen-1 : acceptLen; + if (!(flags & TCL_PARSE_NO_WHITESPACE)) { /* * Accept trailing whitespace. */ - while (len != 0 && TclIsSpaceProc(*p)) { + while (len != 0 && TclIsSpaceProcM(*p)) { p++; len--; } } if (endPtrPtr == NULL) { - if ((len != 0) && ((numBytes + 1 > 1) || (*p != '\0'))) { + if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) { status = TCL_ERROR; } } else { *endPtrPtr = p; } @@ -1125,10 +1289,11 @@ if (status == TCL_OK && objPtr != NULL) { TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: + case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: case ZERO_D: case LEADING_RADIX_POINT: @@ -1152,18 +1317,21 @@ shift = numTrailZeros; if (!significandOverflow && significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; - TclInitBignumFromWideUInt(&significandBig, significandWide); + err = mp_init_u64(&significandBig, significandWide); } if (shift) { if (!significandOverflow) { significandWide <<= shift; - } else { - mp_mul_2d(&significandBig, shift, &significandBig); + } else if (err == MP_OKAY) { + err = mp_mul_2d(&significandBig, shift, &significandBig); } + } + if (err != MP_OKAY) { + return TCL_ERROR; } goto returnInteger; case HEXADECIMAL: /* @@ -1173,18 +1341,21 @@ shift = 4 * numTrailZeros; if (!significandOverflow && significandWide !=0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || significandWide > (MOST_BITS + signum) >> shift)) { significandOverflow = 1; - TclInitBignumFromWideUInt(&significandBig, significandWide); + err = mp_init_u64(&significandBig, significandWide); } if (shift) { if (!significandOverflow) { significandWide <<= shift; - } else { - mp_mul_2d(&significandBig, shift, &significandBig); + } else if (err == MP_OKAY) { + err = mp_mul_2d(&significandBig, shift, &significandBig); } + } + if (err != MP_OKAY) { + return TCL_ERROR; } goto returnInteger; case OCTAL: /* @@ -1194,24 +1365,24 @@ shift = 3 * numTrailZeros; if (!octalSignificandOverflow && octalSignificandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || octalSignificandWide > (MOST_BITS + signum) >> shift)) { octalSignificandOverflow = 1; - TclInitBignumFromWideUInt(&octalSignificandBig, + err = mp_init_u64(&octalSignificandBig, octalSignificandWide); } if (shift) { if (!octalSignificandOverflow) { octalSignificandWide <<= shift; - } else { - mp_mul_2d(&octalSignificandBig, shift, + } else if (err == MP_OKAY) { + err = mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); } } if (!octalSignificandOverflow) { - if (octalSignificandWide > (MOST_BITS + signum)) { - TclInitBignumFromWideUInt(&octalSignificandBig, + if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) { + err = mp_init_u64(&octalSignificandBig, octalSignificandWide); octalSignificandOverflow = 1; } else { objPtr->typePtr = &tclIntType; if (signum) { @@ -1221,30 +1392,33 @@ objPtr->internalRep.wideValue = (Tcl_WideInt) octalSignificandWide; } } } - if (octalSignificandOverflow) { + if ((err == MP_OKAY) && octalSignificandOverflow) { if (signum) { - mp_neg(&octalSignificandBig, &octalSignificandBig); + err = mp_neg(&octalSignificandBig, &octalSignificandBig); } TclSetBignumIntRep(objPtr, &octalSignificandBig); + } + if (err != MP_OKAY) { + return TCL_ERROR; } break; case ZERO: case DECIMAL: significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1, &significandWide, &significandBig, significandOverflow); - if (!significandOverflow && (significandWide > MOST_BITS+signum)){ + if ((err == MP_OKAY) && !significandOverflow && (significandWide > MOST_BITS+signum)) { significandOverflow = 1; - TclInitBignumFromWideUInt(&significandBig, significandWide); + err = mp_init_u64(&significandBig, significandWide); } returnInteger: if (!significandOverflow) { - if (significandWide > MOST_BITS+signum) { - TclInitBignumFromWideUInt(&significandBig, + if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) { + err = mp_init_u64(&significandBig, significandWide); significandOverflow = 1; } else { objPtr->typePtr = &tclIntType; if (signum) { @@ -1254,15 +1428,18 @@ objPtr->internalRep.wideValue = (Tcl_WideInt) significandWide; } } } - if (significandOverflow) { + if ((err == MP_OKAY) && significandOverflow) { if (signum) { - mp_neg(&significandBig, &significandBig); + err = mp_neg(&significandBig, &significandBig); } TclSetBignumIntRep(objPtr, &significandBig); + } + if (err != MP_OKAY) { + return TCL_ERROR; } break; case FRACTION: case EXPONENT: @@ -1275,20 +1452,49 @@ * k = numTrailZeros+exponent-numDigitsAfterDp. */ objPtr->typePtr = &tclDoubleType; if (exponentSignum) { + /* + * At this point exponent>=0, so the following calculation + * cannot underflow. + */ exponent = -exponent; } + + /* + * Adjust the exponent for the number of trailing zeros that + * have not been accumulated, and the number of digits after + * the decimal point. Pin any overflow to LONG_MAX/LONG_MIN + * respectively. + */ + + if (exponent >= 0) { + if (exponent - numDigitsAfterDp > LONG_MAX - numTrailZeros) { + exponent = LONG_MAX; + } else { + exponent = exponent - numDigitsAfterDp + numTrailZeros; + } + } else { + if (exponent + numTrailZeros < LONG_MIN + numDigitsAfterDp) { + exponent = LONG_MIN; + } else { + exponent = exponent + numTrailZeros - numDigitsAfterDp; + } + } + + /* + * The desired number is now significandWide * 10**exponent + * or significandBig * 10**exponent, depending on whether + * the significand has overflowed a wide int. + */ if (!significandOverflow) { objPtr->internalRep.doubleValue = MakeLowPrecisionDouble( - signum, significandWide, numSigDigs, - numTrailZeros + exponent - numDigitsAfterDp); + signum, significandWide, numSigDigs, exponent); } else { objPtr->internalRep.doubleValue = MakeHighPrecisionDouble( - signum, &significandBig, numSigDigs, - numTrailZeros + exponent - numDigitsAfterDp); + signum, &significandBig, numSigDigs, exponent); } break; case sINF: case sINFINITY: @@ -1301,11 +1507,11 @@ break; #ifdef IEEE_FLOATING_POINT case sNAN: case sNANFINISH: - objPtr->internalRep.doubleValue = MakeNaN(signum,significandWide); + objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide); objPtr->typePtr = &tclDoubleType; break; #endif case INITIAL: /* This case only to silence compiler warning. */ @@ -1322,10 +1528,13 @@ Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"", expected); Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); + if (state == BAD_OCTAL) { + Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); + } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } } @@ -1392,11 +1601,13 @@ /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. */ - TclInitBignumFromWideUInt(bignumRepPtr, w); + if (mp_init_u64(bignumRepPtr, w) != MP_OKAY) { + return 0; + } } else { /* * Wide multiplication. */ @@ -1412,36 +1623,41 @@ if (numZeros < log10_DIGIT_MAX) { /* * Up to about 8 zeros - single digit multiplication. */ - mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1], - bignumRepPtr); - mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr); + if ((mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1], + bignumRepPtr) != MP_OKAY) + || (mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr) != MP_OKAY)) + return 0; } else { + mp_err err; /* * More than single digit multiplication. Multiply by the appropriate * small powers of 5, and then shift. Large strings of zeroes are * eaten 256 at a time; this is less efficient than it could be, but - * seems implausible. We presume that DIGIT_BIT is at least 27. The + * seems implausible. We presume that MP_DIGIT_BIT is at least 27. The * first multiplication, by up to 10**7, is done with a one-DIGIT - * multiply (this presumes that DIGIT_BIT >= 24). + * multiply (this presumes that MP_DIGIT_BIT >= 24). */ n = numZeros + 1; - mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr); - for (i=3; i<=7; ++i) { + err = mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr); + for (i = 3; (err == MP_OKAY) && (i <= 7); ++i) { if (n & (1 << i)) { - mp_mul(bignumRepPtr, pow5+i, bignumRepPtr); + err = mp_mul(bignumRepPtr, pow5+i, bignumRepPtr); } } - while (n >= 256) { - mp_mul(bignumRepPtr, pow5+8, bignumRepPtr); + while ((err == MP_OKAY) && (n >= 256)) { + err = mp_mul(bignumRepPtr, pow5+8, bignumRepPtr); n -= 256; } - mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr); - mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr); + if ((err != MP_OKAY) + || (mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr) != MP_OKAY) + || (mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr) != MP_OKAY)) { + return 0; + } } return 1; } @@ -1465,13 +1681,13 @@ */ static double MakeLowPrecisionDouble( int signum, /* 1 if the number is negative, 0 otherwise */ - Tcl_WideUInt significand, /* Significand of the number. */ - int numSigDigs, /* Number of digits in the significand. */ - int exponent) /* Power of ten. */ + Tcl_WideUInt significand, /* Significand of the number */ + int numSigDigs, /* Number of digits in the significand */ + long exponent) /* Power of ten */ { double retval; /* Value of the number. */ mp_int significandBig; /* Significand expressed as a bignum. */ /* @@ -1486,10 +1702,13 @@ /* * Test for the easy cases. */ + if (significand == 0) { + return copysign(0.0, -signum); + } if (numSigDigs <= QUICK_MAX) { if (exponent >= 0) { if (exponent <= mmaxpow) { /* * The significand is an exact integer, and so is @@ -1535,11 +1754,13 @@ /* * All the easy cases have failed. Promote ths significand to bignum and * call MakeHighPrecisionDouble to do it the hard way. */ - TclInitBignumFromWideUInt(&significandBig, significand); + if (mp_init_u64(&significandBig, significand) != MP_OKAY) { + return 0.0; + } retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs, exponent); mp_clear(&significandBig); /* @@ -1578,17 +1799,17 @@ *---------------------------------------------------------------------- */ static double MakeHighPrecisionDouble( - int signum, /* 1=negative, 0=nonnegative. */ - mp_int *significand, /* Exact significand of the number. */ - int numSigDigs, /* Number of significant digits. */ - int exponent) /* Power of 10 by which to multiply. */ + int signum, /* 1=negative, 0=nonnegative */ + mp_int *significand, /* Exact significand of the number */ + int numSigDigs, /* Number of significant digits */ + long exponent) /* Power of 10 by which to multiply */ { double retval; - int machexp; /* Machine exponent of a power of 10. */ + int machexp = 0; /* Machine exponent of a power of 10. */ /* * With gcc on x86, the floating point rounding mode is double-extended. * This causes the result of double-precision calculations to be rounded * twice: once to the precision of double-extended and then again to the @@ -1597,19 +1818,22 @@ */ TCL_IEEE_DOUBLE_ROUNDING; /* - * Quick checks for over/underflow. + * Quick checks for zero, and over/underflow. Be careful to avoid + * integer overflow when calculating with 'exponent'. */ - if (numSigDigs+exponent-1 > maxDigits) { + if (mp_iszero(significand)) { + return copysign(0.0, -signum); + } + if (exponent >= 0 && exponent-1 > maxDigits-numSigDigs) { retval = HUGE_VAL; goto returnValue; - } - if (numSigDigs+exponent-1 < minDigits) { - retval = 0; + } else if (exponent < 0 && numSigDigs+exponent < minDigits+1) { + retval = 0.0; goto returnValue; } /* * Develop a first approximation to the significand. It is tempting simply @@ -1740,29 +1964,42 @@ * correction term. */ int roundToEven = 0; /* Flag == TRUE if we need to invoke * "round to even" functionality */ double rteSignificand; /* Significand of the round-to-even result */ int rteExponent; /* Exponent of the round-to-even result */ + int shift; /* Shift count for converting numerator + * and denominator of corrector to floating + * point */ Tcl_WideInt rteSigWide; /* Wide integer version of the significand * for testing evenness */ int i; + mp_err err = MP_OKAY; /* * The first approximation is always low. If we find that it's HUGE_VAL, * we're done. */ if (approxResult == HUGE_VAL) { return approxResult; } - - /* - * Find a common denominator for the decimal and binary fractions. The - * common denominator will be 2**M2 + 5**M5. - */ - significand = frexp(approxResult, &binExponent); + + /* + * We are trying to compute a corrector term that, when added to the + * approximate result, will yield close to the exact result. + * The exact result is exactSignificand * 10**exponent. + * The approximate result is significand * 2**binExponent + * If exponent<0, we need to multiply the exact value by 10**-exponent + * to make it an integer, plus another factor of 2 to decide on rounding. + * Similarly if binExponent= 0) { twoMv.dp[nDigits] = (mp_digit) significand; significand -= (mp_digit) significand; significand = SafeLdExp(significand, MP_DIGIT_BIT); } for (i = 0; i <= 8; ++i) { - if (M5 & (1 << i)) { - mp_mul(&twoMv, pow5+i, &twoMv); + if (M5 & (1 << i) && (mp_mul(&twoMv, pow5+i, &twoMv) != MP_OKAY)) { + mp_clear(&twoMv); + return approxResult; } } /* - * Collect the decimal significand as a high precision integer. The least - * significant bit corresponds to bit M2+exponent+1 so it will need to be - * shifted left by that many bits after being multiplied by - * 5**(M5+exponent). + * Compute twoMd as 2*M*d, where d is the exact value. + * This is done by multiplying by 5**(M5+exponent) and then multiplying + * by 2**(M5+exponent+1), which is, of couse, a left shift. */ - mp_init_copy(&twoMd, exactSignificand); - for (i=0; i<=8; ++i) { + if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) { + mp_clear(&twoMv); + return approxResult; + } + for (i = 0; (i <= 8); ++i) { if ((M5 + exponent) & (1 << i)) { - mp_mul(&twoMd, pow5+i, &twoMd); + err = mp_mul(&twoMd, pow5+i, &twoMd); } } - mp_mul_2d(&twoMd, M2+exponent+1, &twoMd); - mp_sub(&twoMd, &twoMv, &twoMd); + if (err == MP_OKAY) { + err = mp_mul_2d(&twoMd, M2+exponent+1, &twoMd); + } + + /* + * Now let twoMd = twoMd - twoMv, the difference between the exact and + * approximate values. + */ + + if (err == MP_OKAY) { + err = mp_sub(&twoMd, &twoMv, &twoMd); + } /* * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction * term. Because 2M may well overflow a double, we need to scale the - * denominator by a factor of 2**binExponent-mantBits. + * denominator by a factor of 2**binExponent-mantBits. Place that factor + * times 1/2 ULP into twoMd. */ scale = binExponent - mantBits - 1; - - mp_set(&twoMv, 1); - for (i=0; i<=8; ++i) { + mp_set_u64(&twoMv, 1); + for (i = 0; (i <= 8) && (err == MP_OKAY); ++i) { if (M5 & (1 << i)) { - mp_mul(&twoMv, pow5+i, &twoMv); + err = mp_mul(&twoMv, pow5+i, &twoMv); } } multiplier = M2 + scale + 1; - if (multiplier > 0) { - mp_mul_2d(&twoMv, multiplier, &twoMv); + if (err != MP_OKAY) { + mp_clear(&twoMd); + mp_clear(&twoMv); + return approxResult; + } else if (multiplier > 0) { + err = mp_mul_2d(&twoMv, multiplier, &twoMv); } else if (multiplier < 0) { - mp_div_2d(&twoMv, -multiplier, &twoMv, NULL); + err = mp_div_2d(&twoMv, -multiplier, &twoMv, NULL); } + if (err != MP_OKAY) { + mp_clear(&twoMd); + mp_clear(&twoMv); + return approxResult; + } + + /* + * Will the eventual correction term be less than, equal to, or + * greater than 1/2 ULP? + */ switch (mp_cmp_mag(&twoMd, &twoMv)) { case MP_LT: /* - * If the result is less than unity, the error is less than 1/2 unit in - * the last place, so there's no correction to make. + * If the error is less than 1/2 ULP, there's no correction to make. */ mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; case MP_EQ: /* - * If the result is exactly unity, we need to round to even. + * If the error is exactly 1/2 ULP, we need to round to even. */ roundToEven = 1; break; case MP_GT: + /* + * We need to correct the result if the error exceeds 1/2 ULP. + */ break; } + /* + * If we're in the 'round to even' case, and the significand is already + * even, we're done. Return the approximate result. + */ if (roundToEven) { rteSignificand = frexp(approxResult, &rteExponent); rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION); if ((rteSigWide & 1) == 0) { mp_clear(&twoMd); mp_clear(&twoMv); return approxResult; } } + + /* + * Reduce the numerator and denominator of the corrector term so that + * they will fit in the floating point precision. + */ + shift = mp_count_bits(&twoMv) - FP_PRECISION - 1; + if (shift > 0) { + err = mp_div_2d(&twoMv, shift, &twoMv, NULL); + if (err == MP_OKAY) { + err = mp_div_2d(&twoMd, shift, &twoMd, NULL); + } + } + if (err != MP_OKAY) { + mp_clear(&twoMd); + mp_clear(&twoMv); + return approxResult; + } /* * Convert the numerator and denominator of the corrector term accurately * to floating point numbers. */ @@ -1902,36 +2188,38 @@ * Stores base*5**n in result. * *---------------------------------------------------------------------- */ -static inline void +static inline mp_err MulPow5( mp_int *base, /* Number to multiply. */ unsigned n, /* Power of 5 to multiply by. */ mp_int *result) /* Place to store the result. */ { mp_int *p = base; int n13 = n / 13; int r = n % 13; + mp_err err = MP_OKAY; if (r != 0) { - mp_mul_d(p, dpow5[r], result); + err = mp_mul_d(p, dpow5[r], result); p = result; } r = 0; - while (n13 != 0) { + while ((err == MP_OKAY) && (n13 != 0)) { if (n13 & 1) { - mp_mul(p, pow5_13+r, result); + err = mp_mul(p, pow5_13+r, result); p = result; } n13 >>= 1; ++r; } - if (p != result) { - mp_copy(p, result); + if ((err == MP_OKAY) && (p != result)) { + err = mp_copy(p, result); } + return err; } /* *---------------------------------------------------------------------- * @@ -1954,20 +2242,20 @@ Tcl_WideUInt *wPtr) /* INOUT: Number to shift. */ { int rv = 0; Tcl_WideUInt w = *wPtr; - if (!(w & (Tcl_WideUInt) 0xffffffff)) { + if (!(w & (Tcl_WideUInt) 0xFFFFFFFF)) { w >>= 32; rv += 32; } - if (!(w & (Tcl_WideUInt) 0xffff)) { + if (!(w & (Tcl_WideUInt) 0xFFFF)) { w >>= 16; rv += 16; } - if (!(w & (Tcl_WideUInt) 0xff)) { + if (!(w & (Tcl_WideUInt) 0xFF)) { w >>= 8; rv += 8; } - if (!(w & (Tcl_WideUInt) 0xf)) { + if (!(w & (Tcl_WideUInt) 0xF)) { w >>= 4; rv += 4; } if (!(w & 0x3)) { w >>= 2; rv += 2; } @@ -1997,25 +2285,25 @@ Tcl_WideUInt w) /* Number to interrogate. */ { int rv; unsigned long wi; - if (w & ((Tcl_WideUInt) 0xffffffff << 32)) { + if (w & ((Tcl_WideUInt) 0xFFFFFFFF << 32)) { wi = (unsigned long) (w >> 32); rv = 32; } else { wi = (unsigned long) w; rv = 0; } - if (wi & 0xffff0000) { + if (wi & 0xFFFF0000) { wi >>= 16; rv += 16; } - if (wi & 0xff00) { + if (wi & 0xFF00) { wi >>= 8; rv += 8; } - if (wi & 0xf0) { + if (wi & 0xF0) { wi >>= 4; rv += 4; } - if (wi & 0xc) { + if (wi & 0xC) { wi >>= 2; rv += 2; } if (wi & 0x2) { wi >>= 1; ++rv; } @@ -2108,11 +2396,11 @@ * * Bailout for formatting infinities and Not-A-Number. * * Results: * Returns one of the strings 'Infinity' and 'NaN'. The string returned - * must be freed by the caller using 'Tcl_Free'. + * must be freed by the caller using 'ckfree'. * * Side effects: * Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating * NUL byte of the string if 'endPtr' is not NULL. * @@ -2127,17 +2415,17 @@ { char *retval; *decpt = 9999; if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) { - retval = Tcl_Alloc(9); + retval = (char *)ckalloc(9); strcpy(retval, "Infinity"); if (endPtr) { *endPtr = retval + 8; } } else { - retval = Tcl_Alloc(4); + retval = (char *)ckalloc(4); strcpy(retval, "NaN"); if (endPtr) { *endPtr = retval + 3; } } @@ -2164,11 +2452,11 @@ static inline char * FormatZero( int *decpt, /* Location of the decimal point. */ char **endPtr) /* Pointer to the end of the formatted data */ { - char *retval = Tcl_Alloc(2); + char *retval = (char *)ckalloc(2); strcpy(retval, "0"); if (endPtr) { *endPtr = retval+1; } @@ -2449,11 +2737,11 @@ if (k > 0) { /* * The number must be reduced to bring it into range. */ - ds = tens[k & 0xf]; + ds = tens[k & 0xF]; j = k >> 4; if (j & BLETCH) { j &= (BLETCH-1); d /= bigtens[N_BIGTENS - 1]; ieps++; @@ -2470,11 +2758,11 @@ } else if ((j1 = -k) != 0) { /* * The number must be increased to bring it into range. */ - d *= tens[j1 & 0xf]; + d *= tens[j1 & 0xF]; i = 0; for (j = j1>>4; j; j>>=1) { if (j & 1) { ieps++; d *= bigtens[i]; @@ -2659,11 +2947,11 @@ QuickConversion( double e, /* Number to format. */ int k, /* floor(log10(d)), approximately. */ int k_check, /* 0 if k is exact, 1 if it may be too high */ int flags, /* Flags passed to dtoa: - * TCL_DD_SHORTEN_FLAG */ + * TCL_DD_SHORTEST */ int len, /* Length of the return value. */ int ilim, /* Number of digits to store. */ int ilim1, /* Number of digits to store if we misguessed * k. */ int *decpt, /* OUTPUT: Location of the decimal point. */ @@ -2710,11 +2998,11 @@ /* * Handle the peculiar case where the result has no significant digits. */ - retval = Tcl_Alloc(len + 1); + retval = (char *)ckalloc(len + 1); if (ilim == 0) { d -= 5.; if (d > eps.d) { *retval = '1'; *decpt = k; @@ -2721,26 +3009,26 @@ return retval; } else if (d < -eps.d) { *decpt = k; return retval; } else { - Tcl_Free(retval); + ckfree(retval); return NULL; } } /* * Format the digit string. */ - if (flags & TCL_DD_SHORTEN_FLAG) { + if (flags & TCL_DD_SHORTEST) { end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt); } else { end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt); } if (end == NULL) { - Tcl_Free(retval); + ckfree(retval); return NULL; } *end = '\0'; if (endPtr != NULL) { *endPtr = end; @@ -2821,11 +3109,11 @@ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = Tcl_Alloc(len + 1); + char *retval = (char *)ckalloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being * converted. */ Tcl_WideUInt S = wuipow5[s5] << s2; @@ -2971,11 +3259,10 @@ *---------------------------------------------------------------------- */ static inline char * StrictInt64Conversion( - Double *dPtr, /* Original number to convert. */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int s2, int s5, /* Scale factors for the denominator. */ int k, /* Number of output digits before the decimal @@ -2985,11 +3272,11 @@ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = Tcl_Alloc(len + 1); + char *retval = (char *)ckalloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being * converted. */ Tcl_WideUInt S = wuipow5[s5] << s2; @@ -3064,11 +3351,11 @@ * * ShouldBankerRoundUpPowD -- * * Test whether bankers' rounding should round a digit up. Assumption is * made that the denominator of the fraction being tested is a power of - * 2**DIGIT_BIT. + * 2**MP_DIGIT_BIT. * * Results: * Returns 1 iff the fraction is more than 1/2, or if the fraction is * exactly 1/2 and the digit is odd. * @@ -3076,11 +3363,11 @@ */ static inline int ShouldBankerRoundUpPowD( mp_int *b, /* Numerator of the fraction. */ - int sd, /* Denominator is 2**(sd*DIGIT_BIT). */ + int sd, /* Denominator is 2**(sd*MP_DIGIT_BIT). */ int isodd) /* 1 if the digit is odd, 0 if even. */ { int i; static const mp_digit topbit = ((mp_digit)1) << (MP_DIGIT_BIT - 1); @@ -3115,24 +3402,23 @@ static inline int ShouldBankerRoundUpToNextPowD( mp_int *b, /* Numerator of the fraction. */ mp_int *m, /* Numerator of the rounding tolerance. */ - int sd, /* Common denominator is 2**(sd*DIGIT_BIT). */ + int sd, /* Common denominator is 2**(sd*MP_DIGIT_BIT). */ int isodd, /* 1 if the integer significand is odd. */ mp_int *temp) /* Work area for the calculation. */ { int i; /* * Compare B and S-m - which is the same as comparing B+m and S - which we * do by computing b+m and doing a bitwhack compare against - * 2**(DIGIT_BIT*sd) + * 2**(MP_DIGIT_BIT*sd) */ - mp_add(b, m, temp); - if (temp->used <= sd) { /* Too few digits to be > s */ + if ((mp_add(b, m, temp) != MP_OKAY) || (temp->used <= sd)) { /* Too few digits to be > s */ return 0; } if (temp->used > sd+1 || temp->dp[sd] > 1) { /* >= 2s */ return 1; @@ -3152,11 +3438,11 @@ * ShorteningBignumConversionPowD -- * * Converts a double-precision number to the shortest string of digits * that reconverts exactly to the given number, or to 'ilim' digits if * that will yield a shorter result. The denominator in David Gay's - * conversion algorithm is known to be a power of 2**DIGIT_BIT, and hence + * conversion algorithm is known to be a power of 2**MP_DIGIT_BIT, and hence * the division in the main loop may be replaced by a digit shift and * mask. * * Results: * Returns the string of significant decimal digits, in newly allocated @@ -3186,37 +3472,45 @@ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = Tcl_Alloc(len + 1); + char *retval = (char *)ckalloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_int mplus, mminus; /* Bounds for roundoff. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ mp_int temp; int r1; + mp_err err = MP_OKAY; /* * b = bw * 2**b2 * 5**b5 * mminus = 5**m5 */ - TclInitBignumFromWideUInt(&b, bw); - mp_init_set(&mminus, 1); - MulPow5(&b, b5, &b); - mp_mul_2d(&b, b2, &b); + if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) { + return NULL; + } + if (mp_init_set(&mminus, 1) != MP_OKAY) { + mp_clear(&b); + return NULL; + } + err = MulPow5(&b, b5, &b); + if (err == MP_OKAY) { + err = mp_mul_2d(&b, b2, &b); + } /* * Adjust if the logarithm was guessed wrong. */ - if (b.used <= sd) { - mp_mul_d(&b, 10, &b); + if ((err == MP_OKAY) && (b.used <= sd)) { + err = mp_mul_d(&b, 10, &b); ++m2plus; ++m2minus; ++m5; ilim = ilim1; --k; } @@ -3223,20 +3517,28 @@ /* * mminus = 5**m5 * 2**m2minus * mplus = 5**m5 * 2**m2plus */ - mp_mul_2d(&mminus, m2minus, &mminus); - MulPow5(&mminus, m5, &mminus); - if (m2plus > m2minus) { - mp_init_copy(&mplus, &mminus); - mp_mul_2d(&mplus, m2plus-m2minus, &mplus); + if (err == MP_OKAY) { + err = mp_mul_2d(&mminus, m2minus, &mminus); } - mp_init(&temp); + if (err == MP_OKAY) { + err = MulPow5(&mminus, m5, &mminus); + } + if ((err == MP_OKAY) && (m2plus > m2minus)) { + err = mp_init_copy(&mplus, &mminus); + if (err == MP_OKAY) { + err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus); + } + } + if (err == MP_OKAY) { + err = mp_init(&temp); + } /* - * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT) + * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT) * by mp_digit extraction. */ i = 0; for (;;) { @@ -3311,14 +3613,18 @@ /* * Advance to the next digit. */ - mp_mul_d(&b, 10, &b); - mp_mul_d(&mminus, 10, &mminus); - if (m2plus > m2minus) { - mp_mul_2d(&mminus, m2plus-m2minus, &mplus); + if (err == MP_OKAY) { + err = mp_mul_d(&b, 10, &b); + } + if (err == MP_OKAY) { + err = mp_mul_d(&mminus, 10, &mminus); + } + if ((err == MP_OKAY) && (m2plus > m2minus)) { + err = mp_mul_2d(&mminus, m2plus-m2minus, &mplus); } ++i; } /* @@ -3333,11 +3639,11 @@ *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } - return retval; + return (err == MP_OKAY) ? retval : NULL; } /* *---------------------------------------------------------------------- * @@ -3344,11 +3650,11 @@ * StrictBignumConversionPowD -- * * Converts a double-precision number to a fixed-lengt string of 'ilim' * digits (or 'ilim1' if log10(d) has been overestimated). The * denominator in David Gay's conversion algorithm is known to be a power - * of 2**DIGIT_BIT, and hence the division in the main loop may be + * of 2**MP_DIGIT_BIT, and hence the division in the main loop may be * replaced by a digit shift and mask. * * Results: * Returns the string of significant decimal digits, in newly allocated * memory. @@ -3360,11 +3666,10 @@ *---------------------------------------------------------------------- */ static inline char * StrictBignumConversionPowD( - Double *dPtr, /* Original number to convert. */ Tcl_WideUInt bw, /* Integer significand. */ int b2, int b5, /* Scale factor for the significand in the * numerator. */ int sd, /* Scale factor for the denominator. */ int k, /* Number of output digits before the decimal @@ -3374,43 +3679,48 @@ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = Tcl_Alloc(len + 1); + char *retval = (char *)ckalloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ mp_digit digit; /* Current output digit. */ char *s = retval; /* Cursor in the output buffer. */ int i; /* Index in the output buffer. */ + mp_err err; /* * b = bw * 2**b2 * 5**b5 */ - TclInitBignumFromWideUInt(&b, bw); - MulPow5(&b, b5, &b); - mp_mul_2d(&b, b2, &b); + if (mp_init_u64(&b, bw) != MP_OKAY) { + return NULL; + } + err = MulPow5(&b, b5, &b); + if (err == MP_OKAY) { + err = mp_mul_2d(&b, b2, &b); + } /* * Adjust if the logarithm was guessed wrong. */ - if (b.used <= sd) { - mp_mul_d(&b, 10, &b); + if ((err == MP_OKAY) && (b.used <= sd)) { + err = mp_mul_d(&b, 10, &b); ilim = ilim1; --k; } /* - * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT) + * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT) * by mp_digit extraction. */ i = 1; - for (;;) { + while (err == MP_OKAY) { if (b.used <= sd) { digit = 0; } else { digit = b.dp[sd]; if (b.used > sd+1 || digit >= 10) { @@ -3438,11 +3748,11 @@ /* * Advance to the next digit. */ - mp_mul_d(&b, 10, &b); + err = mp_mul_d(&b, 10, &b); ++i; } /* * Endgame - store the location of the decimal point and the end of the @@ -3520,12 +3830,13 @@ /* * Compare b and S-m: this is the same as comparing B+m and S. */ - mp_init(&temp); - mp_add(b, m, &temp); + if ((mp_init(&temp) != MP_OKAY) || (mp_add(b, m, &temp) != MP_OKAY)) { + return 0; + } r = mp_cmp_mag(&temp, S); mp_clear(&temp); switch(r) { case MP_LT: return 0; @@ -3568,11 +3879,11 @@ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { - char *retval = Tcl_Alloc(len+1); + char *retval = (char *)ckalloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int mminus; /* 1/2 ulp below the result. */ mp_int mplus; /* 1/2 ulp above the result. */ @@ -3580,51 +3891,69 @@ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int minit = 1; /* Fudge factor for when we misguess k. */ int i; int r1; + mp_err err; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ - TclInitBignumFromWideUInt(&b, bw); - mp_mul_2d(&b, b2, &b); - mp_init_set(&S, 1); - MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); + if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) { + return NULL; + } + err = mp_mul_2d(&b, b2, &b); + if (err == MP_OKAY) { + err = mp_init_set(&S, 1); + } + if (err == MP_OKAY) { + err = MulPow5(&S, s5, &S); + } + if (err == MP_OKAY) { + err = mp_mul_2d(&S, s2, &S); + } /* * Handle the case where we guess the position of the decimal point wrong. */ - if (mp_cmp_mag(&b, &S) == MP_LT) { - mp_mul_d(&b, 10, &b); + if ((err == MP_OKAY) && (mp_cmp_mag(&b, &S) == MP_LT)) { + err = mp_mul_d(&b, 10, &b); minit = 10; ilim =ilim1; --k; } /* * mminus = 2**m2minus * 5**m5 */ - mp_init_set(&mminus, minit); - mp_mul_2d(&mminus, m2minus, &mminus); - if (m2plus > m2minus) { - mp_init_copy(&mplus, &mminus); - mp_mul_2d(&mplus, m2plus-m2minus, &mplus); + if (err == MP_OKAY) { + err = mp_init_set(&mminus, minit); + } + if (err == MP_OKAY) { + err = mp_mul_2d(&mminus, m2minus, &mminus); + } + if ((err == MP_OKAY) && (m2plus > m2minus)) { + err = mp_init_copy(&mplus, &mminus); + if (err == MP_OKAY) { + err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus); + } } /* * Loop through the digits. */ - mp_init(&dig); + if (err == MP_OKAY) { + err = mp_init(&dig); + } i = 1; - for (;;) { - mp_div(&b, &S, &dig, &b); + while (err == MP_OKAY) { + err = mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; @@ -3633,11 +3962,11 @@ * round to it? */ r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus); if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) { - mp_mul_2d(&b, 1, &b); + err = mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { ++digit; if (digit == 10) { *s++ = '9'; s = BumpUp(s, retval, &k); @@ -3668,12 +3997,12 @@ /* * Have we converted all the requested digits? */ *s++ = '0' + digit; - if (i == ilim) { - mp_mul_2d(&b, 1, &b); + if ((err == MP_OKAY) && (i == ilim)) { + err = mp_mul_2d(&b, 1, &b); if (ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } break; } @@ -3680,21 +4009,25 @@ /* * Advance to the next digit. */ - if (s5 > 0) { + if ((err == MP_OKAY) && (s5 > 0)) { /* * Can possibly shorten the denominator. */ - mp_mul_2d(&b, 1, &b); - mp_mul_2d(&mminus, 1, &mminus); - if (m2plus > m2minus) { - mp_mul_2d(&mplus, 1, &mplus); + err = mp_mul_2d(&b, 1, &b); + if (err == MP_OKAY) { + err = mp_mul_2d(&mminus, 1, &mminus); + } + if ((err == MP_OKAY) && (m2plus > m2minus)) { + err = mp_mul_2d(&mplus, 1, &mplus); } - mp_div_d(&S, 5, &S, NULL); + if (err == MP_OKAY) { + err = mp_div_d(&S, 5, &S, NULL); + } --s5; /* * IDEA: It might possibly be a win to fall back to int64_t * arithmetic here if S < 2**64/10. But it's a win only for @@ -3720,15 +4053,17 @@ * 10**40 14 trips * 10**41 15 trips * 10**42 16 trips * thereafter no gain. */ - } else { - mp_mul_d(&b, 10, &b); - mp_mul_d(&mminus, 10, &mminus); - if (m2plus > m2minus) { - mp_mul_2d(&mplus, 10, &mplus); + } else if (err == MP_OKAY) { + err = mp_mul_d(&b, 10, &b); + if (err == MP_OKAY) { + err = mp_mul_d(&mminus, 10, &mminus); + } + if ((err == MP_OKAY) && (m2plus > m2minus)) { + err = mp_mul_2d(&mplus, 10, &mplus); } } ++i; } @@ -3768,11 +4103,10 @@ *---------------------------------------------------------------------- */ static inline char * StrictBignumConversion( - Double *dPtr, /* Original number being converted. */ Tcl_WideUInt bw, /* Integer significand and exponent. */ int b2, /* Scale factor for the significand. */ int s2, int s5, /* Scale factors for denominator. */ int k, /* Guessed position of the decimal point. */ int len, /* Size of the digit buffer to allocate. */ @@ -3779,47 +4113,59 @@ int ilim, /* Number of digits to convert if b >= s */ int ilim1, /* Number of digits to convert if b < s */ int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { - char *retval = Tcl_Alloc(len+1); + char *retval = (char *)ckalloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ mp_int S; /* Denominator of the result. */ mp_int dig; /* Current digit of the result. */ int digit; /* Current digit of the result. */ int g; /* Size of the current digit ground. */ int i, j; + mp_err err; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ - mp_init_multi(&dig, NULL); - TclInitBignumFromWideUInt(&b, bw); - mp_mul_2d(&b, b2, &b); - mp_init_set(&S, 1); - MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); + if (mp_init(&dig) != MP_OKAY) { + return NULL; + } + if (mp_init_u64(&b, bw) != MP_OKAY) { + mp_clear(&dig); + return NULL; + } + err = mp_mul_2d(&b, b2, &b); + if (err == MP_OKAY) { + err = mp_init_set(&S, 1); + } + if (err == MP_OKAY) { + err = MulPow5(&S, s5, &S); + if (err == MP_OKAY) { + err = mp_mul_2d(&S, s2, &S); + } + } /* * Handle the case where we guess the position of the decimal point wrong. */ - if (mp_cmp_mag(&b, &S) == MP_LT) { - mp_mul_d(&b, 10, &b); + if ((mp_cmp_mag(&b, &S) == MP_LT) && (mp_mul_d(&b, 10, &b) == MP_OKAY)) { ilim =ilim1; --k; } /* * Convert the leading digit. */ i = 0; - mp_div(&b, &S, &dig, &b); + err = mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; @@ -3827,35 +4173,38 @@ * Is a single digit all that was requested? */ *s++ = '0' + digit; if (++i >= ilim) { - mp_mul_2d(&b, 1, &b); - if (ShouldBankerRoundUp(&b, &S, digit&1)) { + if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } } else { - for (;;) { + while (err == MP_OKAY) { /* * Shift by a group of digits. */ g = ilim - i; if (g > DIGIT_GROUP) { g = DIGIT_GROUP; } if (s5 >= g) { - mp_div_d(&S, dpow5[g], &S, NULL); + err = mp_div_d(&S, dpow5[g], &S, NULL); s5 -= g; } else if (s5 > 0) { - mp_div_d(&S, dpow5[s5], &S, NULL); - mp_mul_d(&b, dpow5[g - s5], &b); + err = mp_div_d(&S, dpow5[s5], &S, NULL); + if (err == MP_OKAY) { + err = mp_mul_d(&b, dpow5[g - s5], &b); + } s5 = 0; } else { - mp_mul_d(&b, dpow5[g], &b); + err = mp_mul_d(&b, dpow5[g], &b); } - mp_mul_2d(&b, g, &b); + if (err == MP_OKAY) { + err = mp_mul_2d(&b, g, &b); + } /* * As with the shortening bignum conversion, it's possible at this * point that we will have reduced the denominator to less than * 2**64/10, at which point it would be possible to fall back to @@ -3865,12 +4214,12 @@ * longest format that doesn't introduce empty precision. * * Extract the next group of digits. */ - mp_div(&b, &S, &dig, &b); - if (dig.used > 1) { + + if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; for (j = g-1; j >= 0; --j) { int t = itens[j]; @@ -3883,12 +4232,11 @@ /* * Have we converted all the requested digits? */ if (i == ilim) { - mp_mul_2d(&b, 1, &b); - if (ShouldBankerRoundUp(&b, &S, digit&1)) { + if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) { s = BumpUp(s, retval, &k); } break; } } @@ -3931,22 +4279,23 @@ * sign (or no sign) should appear. * * This function is a service routine that produces the string of digits for * floating-point-to-decimal conversion. It can do a number of things * according to the 'flags' argument. Valid values for 'flags' include: - * TCL_DD_SHORTEST - This is the default for floating point conversion. - * It constructs the shortest string of + * TCL_DD_SHORTEST - This is the default for floating point conversion if + * ::tcl_precision is 0. It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. * With this value, the 'ndigits' parameter is ignored. * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format - * conversion. It constructs a string of at most 'ndigits' digits, + * conversion (or for default floating->string if tcl_precision + * is not 0). It constructs a string of at most 'ndigits' digits, * choosing the one that is closest to the given number (and * resolving ties with 'round to even'). It is allowed to return * fewer than 'ndigits' if the number converts exactly; if the - * TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it + * TCL_DD_E_FORMAT|TCL_DD_SHORTEST is supplied instead, it * also returns fewer digits if the shorter string will still * reconvert without loss to the given input number. In any case, * strings of trailing zeroes are suppressed. * TCL_DD_F_FORMAT - This value is used to prepare numbers for %f format * conversion. It requests that conversion proceed until @@ -3953,11 +4302,11 @@ * 'ndigits' digits after the decimal point have been converted. * It is possible for this format to result in a zero-length * string if the number is sufficiently small. Again, it is * permissible for TCL_DD_F_FORMAT to return fewer digits for a * number that converts exactly, and changing the argument to - * TCL_DD_F_FORMAT|TCL_DD_SHORTEN_FLAG will allow the routine + * TCL_DD_F_FORMAT|TCL_DD_SHORTEST will allow the routine * also to return fewer digits if the shorter string will still * reconvert without loss to the given input number. Strings of * trailing zeroes are suppressed. * * To any of these flags may be OR'ed TCL_DD_NO_QUICK; this flag requires @@ -4090,11 +4439,11 @@ * side. * We may need to increase s2 to put m2plus, m2minus, b2 over a common * denominator. */ - if (flags & TCL_DD_SHORTEN_FLAG) { + if (flags & TCL_DD_SHORTEST) { int m2minus = b2; int m2plus; int m5 = b5; int len = i; @@ -4142,11 +4491,11 @@ return ShorteningInt64Conversion(&d, bw, b2, b5, m2plus, m2minus, m5, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } else if (s5 == 0) { /* * The denominator is a power of 2, so we can replace division by - * digit shifts. First we round up s2 to a multiple of DIGIT_BIT, + * digit shifts. First we round up s2 to a multiple of MP_DIGIT_BIT, * and adjust m2 and b2 accordingly. Then we launch into a version * of the comparison that's specialized for the 'power of mp_digit * in the denominator' case. */ @@ -4193,16 +4542,16 @@ * then all our intermediate calculations can be done using exact * 64-bit arithmetic with no need for expensive multiprecision * operations. */ - return StrictInt64Conversion(&d, bw, b2, b5, s2, s5, k, + return StrictInt64Conversion(bw, b2, b5, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } else if (s5 == 0) { /* * The denominator is a power of 2, so we can replace division by - * digit shifts. First we round up s2 to a multiple of DIGIT_BIT, + * digit shifts. First we round up s2 to a multiple of MP_DIGIT_BIT, * and adjust m2 and b2 accordingly. Then we launch into a version * of the comparison that's specialized for the 'power of mp_digit * in the denominator' case. */ @@ -4210,21 +4559,21 @@ int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT); b2 += delta; s2 += delta; } - return StrictBignumConversionPowD(&d, bw, b2, b5, + return StrictBignumConversionPowD(bw, b2, b5, s2/MP_DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr); } else { /* * There are no helpful special cases, but at least we know in * advance how many digits we will convert. We can run the * conversion in steps of DIGIT_GROUP digits, so as to have many * fewer mp_int divisions. */ - return StrictBignumConversion(&d, bw, b2, s2, s5, k, + return StrictBignumConversion(bw, b2, s2, s5, k, len, ilim, ilim1, decpt, endPtr); } } } @@ -4258,10 +4607,11 @@ union { double dv; Tcl_WideUInt iv; } bitwhack; #endif + mp_err err = MP_OKAY; #if defined(__sgi) && defined(_COMPILER_VERSION) union fpc_csr mipsCR; mipsCR.fc_word = get_fpc_csr(); mipsCR.fc_struct.flush = 0; @@ -4272,11 +4622,12 @@ * Initialize table of powers of 10 expressed as wide integers. */ maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); - pow10_wide = Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); + pow10_wide = (Tcl_WideUInt *) + ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); u = 1; for (i = 0; i < maxpow10_wide; ++i) { pow10_wide[i] = u; u *= 10; } @@ -4313,20 +4664,23 @@ /* * Initialize a table of large powers of five. */ for (i=0; i<9; ++i) { - mp_init(pow5 + i); + err = err || mp_init(pow5 + i); } - mp_set(pow5, 5); + mp_set_u64(pow5, 5); for (i=0; i<8; ++i) { - mp_sqr(pow5+i, pow5+i+1); + err = err || mp_sqr(pow5+i, pow5+i+1); } - mp_init_set_int(pow5_13, 1220703125); + err = err || mp_init_u64(pow5_13, 1220703125); for (i = 1; i < 5; ++i) { - mp_init(pow5_13 + i); - mp_sqr(pow5_13 + i - 1, pow5_13 + i); + err = err || mp_init(pow5_13 + i); + err = err || mp_sqr(pow5_13 + i - 1, pow5_13 + i); + } + if (err != MP_OKAY) { + Tcl_Panic("out of memory"); } /* * Determine the number of decimal digits to the left and right of the * decimal point in the largest and smallest double, the smallest double @@ -4348,13 +4702,13 @@ */ #ifdef IEEE_FLOATING_POINT bitwhack.dv = 1.000000238418579; /* 3ff0 0000 4000 0000 */ - if ((bitwhack.iv >> 32) == 0x3ff00000) { + if ((bitwhack.iv >> 32) == 0x3FF00000) { n770_fp = 0; - } else if ((bitwhack.iv & 0xffffffff) == 0x3ff00000) { + } else if ((bitwhack.iv & 0xFFFFFFFF) == 0x3FF00000) { n770_fp = 1; } else { Tcl_Panic("unknown floating point word order on this machine"); } #endif @@ -4379,11 +4733,11 @@ void TclFinalizeDoubleConversion(void) { int i; - Tcl_Free(pow10_wide); + ckfree(pow10_wide); for (i=0; i<9; ++i) { mp_clear(pow5 + i); } for (i=0; i < 5; ++i) { mp_clear(pow5_13 + i); @@ -4410,14 +4764,16 @@ int Tcl_InitBignumFromDouble( Tcl_Interp *interp, /* For error message. */ double d, /* Number to convert. */ - mp_int *b) /* Place to store the result. */ + void *big) /* Place to store the result. */ { double fract; int expt; + mp_err err; + mp_int *b = (mp_int *)big; /* * Infinite values can't convert to bignum. */ @@ -4431,22 +4787,27 @@ return TCL_ERROR; } fract = frexp(d, &expt); if (expt <= 0) { - mp_init(b); + err = mp_init(b); mp_zero(b); } else { Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits); int shift = expt - mantBits; - TclInitBignumFromWideInt(b, w); - if (shift < 0) { - mp_div_2d(b, -shift, b, NULL); + err = mp_init_i64(b, w); + if (err != MP_OKAY) { + /* just skip */ + } else if (shift < 0) { + err = mp_div_2d(b, -shift, b, NULL); } else if (shift > 0) { - mp_mul_2d(b, shift, b); + err = mp_mul_2d(b, shift, b); } + } + if (err != MP_OKAY) { + return TCL_ERROR; } return TCL_OK; } /* @@ -4464,15 +4825,17 @@ *---------------------------------------------------------------------- */ double TclBignumToDouble( - const mp_int *a) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { mp_int b; int bits, shift, i, lsb; double r; + mp_err err; + const mp_int *a = (const mp_int *)big; /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. @@ -4479,14 +4842,14 @@ */ bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { errno = ERANGE; - if (a->sign == MP_ZPOS) { - return HUGE_VAL; + if (mp_isneg(a)) { + return -HUGE_VAL; } else { - return -HUGE_VAL; + return HUGE_VAL; } } shift = mantBits - bits; /* @@ -4497,53 +4860,60 @@ * least significant bits are 0, but the 'shift'th bit is nonzero, * then the significand lies exactly between two values and must be * 'rounded to even'. */ - mp_init(&b); - if (shift == 0) { - mp_copy(a, &b); + err = mp_init(&b); + if (err != MP_OKAY) { + /* just skip */ + } else if (shift == 0) { + err = mp_copy(a, &b); } else if (shift > 0) { - mp_mul_2d(a, shift, &b); + err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { lsb = mp_cnt_lsb(a); if (lsb == -1-shift) { /* * Round to even */ - mp_div_2d(a, -shift, &b, NULL); - if (mp_isodd(&b)) { - if (b.sign == MP_ZPOS) { - mp_add_d(&b, 1, &b); + err = mp_div_2d(a, -shift, &b, NULL); + if ((err == MP_OKAY) && mp_isodd(&b)) { + if (mp_isneg(&b)) { + err = mp_sub_d(&b, 1, &b); } else { - mp_sub_d(&b, 1, &b); + err = mp_add_d(&b, 1, &b); } } } else { /* * Ordinary rounding */ - mp_div_2d(a, -1-shift, &b, NULL); - if (b.sign == MP_ZPOS) { - mp_add_d(&b, 1, &b); + err = mp_div_2d(a, -1-shift, &b, NULL); + if (err != MP_OKAY) { + /* just skip */ + } else if (mp_isneg(&b)) { + err = mp_sub_d(&b, 1, &b); } else { - mp_sub_d(&b, 1, &b); + err = mp_add_d(&b, 1, &b); } - mp_div_2d(&b, 1, &b, NULL); + err = mp_div_2d(&b, 1, &b, NULL); } } /* * Accumulate the result, one mp_digit at a time. */ + if (err != MP_OKAY) { + return 0.0; + } r = 0.0; - for (i=b.used-1 ; i>=0 ; --i) { + for (i = b.used-1; i>=0; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } mp_clear(&b); /* @@ -4554,14 +4924,14 @@ /* * Return the result with the appropriate sign. */ - if (a->sign == MP_ZPOS) { - return r; + if (mp_isneg(a)) { + return -r; } else { - return -r; + return r; } } /* *---------------------------------------------------------------------- @@ -4577,40 +4947,49 @@ *---------------------------------------------------------------------- */ double TclCeil( - const mp_int *a) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; + mp_err err; + const mp_int *a = (const mp_int *)big; - mp_init(&b); - if (a->sign != MP_ZPOS) { - mp_neg(a, &b); + err = mp_init(&b); + if ((err == MP_OKAY) && mp_isneg(a)) { + err = mp_neg(a, &b); r = -TclFloor(&b); } else { int bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { r = HUGE_VAL; } else { int i, exact = 1, shift = mantBits - bits; - if (shift > 0) { - mp_mul_2d(a, shift, &b); + if (err != MP_OKAY) { + /* just skip */ + } else if (shift > 0) { + err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { mp_int d; - mp_init(&d); - mp_div_2d(a, -shift, &b, &d); - exact = d.used == 0; + err = mp_init(&d); + if (err == MP_OKAY) { + err = mp_div_2d(a, -shift, &b, &d); + } + exact = mp_iszero(&d); mp_clear(&d); } else { - mp_copy(a, &b); + err = mp_copy(a, &b); + } + if ((err == MP_OKAY) && !exact) { + err = mp_add_d(&b, 1, &b); } - if (!exact) { - mp_add_d(&b, 1, &b); + if (err != MP_OKAY) { + return 0.0; } for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); @@ -4634,18 +5013,20 @@ *---------------------------------------------------------------------- */ double TclFloor( - const mp_int *a) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; + mp_err err; + const mp_int *a = (const mp_int *)big; - mp_init(&b); - if (a->sign != MP_ZPOS) { - mp_neg(a, &b); + err = mp_init(&b); + if ((err == MP_OKAY) && mp_isneg(a)) { + err = mp_neg(a, &b); r = -TclCeil(&b); } else { int bits = mp_count_bits(a); if (bits > DBL_MAX_EXP*log2FLT_RADIX) { @@ -4652,15 +5033,18 @@ r = DBL_MAX; } else { int i, shift = mantBits - bits; if (shift > 0) { - mp_mul_2d(a, shift, &b); + err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { - mp_div_2d(a, -shift, &b, NULL); + err = mp_div_2d(a, -shift, &b, NULL); } else { - mp_copy(a, &b); + err = mp_copy(a, &b); + } + if (err != MP_OKAY) { + return 0.0; } for (i=b.used-1 ; i>=0 ; --i) { r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; } r = ldexp(r, bits - mantBits); @@ -4698,43 +5082,48 @@ mp_int b; int bits; int shift; int i; double r; + mp_err err = MP_OKAY; /* * Determine how many bits we need, and extract that many from the input. * Round to nearest unit in the last place. */ bits = mp_count_bits(a); shift = mantBits - 2 - bits; - mp_init(&b); + if (mp_init(&b)) { + return 0.0; + } if (shift > 0) { - mp_mul_2d(a, shift, &b); + err = mp_mul_2d(a, shift, &b); } else if (shift < 0) { - mp_div_2d(a, -shift, &b, NULL); + err = mp_div_2d(a, -shift, &b, NULL); } else { - mp_copy(a, &b); + err = mp_copy(a, &b); } /* * Accumulate the result, one mp_digit at a time. */ r = 0.0; - for (i=b.used-1; i>=0; --i) { - r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; + if (err == MP_OKAY) { + for (i=b.used-1; i>=0; --i) { + r = ldexp(r, MP_DIGIT_BIT) + b.dp[i]; + } } mp_clear(&b); /* * Return the result with the appropriate sign. */ *machexp = bits - mantBits + 2; - return ((a->sign == MP_ZPOS) ? r : -r); + return (mp_isneg(a) ? -r : r); } /* *---------------------------------------------------------------------- * @@ -4769,11 +5158,11 @@ if (exponent > 0) { /* * Multiply by 10**exponent. */ - retval = frexp(retval * pow10vals[exponent & 0xf], &j); + retval = frexp(retval * pow10vals[exponent & 0xF], &j); expt += j; for (i=4; i<9; ++i) { if (exponent & (1<> 32) & 0xffffffff) | (w << 32)); + return (((w >> 32) & 0xFFFFFFFF) | (w << 32)); } #endif /* *---------------------------------------------------------------------- Index: generic/tclStringObj.c ================================================================== --- generic/tclStringObj.c +++ generic/tclStringObj.c @@ -33,11 +33,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" #include "tclStringRep.h" #include "assert.h" /* * Prototypes for functions defined later in this file: @@ -44,32 +44,32 @@ */ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t appendNumChars); + const Tcl_UniChar *unicode, int appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); + const Tcl_UniChar *unicode, int numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes); + const char *bytes, int numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes); + const char *bytes, int numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static size_t ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); +static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, int numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes, - size_t numAppendChars); + const char *bytes, int numBytes, + int numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); -static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); -static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); +static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); +static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); -static size_t UnicodeLength(const Tcl_UniChar *unicode); + const Tcl_UniChar *unicode, int numChars); +static int UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* * The structure below defines the string Tcl object type by means of * functions that can be invoked by generic object code. @@ -121,11 +121,11 @@ #endif static void GrowStringBuffer( Tcl_Obj *objPtr, - size_t needed, + int needed, int flag) { /* * Pre-conditions: * objPtr->typePtr == &tclStringType @@ -133,75 +133,82 @@ * flag || objPtr->bytes != NULL */ String *stringPtr = GET_STRING(objPtr); char *ptr = NULL; - size_t attempt; + int attempt; if (objPtr->bytes == &tclEmptyString) { objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { - attempt = 2 * needed; - ptr = Tcl_AttemptRealloc(objPtr->bytes, attempt + 1); + if (needed <= INT_MAX / 2) { + attempt = 2 * needed; + ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1); + } if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid * overflow into invalid argument values for attempt. */ - size_t limit = INT_MAX - needed; - size_t extra = needed - objPtr->length + TCL_MIN_GROWTH; - size_t growth = (extra > limit) ? limit : extra; + unsigned int limit = INT_MAX - needed; + unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH; + int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; - ptr = Tcl_AttemptRealloc(objPtr->bytes, attempt + 1); + ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1); } } if (ptr == NULL) { /* * First allocation - just big enough; or last chance fallback. */ attempt = needed; - ptr = Tcl_Realloc(objPtr->bytes, attempt + 1); + ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1); } objPtr->bytes = ptr; stringPtr->allocated = attempt; } static void GrowUnicodeBuffer( Tcl_Obj *objPtr, - size_t needed) + int needed) { /* * Pre-conditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->maxChars + * needed < STRING_MAXCHARS */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); - size_t attempt; + int attempt; if (stringPtr->maxChars > 0) { /* * Subsequent appends - apply the growth algorithm. */ - attempt = 2 * needed; - ptr = stringAttemptRealloc(stringPtr, attempt); + if (needed <= STRING_MAXCHARS / 2) { + attempt = 2 * needed; + ptr = stringAttemptRealloc(stringPtr, attempt); + } if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid * overflow into invalid argument values for attempt. */ - size_t extra = needed - stringPtr->numChars + unsigned int limit = STRING_MAXCHARS - needed; + unsigned int extra = needed - stringPtr->numChars + TCL_MIN_UNICHAR_GROWTH; + int growth = (int) ((extra > limit) ? limit : extra); - attempt = needed + extra; + attempt = needed + growth; ptr = stringAttemptRealloc(stringPtr, attempt); } } if (ptr == NULL) { /* @@ -245,11 +252,11 @@ #undef Tcl_NewStringObj Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length) /* The number of bytes to copy from "bytes" + int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ { return Tcl_DbNewStringObj(bytes, length, "unknown", 0); @@ -257,17 +264,18 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length) /* The number of bytes to copy from "bytes" - * when initializing the new object. If -1, - * use bytes up to the first NUL byte. */ + int length) /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ { Tcl_Obj *objPtr; - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclNewStringObj(objPtr, bytes, length); return objPtr; } @@ -305,21 +313,22 @@ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If -1, - * use bytes up to the first NUL byte. */ + int length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclDbNewObj(objPtr, file, line); TclInitStringRep(objPtr, bytes, length); return objPtr; @@ -327,17 +336,16 @@ #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If -1, - * use bytes up to the first NUL byte. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ + int length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ + TCL_UNUSED(const char *) /*file*/, + TCL_UNUSED(int) /*line*/) { return Tcl_NewStringObj(bytes, length); } #endif /* TCL_MEM_DEBUG */ @@ -362,11 +370,11 @@ Tcl_Obj * Tcl_NewUnicodeObj( const Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ - size_t numChars) /* Number of characters in the unicode + int numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); @@ -389,17 +397,17 @@ * rep. * *---------------------------------------------------------------------- */ -size_t +int Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { String *stringPtr; - size_t numChars = 0; + int numChars; /* * Quick, no-shimmer return for short string reps. */ @@ -418,12 +426,14 @@ * but there's no value in that. We *want* to shimmer an improper bytearray * because improper bytearrays have worthless internal reps. */ if (TclIsPureByteArray(objPtr)) { - (void) TclGetByteArrayFromObj(objPtr, &numChars); - return numChars; + int length; + + (void) Tcl_GetByteArrayFromObj(objPtr, &length); + return length; } /* * OK, need to work with the object as a string. */ @@ -434,11 +444,11 @@ /* * If numChars is unknown, compute it. */ - if (numChars == TCL_AUTO_LENGTH) { + if (numChars == -1) { TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } return numChars; } @@ -505,28 +515,31 @@ int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - size_t index) /* Get the index'th Unicode character. */ + int index) /* Get the index'th Unicode character. */ { String *stringPtr; - int ch; + int ch, length; + + if (index < 0) { + return -1; + } /* * Optimize the case where we're really dealing with a bytearray object * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { - size_t length = 0; - unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length); + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } - return bytes[index]; + return (int) bytes[index]; } /* * OK, need to work with the object as a string. */ @@ -537,11 +550,11 @@ if (stringPtr->hasUnicode == 0) { /* * If numChars is unknown, compute it. */ - if (stringPtr->numChars == TCL_AUTO_LENGTH) { + if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { return (Tcl_UniChar) objPtr->bytes[index]; } @@ -551,11 +564,11 @@ if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ if ((ch & 0xF800) == 0xD800) { if (ch & 0x400) { if ((index > 0) && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) { @@ -570,10 +583,40 @@ } #endif return ch; } +/* + *---------------------------------------------------------------------- + * + * Tcl_GetUnicode -- + * + * Get the Unicode form of the String object. If the object is not + * already a String object, it will be converted to one. If the String + * object does not have a Unicode rep, then one is created from the UTF + * string format. + * + * Results: + * Returns a pointer to the object's internal Unicode string. + * + * Side effects: + * Converts the object to have the String internal rep. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_GetUnicode +Tcl_UniChar * +Tcl_GetUnicode( + Tcl_Obj *objPtr) /* The object to find the unicode string + * for. */ +{ + return Tcl_GetUnicodeFromObj(objPtr, NULL); +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_GetUnicodeFromObj -- * @@ -635,31 +678,28 @@ */ Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - size_t first, /* First index of the range. */ - size_t last) /* Last index of the range. */ + int first, /* First index of the range. */ + int last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; - size_t length = 0; + int length; - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; - } - if (last + 2 <= first + 1) { - return Tcl_NewObj(); + if (first < 0) { + first = 0; } /* * Optimize the case where we're really dealing with a bytearray object * we don't need to convert to a string to perform the substring operation. */ if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length); + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (last >= length) { last = length - 1; } if (last < first) { @@ -678,11 +718,11 @@ if (stringPtr->hasUnicode == 0) { /* * If numChars is unknown, compute it. */ - if (stringPtr->numChars == TCL_AUTO_LENGTH) { + if (stringPtr->numChars == -1) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { if (last >= stringPtr->numChars) { last = stringPtr->numChars - 1; @@ -708,17 +748,17 @@ last = stringPtr->numChars; } if (last < first) { return Tcl_NewObj(); } -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* See: bug [11ae2be95dac9417] */ - if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) + if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } - if ((last + 2 < stringPtr->numChars + 1) + if ((last + 1 < stringPtr->numChars) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; } #endif @@ -749,12 +789,12 @@ void Tcl_SetStringObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - size_t length) /* The number of bytes to copy from "bytes" - * when initializing the object. If -1, + int length) /* The number of bytes to copy from "bytes" + * when initializing the object. If negative, * use bytes up to the first NUL byte.*/ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetStringObj"); } @@ -769,11 +809,11 @@ * Free any old string rep, then set the string rep to a copy of the * length bytes starting at "bytes". */ TclInvalidateStringRep(objPtr); - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclInitStringRep(objPtr, bytes, length); } @@ -802,16 +842,25 @@ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - size_t length) /* Number of bytes desired for string + int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; + if (length < 0) { + /* + * Setting to a negative length is nonsense. This is probably the + * result of overflowing the signed integer range. + */ + + Tcl_Panic("Tcl_SetObjLength: negative length requested: " + "%d (integer overflow?)", length); + } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } if (objPtr->bytes && objPtr->length == length) { @@ -828,13 +877,13 @@ if (length > stringPtr->allocated) { /* * Need to enlarge the buffer. */ if (objPtr->bytes == &tclEmptyString) { - objPtr->bytes = Tcl_Alloc(length + 1); + objPtr->bytes = (char *)ckalloc(length + 1); } else { - objPtr->bytes = Tcl_Realloc(objPtr->bytes, length + 1); + objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1); } stringPtr->allocated = length; } objPtr->length = length; @@ -842,13 +891,18 @@ /* * Invalidate the unicode data. */ - stringPtr->numChars = TCL_AUTO_LENGTH; + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; } else { + /* + * Changing length of pure unicode string. + */ + + stringCheckLimits(length); if (length > stringPtr->maxChars) { stringPtr = stringRealloc(stringPtr, length); SET_STRING(objPtr, stringPtr); stringPtr->maxChars = length; } @@ -893,16 +947,24 @@ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - size_t length) /* Number of bytes desired for string + int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; + if (length < 0) { + /* + * Setting to a negative length is nonsense. This is probably the + * result of overflowing the signed integer range. + */ + + return 0; + } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } if (objPtr->bytes && objPtr->length == length) { return 1; @@ -921,13 +983,13 @@ */ char *newBytes; if (objPtr->bytes == &tclEmptyString) { - newBytes = Tcl_AttemptAlloc(length + 1); + newBytes = (char *)attemptckalloc(length + 1); } else { - newBytes = Tcl_AttemptRealloc(objPtr->bytes, length + 1); + newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1); } if (newBytes == NULL) { return 0; } objPtr->bytes = newBytes; @@ -939,17 +1001,20 @@ /* * Invalidate the unicode data. */ - stringPtr->numChars = TCL_AUTO_LENGTH; + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; } else { /* * Changing length of pure unicode string. */ + if (length > STRING_MAXCHARS) { + return 0; + } if (length > stringPtr->maxChars) { stringPtr = stringAttemptRealloc(stringPtr, length); if (stringPtr == NULL) { return 0; } @@ -992,52 +1057,54 @@ void Tcl_SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - size_t numChars) /* Number of characters in the unicode + int numChars) /* Number of characters in the unicode * string. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj"); } TclFreeIntRep(objPtr); SetUnicodeObj(objPtr, unicode, numChars); } -static size_t +static int UnicodeLength( const Tcl_UniChar *unicode) { - size_t numChars = 0; + int numChars = 0; if (unicode) { - while ((numChars != TCL_AUTO_LENGTH) && (unicode[numChars] != 0)) { + while (numChars >= 0 && unicode[numChars] != 0) { numChars++; } } + stringCheckLimits(numChars); return numChars; } static void SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - size_t numChars) /* Number of characters in the unicode + int numChars) /* Number of characters in the unicode * string. */ { String *stringPtr; - if (numChars == TCL_AUTO_LENGTH) { + if (numChars < 0) { numChars = UnicodeLength(unicode); } /* * Allocate enough space for the String structure + Unicode string. */ + stringCheckLimits(numChars); stringPtr = stringAlloc(numChars); SET_STRING(objPtr, stringPtr); objPtr->typePtr = &tclStringType; stringPtr->maxChars = numChars; @@ -1071,53 +1138,61 @@ void Tcl_AppendLimitedToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - size_t length, /* The number of bytes available to be - * appended from "bytes". If -1, then - * all bytes up to a NUL byte are available. */ - size_t limit, /* The maximum number of bytes to append to + int length, /* The number of bytes available to be + * appended from "bytes". If < 0, then all + * bytes up to a NUL byte are available. */ + int limit, /* The maximum number of bytes to append to * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { String *stringPtr; - size_t toCopy = 0; + int toCopy = 0; + int eLen = 0; - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); - } - - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { return; + } + if (limit <= 0) { + return; } if (length <= limit) { toCopy = length; } else { if (ellipsis == NULL) { ellipsis = "..."; } - toCopy = (bytes == NULL) ? limit - : (size_t)(Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes); + eLen = strlen(ellipsis); + while (eLen > limit) { + eLen = TclUtfPrev(ellipsis+eLen, ellipsis) - ellipsis; + } + + toCopy = TclUtfPrev(bytes+limit+1-eLen, bytes) - bytes; } /* * If objPtr has a valid Unicode rep, then append the Unicode conversion * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to * objPtr's string rep. */ + + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); + } SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { + if (stringPtr->hasUnicode && stringPtr->numChars > 0) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); } @@ -1124,14 +1199,14 @@ if (length <= limit) { return; } stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { - AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis)); + if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + AppendUtfToUnicodeRep(objPtr, ellipsis, eLen); } else { - AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis)); + AppendUtfToUtfRep(objPtr, ellipsis, eLen); } } /* *---------------------------------------------------------------------- @@ -1153,15 +1228,15 @@ void Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - size_t length) /* The number of bytes to append from "bytes". - * If -1, then append all bytes up to NUL + int length) /* The number of bytes to append from "bytes". + * If < 0, then append all bytes up to NUL * byte. */ { - Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_AUTO_LENGTH, NULL); + Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); } /* *---------------------------------------------------------------------- * @@ -1182,11 +1257,11 @@ void Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ - size_t length) /* Number of chars in "unicode". */ + int length) /* Number of chars in "unicode". */ { String *stringPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); @@ -1236,12 +1311,11 @@ Tcl_AppendObjToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; - size_t length = 0, numChars; - size_t appendNumChars = TCL_AUTO_LENGTH; + int length, numChars, appendNumChars = -1; const char *bytes; /* * Special case: second object is standard-empty is fast case. We know * that appending nothing to anything leaves that starting anything... @@ -1261,11 +1335,11 @@ if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) && TclIsPureByteArray(appendObjPtr)) { /* * You might expect the code here to be * - * bytes = TclGetByteArrayFromObj(appendObjPtr, &length); + * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); * * and essentially all of the time that would be fine. However, it * would run into trouble in the case where objPtr and appendObjPtr * point to the same thing. That may never be a good idea. It seems to @@ -1277,14 +1351,14 @@ * cases. * * First, get the lengths. */ - size_t lengthSrc = 0; + int lengthSrc; - (void) TclGetByteArrayFromObj(objPtr, &length); - (void) TclGetByteArrayFromObj(appendObjPtr, &lengthSrc); + (void) Tcl_GetByteArrayFromObj(objPtr, &length); + (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); /* * Grow buffer enough for the append. */ @@ -1323,11 +1397,11 @@ * If appendObjPtr is not of the "String" type, don't convert it. */ if (TclHasIntRep(appendObjPtr, &tclStringType)) { Tcl_UniChar *unicode = - TclGetUnicodeFromObj(appendObjPtr, &numChars); + Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { bytes = TclGetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); @@ -1342,19 +1416,19 @@ */ bytes = TclGetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; - if ((numChars != TCL_AUTO_LENGTH) && TclHasIntRep(appendObjPtr, &tclStringType)) { + if ((numChars >= 0) && TclHasIntRep(appendObjPtr, &tclStringType)) { String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; } AppendUtfToUtfRep(objPtr, bytes, length); - if ((numChars != TCL_AUTO_LENGTH) && (appendNumChars != TCL_AUTO_LENGTH)) { + if (numChars >= 0 && appendNumChars >= 0) { stringPtr->numChars = numChars + appendNumChars; } } /* @@ -1376,16 +1450,16 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - size_t appendNumChars) /* Number of chars of "unicode" to append. */ + int appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; - size_t numChars; + int numChars; - if (appendNumChars == TCL_AUTO_LENGTH) { + if (appendNumChars < 0) { appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { return; } @@ -1400,34 +1474,35 @@ * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an * explanation of this growth algorithm. */ numChars = stringPtr->numChars + appendNumChars; + stringCheckLimits(numChars); if (numChars > stringPtr->maxChars) { - size_t index = TCL_INDEX_NONE; + int offset = -1; /* * Protect against case where unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations due to * the reallocs below. */ if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { - index = unicode - stringPtr->unicode; + offset = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); stringPtr = GET_STRING(objPtr); /* * Relocate unicode if needed; see above. */ - if (index != TCL_INDEX_NONE) { - unicode = stringPtr->unicode + index; + if (offset >= 0) { + unicode = stringPtr->unicode + offset; } } /* * Copy the new string onto the end of the old string, then add the @@ -1464,17 +1539,17 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - size_t numChars) /* Number of chars of "unicode" to convert. */ + int numChars) /* Number of chars of "unicode" to convert. */ { String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != TCL_AUTO_LENGTH) { + if (stringPtr->numChars != -1) { stringPtr->numChars += numChars; } } /* @@ -1497,11 +1572,11 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - size_t numBytes) /* Number of bytes of "bytes" to convert. */ + int numBytes) /* Number of bytes of "bytes" to convert. */ { String *stringPtr; if (numBytes == 0) { return; @@ -1533,14 +1608,14 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - size_t numBytes) /* Number of bytes of "bytes" to append. */ + int numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; - size_t newLength, oldLength; + int newLength, oldLength; if (numBytes == 0) { return; } @@ -1552,14 +1627,17 @@ if (objPtr->bytes == NULL) { objPtr->length = 0; } oldLength = objPtr->length; newLength = numBytes + oldLength; + if (newLength < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { - size_t offset = TCL_AUTO_LENGTH; + int offset = -1; /* * Protect against case where unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations due to * the reallocs below. @@ -1579,28 +1657,65 @@ /* * Relocate bytes if needed; see above. */ - if (offset != TCL_AUTO_LENGTH) { + if (offset >= 0) { bytes = objPtr->bytes + offset; } } /* * Invalidate the unicode data. */ - stringPtr->numChars = TCL_AUTO_LENGTH; + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; if (bytes) { memmove(objPtr->bytes + oldLength, bytes, numBytes); } objPtr->bytes[newLength] = 0; objPtr->length = newLength; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendStringsToObjVA -- + * + * This function appends one or more null-terminated strings to an + * object. + * + * Results: + * None. + * + * Side effects: + * The contents of all the string arguments are appended to the string + * representation of objPtr. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AppendStringsToObjVA( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + va_list argList) /* Variable argument list. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); + } + + while (1) { + const char *bytes = va_arg(argList, char *); + + if (bytes == NULL) { + break; + } + Tcl_AppendToObj(objPtr, bytes, -1); + } +} /* *---------------------------------------------------------------------- * * Tcl_AppendStringsToObj -- @@ -1624,22 +1739,11 @@ ...) { va_list argList; va_start(argList, objPtr); - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); - } - - while (1) { - const char *bytes = va_arg(argList, char *); - - if (bytes == NULL) { - break; - } - Tcl_AppendToObj(objPtr, bytes, -1); - } + Tcl_AppendStringsToObjVA(objPtr, argList); va_end(argList); } /* *---------------------------------------------------------------------- @@ -1668,12 +1772,12 @@ const char *format, int objc, Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; - int objIndex = 0, gotXpg = 0, gotSequential = 0; - size_t originalLength, limit, numBytes = 0; + int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; + int originalLength, limit; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; static const char *const badIndex[2] = { "not enough arguments for all format specifiers", @@ -1682,12 +1786,12 @@ static const char *overflow = "max size for a Tcl value exceeded"; if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } - (void)TclGetStringFromObj(appendObj, &originalLength); - limit = (size_t)INT_MAX - originalLength; + TclGetStringFromObj(appendObj, &originalLength); + limit = INT_MAX - originalLength; /* * Format string is NUL-terminated. */ @@ -1696,12 +1800,11 @@ int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif - int newXpg, numChars, allocSegment = 0, segmentLimit; - size_t segmentNumBytes; + int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); format += step; if (ch != '%') { @@ -1829,11 +1932,11 @@ } objIndex++; format += step; step = TclUtfToUniChar(format, &ch); } - if (width > (int) limit) { + if (width > limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } @@ -1960,10 +2063,11 @@ allocSegment = 1; break; } case 'u': + /* FALLTHRU */ case 'd': case 'o': case 'p': case 'x': case 'X': @@ -2054,16 +2158,24 @@ break; case 'b': Tcl_AppendToObj(segment, "0b", 2); segmentLimit -= 2; break; +#if TCL_MAJOR_VERSION < 9 + case 'd': + if (gotZero) { + Tcl_AppendToObj(segment, "0d", 2); + segmentLimit -= 2; + } + break; +#endif } } switch (ch) { case 'd': { - size_t length; + int length; Tcl_Obj *pure; const char *bytes; if (useShort) { pure = Tcl_NewWideIntObj(s); @@ -2094,25 +2206,25 @@ * entirely of one-byte encoded characters, so "length" is the * number of chars. */ if (gotPrecision) { - if (length < (size_t)precision) { + if (length < precision) { segmentLimit -= precision - length; } - while (length < (size_t)precision) { + while (length < precision) { Tcl_AppendToObj(segment, "0", 1); length++; } gotZero = 0; } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < (size_t)width) { + if (length < width) { segmentLimit -= width - length; } - while (length < (size_t)width) { + while (length < width) { Tcl_AppendToObj(segment, "0", 1); length++; } } if (toAppend > segmentLimit) { @@ -2129,14 +2241,13 @@ case 'o': case 'p': case 'x': case 'X': case 'b': { - Tcl_WideUInt bits = 0; - Tcl_WideInt numDigits = 0; - int numBits = 4, base = 16, index = 0, shift = 0; - size_t length; + Tcl_WideUInt bits = (Tcl_WideUInt) 0; + Tcl_WideInt numDigits = (Tcl_WideInt) 0; + int length, numBits = 4, base = 16, index = 0, shift = 0; Tcl_Obj *pure; char *bytes; if (ch == 'u') { base = 10; @@ -2163,11 +2274,11 @@ while (uw) { numDigits++; uw /= base; } #endif - } else if (useBig && big.used) { + } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); numDigits = 1 + (((Tcl_WideInt) big.used * MP_DIGIT_BIT) / numBits); @@ -2196,25 +2307,25 @@ if (numDigits == 0) { numDigits = 1; } pure = Tcl_NewObj(); - Tcl_SetObjLength(pure, numDigits); + Tcl_SetObjLength(pure, (int) numDigits); bytes = TclGetString(pure); - toAppend = length = numDigits; + toAppend = length = (int) numDigits; while (numDigits--) { int digitOffset; - if (useBig && big.used) { + if (useBig && !mp_iszero(&big)) { if (index < big.used && (size_t) shift < CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) { bits |= ((Tcl_WideUInt) big.dp[index++]) << shift; shift += MP_DIGIT_BIT; } shift -= numBits; } - digitOffset = bits % base; + digitOffset = (int) (bits % base); if (digitOffset > 9) { if (ch == 'X') { bytes[numDigits] = 'A' + digitOffset - 10; } else { bytes[numDigits] = 'a' + digitOffset - 10; @@ -2226,25 +2337,25 @@ } if (useBig) { mp_clear(&big); } if (gotPrecision) { - if (length < (size_t)precision) { + if (length < precision) { segmentLimit -= precision - length; } - while (length < (size_t)precision) { + while (length < precision) { Tcl_AppendToObj(segment, "0", 1); length++; } gotZero = 0; } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < (size_t)width) { + if (length < width) { segmentLimit -= width - length; } - while (length < (size_t)width) { + while (length < width) { Tcl_AppendToObj(segment, "0", 1); length++; } } if (toAppend > segmentLimit) { @@ -2359,11 +2470,11 @@ Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); numChars++; } } - (void)TclGetStringFromObj(segment, &segmentNumBytes); + TclGetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); } msg = overflow; @@ -2501,23 +2612,23 @@ * Within that buffer, we trim both ends if needed so that we * copy only whole characters, and avoid copying any partial * multi-byte characters. */ - q = Tcl_UtfPrev(end, bytes); - if (!Tcl_UtfCharComplete(q, (end - q))) { + q = TclUtfPrev(end, bytes); + if (!Tcl_UtfCharComplete(q, (int)(end - q))) { end = q; } - q = bytes + TCL_UTF_MAX; + q = bytes + 4; while ((bytes < end) && (bytes < q) && ((*bytes & 0xC0) == 0x80)) { bytes++; } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes , (end - bytes))); + Tcl_NewStringObj(bytes , (int)(end - bytes))); break; } case 'c': case 'i': @@ -2563,19 +2674,19 @@ va_arg(argList, double))); } seekingConversion = 0; break; case '*': - lastNum = va_arg(argList, int); + lastNum = (int) va_arg(argList, int); Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum)); p++; break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { char *end; - lastNum = strtoul(p, &end, 10); + lastNum = (int) strtoul(p, &end, 10); p = end; break; } case '.': gotPrecision = 1; @@ -2612,10 +2723,11 @@ size = 3; p++; break; case 'h': size = -1; + /* FALLTHRU */ default: p++; } } while (seekingConversion); } @@ -2622,11 +2734,11 @@ TclListObjGetElements(NULL, list, &objc, &objv); code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); if (code != TCL_OK) { Tcl_AppendPrintfToObj(objPtr, "Unable to format \"%s\" with supplied arguments: %s", - format, TclGetString(list)); + format, Tcl_GetString(list)); } Tcl_DecrRefCount(list); } /* @@ -2702,16 +2814,16 @@ */ char * TclGetStringStorage( Tcl_Obj *objPtr, - size_t *sizePtr) + unsigned int *sizePtr) { String *stringPtr; if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) { - return TclGetStringFromObj(objPtr, sizePtr); + return TclGetStringFromObj(objPtr, (int *)sizePtr); } stringPtr = GET_STRING(objPtr); *sizePtr = stringPtr->allocated; return objPtr->bytes; @@ -2736,16 +2848,16 @@ Tcl_Obj * TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t count, + int count, int flags) { Tcl_Obj *objResultPtr; int inPlace = flags & TCL_STRING_IN_PLACE; - size_t length = 0, unichar = 0, done = 1; + int length = 0, unichar = 0, done = 1; int binary = TclIsPureByteArray(objPtr); /* assert (count >= 2) */ /* @@ -2764,17 +2876,17 @@ } } if (binary) { /* Result will be pure byte array. Pre-size it */ - (void)TclGetByteArrayFromObj(objPtr, &length); + Tcl_GetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ - (void)TclGetUnicodeFromObj(objPtr, &length); + Tcl_GetUnicodeFromObj(objPtr, &length); } else { /* Result will be concat of string reps. Pre-size it. */ - (void)TclGetStringFromObj(objPtr, &length); + Tcl_GetStringFromObj(objPtr, &length); } if (length == 0) { /* Any repeats of empty is empty. */ return objPtr; @@ -2836,19 +2948,19 @@ /* * Efficiently concatenate string reps. */ if (!inPlace || Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewStringObj(TclGetString(objPtr), length); + objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length); } else { TclFreeIntRep(objPtr); objResultPtr = objPtr; } if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes", + "string size overflow: unable to alloc %u bytes", count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } @@ -2855,11 +2967,11 @@ Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr), + Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr), (count - done) * length); } return objResultPtr; } @@ -2886,12 +2998,11 @@ int objc, Tcl_Obj * const objv[], int flags) { Tcl_Obj *objResultPtr, * const *ov; - int oc, binary = 1; - size_t length = 0; + int oc, length = 0, binary = 1; int allowUniChar = 1, requestUniChar = 0; int first = objc - 1; /* Index of first value possibly not empty */ int last = 0; /* Index of last value possibly not empty */ int inPlace = flags & TCL_STRING_IN_PLACE; @@ -2947,11 +3058,11 @@ if (binary) { /* * Result will be pure byte array. Pre-size it */ - size_t numBytes = 0; + int numBytes; ov = objv; oc = objc; do { Tcl_Obj *objPtr = *ov++; @@ -2960,16 +3071,18 @@ * value we know we can safely use, or it is an empty string. * We don't need to count bytes for the empty strings. */ if (TclIsPureByteArray(objPtr)) { - (void)TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ + Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (numBytes) { last = objc - oc; if (length == 0) { first = last; + } else if (numBytes > INT_MAX - length) { + goto overflow; } length += numBytes; } } } while (--oc); @@ -2982,17 +3095,19 @@ oc = objc; do { Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - size_t numChars; + int numChars; - (void)TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ + Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { last = objc - oc; if (length == 0) { first = last; + } else if (numChars > INT_MAX - length) { + goto overflow; } length += numChars; } } } while (--oc); @@ -3015,11 +3130,11 @@ if (objPtr->bytes == NULL) { /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { - (void)TclGetStringFromObj(objPtr, &length); /* PANIC? */ + Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ } } while (--oc && (length == 0) && (pendingPtr == NULL)); /* * Either we found a possibly non-empty value, and we remember @@ -3029,11 +3144,11 @@ */ first = last = objc - oc - 1; if (oc && (length == 0)) { - size_t numBytes; + int numBytes; /* assert ( pendingPtr != NULL ) */ /* * There's a pending value followed by more values. Loop over @@ -3041,41 +3156,40 @@ * is found, or the pending value gets its string generated. */ do { Tcl_Obj *objPtr = *ov++; - (void)TclGetStringFromObj(objPtr, &numBytes); /* PANIC? */ + Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ } while (--oc && numBytes == 0 && pendingPtr->bytes == NULL); if (numBytes) { last = objc -oc -1; } if (oc || numBytes) { - (void)TclGetStringFromObj(pendingPtr, &length); + Tcl_GetStringFromObj(pendingPtr, &length); } if (length == 0) { if (numBytes) { first = last; } - } else if (numBytes + length > (size_t)INT_MAX) { + } else if (numBytes > INT_MAX - length) { goto overflow; } length += numBytes; } } while (oc && (length == 0)); while (oc) { - size_t numBytes; + int numBytes; Tcl_Obj *objPtr = *ov++; /* assert ( length > 0 && pendingPtr == NULL ) */ - TclGetString(objPtr); /* PANIC? */ - numBytes = objPtr->length; + Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ if (numBytes) { last = objc - oc; - if (numBytes + length > (size_t)INT_MAX) { + if (numBytes > INT_MAX - length) { goto overflow; } length += numBytes; } --oc; @@ -3098,14 +3212,14 @@ * Broken interface! Byte array value routines offer no way to handle * failure to allocate enough space. Following stanza may panic. */ if (inPlace && !Tcl_IsShared(*objv)) { - size_t start = 0; + int start; objResultPtr = *objv++; objc--; - (void)TclGetByteArrayFromObj(objResultPtr, &start); + Tcl_GetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { objResultPtr = Tcl_NewByteArrayObj(NULL, length); dst = Tcl_SetByteArrayLength(objResultPtr, length); } @@ -3117,27 +3231,27 @@ * value we know we can safely use, or it is an empty string. * We don't need to copy bytes from the empty strings. */ if (TclIsPureByteArray(objPtr)) { - size_t more = 0; - unsigned char *src = TclGetByteArrayFromObj(objPtr, &more); + int more; + unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; } } } else if (allowUniChar && requestUniChar) { /* Efficiently produce a pure Tcl_UniChar array result */ Tcl_UniChar *dst; if (inPlace && !Tcl_IsShared(*objv)) { - size_t start; + int start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ - (void)TclGetUnicodeFromObj(objResultPtr, &start); + Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" @@ -3168,59 +3282,59 @@ } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - size_t more; - Tcl_UniChar *src = TclGetUnicodeFromObj(objPtr, &more); + int more; + Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; } } } else { /* Efficiently concatenate string reps */ char *dst; if (inPlace && !Tcl_IsShared(*objv)) { - size_t start; + int start; objResultPtr = *objv++; objc--; - (void)TclGetStringFromObj(objResultPtr, &start); + Tcl_GetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", + "concatenation failed: unable to alloc %u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } - dst = TclGetString(objResultPtr) + start; + dst = Tcl_GetString(objResultPtr) + start; /* assert ( length > start ) */ TclFreeIntRep(objResultPtr); } else { objResultPtr = Tcl_NewObj(); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { Tcl_DecrRefCount(objResultPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", + "concatenation failed: unable to alloc %u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } - dst = TclGetString(objResultPtr); + dst = Tcl_GetString(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - size_t more; - char *src = TclGetStringFromObj(objPtr, &more); + int more; + char *src = Tcl_GetStringFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; } } @@ -3258,15 +3372,14 @@ TclStringCmp( Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - size_t reqlength) /* requested length */ + int reqlength) /* requested length */ { char *s1, *s2; - int empty, match; - size_t length, s1len = 0, s2len = 0; + int empty, length, match, s1len, s2len; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* * Always match at 0 chars of if it is the same obj. @@ -3280,12 +3393,12 @@ * type conversions and it is much faster. Only do this if we're * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ - s1 = (char *) TclGetByteArrayFromObj(value1Ptr, &s1len); - s2 = (char *) TclGetByteArrayFromObj(value2Ptr, &s2len); + s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); + s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; } else if (TclHasIntRep(value1Ptr, &tclStringType) && TclHasIntRep(value2Ptr, &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of @@ -3293,12 +3406,12 @@ * memcmp. In benchmark testing this proved the most efficient * check between the unicode and string comparison operations. */ if (nocase) { - s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len); - s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len); + s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); + s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) @@ -3377,11 +3490,11 @@ * (\xC0\x80 in Tcl's utf rep). We can use the more efficient * TclpUtfNcmp2 if we are case-sensitive and no specific * length was requested. */ - if ((reqlength == TCL_AUTO_LENGTH) && !nocase) { + if ((reqlength < 0) && !nocase) { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); s2len = Tcl_NumUtfChars(s2, s2len); memCmpFn = (memCmpFn_t) @@ -3389,19 +3502,19 @@ } } } length = (s1len < s2len) ? s1len : s2len; - if (reqlength == TCL_AUTO_LENGTH) { + if (reqlength > 0 && reqlength < length) { + length = reqlength; + } else if (reqlength < 0) { /* * The requested length is negative, so we ignore it by setting it * to length + 1 so we correct the match var. */ reqlength = length + 1; - } else if (reqlength > 0 && reqlength < length) { - length = reqlength; } if (checkEq && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { @@ -3408,11 +3521,11 @@ /* * The comparison function should compare up to the minimum byte * length only. */ - match = memCmpFn(s1, s2, length); + match = memCmpFn(s1, s2, (size_t) length); } if ((match == 0) && (reqlength > length)) { match = s1len - s2len; } match = (match > 0) ? 1 : (match < 0) ? -1 : 0; @@ -3429,69 +3542,73 @@ * Implements the [string first] operation. * * Results: * If needle is found as a substring of haystack, the index of the * first instance of such a find is returned. If needle is not present - * as a substring of haystack, TCL_IO_FAILURE is returned. + * as a substring of haystack, -1 is returned. * * Side effects: * needle and haystack may have their Tcl_ObjType changed. * *--------------------------------------------------------------------------- */ -size_t +Tcl_Obj * TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, - size_t start) + int start) { - size_t lh = 0, ln = Tcl_GetCharLength(needle); + int lh, ln = Tcl_GetCharLength(needle); + Tcl_Obj *result; + int value = -1; + Tcl_UniChar *check, *end, *uh, *un; - if (start == TCL_AUTO_LENGTH) { + if (start < 0) { start = 0; } if (ln == 0) { /* We don't find empty substrings. Bizarre! * Whenever this routine is turned into a proper substring * finder, change to `return start` after limits imposed. */ - return TCL_IO_FAILURE; + goto firstEnd; } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *end, *try, *bh; - unsigned char *bn = TclGetByteArrayFromObj(needle, &ln); + unsigned char *end, *check, *bh; + unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); /* Find bytes in bytes */ - bh = TclGetByteArrayFromObj(haystack, &lh); + bh = Tcl_GetByteArrayFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ - return TCL_IO_FAILURE; + goto firstEnd; } end = bh + lh; - try = bh + start; - while (try + ln <= end) { + check = bh + start; + while (check + ln <= end) { /* * Look for the leading byte of the needle in the haystack - * starting at try and stopping when there's not enough room + * starting at check and stopping when there's not enough room * for the needle left. */ - try = memchr(try, bn[0], (end + 1 - ln) - try); - if (try == NULL) { + check = (unsigned char *)memchr(check, bn[0], (end + 1 - ln) - check); + if (check == NULL) { /* Leading byte not found -> needle cannot be found. */ - return TCL_IO_FAILURE; + goto firstEnd; } /* Leading byte found, check rest of needle. */ - if (0 == memcmp(try+1, bn+1, ln-1)) { + if (0 == memcmp(check+1, bn+1, ln-1)) { /* Checks! Return the successful index. */ - return (try - bh); + value = (check - bh); + goto firstEnd; } /* Rest of needle match failed; Iterate to continue search. */ - try++; + check++; } - return TCL_IO_FAILURE; + goto firstEnd; } /* * TODO: It might be nice to support some cases where it is not * necessary to shimmer to &tclStringType to compute the result, @@ -3502,29 +3619,28 @@ * locking down in practice more firmly just what encodings produce * what supported results for the objPtr->bytes values. For now, * do only the well-defined Tcl_UniChar array search. */ - { - Tcl_UniChar *try, *end, *uh; - Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln); - - uh = TclGetUnicodeFromObj(haystack, &lh); - if ((lh < ln) || (start > lh - ln)) { - /* Don't start the loop if there cannot be a valid answer */ - return TCL_IO_FAILURE; - } - end = uh + lh; - - for (try = uh + start; try + ln <= end; try++) { - if ((*try == *un) && (0 == - memcmp(try + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) { - return (try - uh); - } - } - return TCL_IO_FAILURE; - } + un = Tcl_GetUnicodeFromObj(needle, &ln); + uh = Tcl_GetUnicodeFromObj(haystack, &lh); + if ((lh < ln) || (start > lh - ln)) { + /* Don't start the loop if there cannot be a valid answer */ + goto firstEnd; + } + end = uh + lh; + + for (check = uh + start; check + ln <= end; check++) { + if ((*check == *un) && (0 == + memcmp(check + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) { + value = (check - uh); + goto firstEnd; + } + } + firstEnd: + TclNewIntObj(result, value); + return result; } /* *--------------------------------------------------------------------------- * @@ -3533,80 +3649,85 @@ * Implements the [string last] operation. * * Results: * If needle is found as a substring of haystack, the index of the * last instance of such a find is returned. If needle is not present - * as a substring of haystack, TCL_IO_FAILURE is returned. + * as a substring of haystack, -1 is returned. * * Side effects: * needle and haystack may have their Tcl_ObjType changed. * *--------------------------------------------------------------------------- */ -size_t +Tcl_Obj * TclStringLast( Tcl_Obj *needle, Tcl_Obj *haystack, - size_t last) + int last) { - size_t lh = 0, ln = Tcl_GetCharLength(needle); + int lh, ln = Tcl_GetCharLength(needle); + Tcl_Obj *result; + int value = -1; + Tcl_UniChar *check, *uh, *un; if (ln == 0) { /* * We don't find empty substrings. Bizarre! * * TODO: When we one day make this a true substring * finder, change this to "return last", after limitation. */ - return TCL_IO_FAILURE; - } - - if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *try, *bh = TclGetByteArrayFromObj(haystack, &lh); - unsigned char *bn = TclGetByteArrayFromObj(needle, &ln); - - if (last + 1 >= lh + 1) { - last = lh - 1; - } - if (last + 1 < ln) { - /* Don't start the loop if there cannot be a valid answer */ - return TCL_IO_FAILURE; - } - try = bh + last + 1 - ln; - - while (try >= bh) { - if ((*try == bn[0]) - && (0 == memcmp(try+1, bn+1, ln-1))) { - return (try - bh); - } - try--; - } - return TCL_IO_FAILURE; - } - - { - Tcl_UniChar *try, *uh = TclGetUnicodeFromObj(haystack, &lh); - Tcl_UniChar *un = TclGetUnicodeFromObj(needle, &ln); - - if (last + 1 >= lh + 1) { - last = lh - 1; - } - if (last + 1 < ln) { - /* Don't start the loop if there cannot be a valid answer */ - return TCL_IO_FAILURE; - } - try = uh + last + 1 - ln; - while (try >= uh) { - if ((*try == un[0]) - && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { - return (try - uh); - } - try--; - } - return TCL_IO_FAILURE; - } + goto lastEnd; + } + + if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { + unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); + unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + + if (last >= lh) { + last = lh - 1; + } + if (last + 1 < ln) { + /* Don't start the loop if there cannot be a valid answer */ + goto lastEnd; + } + check = bh + last + 1 - ln; + + while (check >= bh) { + if ((*check == bn[0]) + && (0 == memcmp(check+1, bn+1, ln-1))) { + value = (check - bh); + goto lastEnd; + } + check--; + } + goto lastEnd; + } + + uh = Tcl_GetUnicodeFromObj(haystack, &lh); + un = Tcl_GetUnicodeFromObj(needle, &ln); + + if (last >= lh) { + last = lh - 1; + } + if (last + 1 < ln) { + /* Don't start the loop if there cannot be a valid answer */ + goto lastEnd; + } + check = uh + last + 1 - ln; + while (check >= uh) { + if ((*check == un[0]) + && (0 == memcmp(check+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { + value = (check - uh); + goto lastEnd; + } + check--; + } + lastEnd: + TclNewIntObj(result, value); + return result; } /* *--------------------------------------------------------------------------- * @@ -3627,11 +3748,11 @@ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ - size_t count) /* Until this many are copied, */ + int count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; if (to == from) { @@ -3657,12 +3778,12 @@ String *stringPtr; Tcl_UniChar ch = 0; int inPlace = flags & TCL_STRING_IN_PLACE; if (TclIsPureByteArray(objPtr)) { - size_t numBytes = 0; - unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes); + int numBytes; + unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes); @@ -3702,41 +3823,41 @@ } } } if (objPtr->bytes) { - size_t numChars = stringPtr->numChars; - size_t numBytes = objPtr->length; + int numChars = stringPtr->numChars; + int numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewObj(); Tcl_SetObjLength(objPtr, numBytes); } to = objPtr->bytes; - if ((numChars == TCL_AUTO_LENGTH) || (numChars < numBytes)) { + if (numChars < numBytes) { /* * Either numChars == -1 and we don't know how many chars are * represented by objPtr->bytes and we need Pass 1 just in case, * or numChars >= 0 and we know we have fewer chars than bytes, so * we know there's a multibyte character needing Pass 1. * * Pass 1. Reverse the bytes of each multi-byte character. */ - size_t charCount = 0; - size_t bytesLeft = numBytes; + int charCount = 0; + int bytesLeft = numBytes; while (bytesLeft) { /* * NOTE: We know that the from buffer is NUL-terminated. It's * part of the contract for objPtr->bytes values. Thus, we can * skip calling Tcl_UtfCharComplete() here. */ - size_t bytesInChar = TclUtfToUniChar(from, &ch); + int bytesInChar = TclUtfToUniChar(from, &ch); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); to += bytesInChar; from += bytesInChar; @@ -3782,17 +3903,21 @@ Tcl_Obj * TclStringReplace( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* String to act upon */ - size_t first, /* First index to replace */ - size_t count, /* How many chars to replace */ + int first, /* First index to replace */ + int count, /* How many chars to replace */ Tcl_Obj *insertPtr, /* Replacement string, may be NULL */ int flags) /* TCL_STRING_IN_PLACE => attempt in-place */ { int inPlace = flags & TCL_STRING_IN_PLACE; Tcl_Obj *result; + + /* Caller is expected to pass sensible arguments */ + assert ( count >= 0 ) ; + assert ( first >= 0 ) ; /* Replace nothing with nothing */ if ((insertPtr == NULL) && (count == 0)) { if (inPlace) { return objPtr; @@ -3807,12 +3932,12 @@ * objPtr is either a proper "bytearray" or a "string" or else it has * a known and short string rep. */ if (TclIsPureByteArray(objPtr)) { - size_t numBytes = 0; - unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &numBytes); + int numBytes; + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { /* Replace something with nothing. */ assert ( first <= numBytes ) ; @@ -3830,13 +3955,13 @@ if ((first == 0) && (count == numBytes)) { return insertPtr; } if (TclIsPureByteArray(insertPtr)) { - size_t newBytes = 0; + int newBytes; unsigned char *iBytes - = TclGetByteArrayFromObj(insertPtr, &newBytes); + = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) { /* * Removal count and replacement count are equal. * Other conditions permit. Do in-place splice. @@ -3845,11 +3970,11 @@ memcpy(bytes + first, iBytes, count); Tcl_InvalidateStringRep(objPtr); return objPtr; } - if ((size_t)newBytes > INT_MAX - (numBytes - count)) { + if (newBytes > INT_MAX - (numBytes - count)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); @@ -3875,20 +4000,20 @@ * all single-byte characters so we can index it directly. */ /* The traditional implementation... */ { - size_t numChars; - Tcl_UniChar *ustring = TclGetUnicodeFromObj(objPtr, &numChars); + int numChars; + Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ result = Tcl_NewUnicodeObj(ustring, first); if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } - if (first + count < (size_t)numChars) { + if (first + count < numChars) { Tcl_AppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } return result; @@ -3925,24 +4050,25 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - size_t numBytes, - size_t numAppendChars) + int numBytes, + int numAppendChars) { String *stringPtr = GET_STRING(objPtr); - size_t needed, numOrigChars = 0; + int needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == TCL_AUTO_LENGTH) { + if (numAppendChars == -1) { TclNumUtfChars(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; + stringCheckLimits(needed); if (needed > stringPtr->maxChars) { GrowUnicodeBuffer(objPtr, needed); stringPtr = GET_STRING(objPtr); } @@ -3986,11 +4112,11 @@ * currently have an internal rep.*/ { String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; - if (srcStringPtr->numChars == TCL_AUTO_LENGTH) { + if (srcStringPtr->numChars == -1) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to * copy it. Just let the copy be untyped. */ @@ -4052,11 +4178,11 @@ *---------------------------------------------------------------------- */ static int SetStringFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) /* The object to convert. */ { if (!TclHasIntRep(objPtr, &tclStringType)) { String *stringPtr = stringAlloc(0); @@ -4122,25 +4248,25 @@ (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode, stringPtr->numChars); } } -static size_t +static int ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - size_t numChars) + int numChars) { /* * Pre-condition: this is the "string" Tcl_ObjType. */ - size_t i, origLength, size = 0; + int i, origLength, size = 0; char *dst; String *stringPtr = GET_STRING(objPtr); - if (numChars == TCL_AUTO_LENGTH) { + if (numChars < 0) { numChars = UnicodeLength(unicode); } if (numChars == 0) { return 0; @@ -4158,13 +4284,16 @@ if (numChars <= (INT_MAX - size)/TCL_UTF_MAX && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) { goto copyBytes; } - for (i = 0; i < numChars; i++) { + for (i = 0; i < numChars && size >= 0; i++) { size += TclUtfCount(unicode[i]); } + if (size < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } /* * Grow space if needed. */ @@ -4201,11 +4330,11 @@ static void FreeStringInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - Tcl_Free(GET_STRING(objPtr)); + ckfree(GET_STRING(objPtr)); objPtr->typePtr = NULL; } /* * Local Variables: Index: generic/tclStringRep.h ================================================================== --- generic/tclStringRep.h +++ generic/tclStringRep.h @@ -29,14 +29,10 @@ * Copyright (c) 1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ - -#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 * the Unicode and UTF string to enable growing and shrinking of the UTF and @@ -49,46 +45,54 @@ * can be officially modified by altering the definition of Tcl_UniChar in * tcl.h, but do not do that unless you are sure what you're doing! */ typedef struct { - size_t numChars; /* The number of chars in the string. -1 means - * this value has not been calculated. Any other + int numChars; /* The number of chars in the string. -1 means + * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or * that the number of UTF bytes == the number * of chars. */ - size_t allocated; /* The amount of space actually allocated for + int allocated; /* The amount of space actually allocated for * the UTF string (minus 1 byte for the * termination char). */ - size_t maxChars; /* Max number of chars that can fit in the + int maxChars; /* Max number of chars that can fit in the * space allocated for the unicode array. */ int hasUnicode; /* Boolean determining whether the string has * a Unicode representation. */ Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size * of this field depends on the 'maxChars' * field above. */ } String; +#define STRING_MAXCHARS \ + (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) #define STRING_SIZE(numChars) \ (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar))) +#define stringCheckLimits(numChars) \ + do { \ + if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ + Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ + (int)STRING_MAXCHARS); \ + } \ + } while (0) #define stringAttemptAlloc(numChars) \ - (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars)) + (String *) attemptckalloc(STRING_SIZE(numChars)) #define stringAlloc(numChars) \ - (String *) Tcl_Alloc(STRING_SIZE(numChars)) + (String *) ckalloc(STRING_SIZE(numChars)) #define stringRealloc(ptr, numChars) \ - (String *) Tcl_Realloc((ptr), STRING_SIZE(numChars)) + (String *) ckrealloc((ptr), STRING_SIZE(numChars)) #define stringAttemptRealloc(ptr, numChars) \ - (String *) Tcl_AttemptRealloc((ptr), STRING_SIZE(numChars)) + (String *) attemptckrealloc((ptr), STRING_SIZE(numChars)) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) -#endif /* _TCLSTRINGREP */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclStringTrim.h ================================================================== --- generic/tclStringTrim.h +++ generic/tclStringTrim.h @@ -26,10 +26,12 @@ MODULE_SCOPE const char tclDefaultTrimSet[]; /* * The whitespace trimming set used when [concat]enating. This is a subset of * the above, and deliberately so. + * + * TODO: Find a reasonable way to guarantee in sync with TclIsSpaceProc() */ #define CONCAT_TRIM_SET " \f\v\r\t\n" #endif /* TCL_STRING_TRIM_H */ Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -8,11 +8,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tommath_private.h" +#include "tclTomMath.h" #ifdef __CYGWIN__ # include #endif @@ -27,64 +28,404 @@ */ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc +#undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj +#undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode +#undef Tcl_GetUnicodeFromObj +#undef Tcl_AppendUnicodeToObj +#undef Tcl_NewUnicodeObj +#undef Tcl_SetUnicodeObj +#undef Tcl_UniCharNcasecmp +#undef Tcl_UniCharCaseMatch +#undef Tcl_UniCharLen +#undef Tcl_UniCharNcmp #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory +#undef Tcl_FindHashEntry +#undef Tcl_CreateHashEntry +#undef Tcl_Panic +#undef Tcl_FindExecutable #undef Tcl_SetExitProc #undef Tcl_SetPanicProc #undef TclpGetPid +#undef TclSockMinimumBuffers +#undef Tcl_SetIntObj +#undef Tcl_SetLongObj +#undef TclpInetNtoa +#undef TclWinGetServByName +#undef TclWinGetSockOpt +#undef TclWinSetSockOpt +#undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage - -#ifdef TCL_MEM_DEBUG -# define Tcl_Alloc TclpAlloc -# define Tcl_Free TclpFree -# define Tcl_Realloc TclpRealloc -# undef Tcl_AttemptAlloc -# define Tcl_AttemptAlloc TclpAlloc -# undef Tcl_AttemptRealloc -# define Tcl_AttemptRealloc TclpRealloc +#undef Tcl_UniCharToUtfDString +#undef Tcl_UtfToUniCharDString +#undef Tcl_UtfToUniChar +#undef Tcl_MacOSXOpenBundleResources + +#if TCL_UTF_MAX > 3 +static void uniCodePanic(void) { + Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX); +} +# define Tcl_GetUnicode (int *(*)(Tcl_Obj *))(void *)uniCodePanic +# define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *))(void *)uniCodePanic +# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar))(void *)uniCodePanic +# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic +# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic +# define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic +# define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int))(void *)uniCodePanic +# define Tcl_UniCharLen (int(*)(const Tcl_UniChar *))(void *)uniCodePanic +# define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic +#endif + +#define TclBN_mp_add mp_add +#define TclBN_mp_and mp_and +#define TclBN_mp_clamp mp_clamp +#define TclBN_mp_clear mp_clear +#define TclBN_mp_clear_multi mp_clear_multi +#define TclBN_mp_cmp mp_cmp +#define TclBN_mp_cmp_mag mp_cmp_mag +#define TclBN_mp_cnt_lsb mp_cnt_lsb +#define TclBN_mp_copy mp_copy +#define TclBN_mp_count_bits mp_count_bits +#define TclBN_mp_div mp_div +#define TclBN_mp_div_2 mp_div_2 +#define TclBN_mp_div_2d mp_div_2d +#define TclBN_mp_exch mp_exch +#define TclBN_mp_get_mag_u64 mp_get_mag_u64 +#define TclBN_mp_grow mp_grow +#define TclBN_mp_init mp_init +#define TclBN_mp_init_copy mp_init_copy +#define TclBN_mp_init_multi mp_init_multi +#define TclBN_mp_init_size mp_init_size +#define TclBN_mp_init_i64 mp_init_i64 +#define TclBN_mp_init_u64 mp_init_u64 +#define TclBN_mp_lshd mp_lshd +#define TclBN_mp_mod mp_mod +#define TclBN_mp_mod_2d mp_mod_2d +#define TclBN_mp_mul mp_mul +#define TclBN_mp_mul_2 mp_mul_2 +#define TclBN_mp_mul_2d mp_mul_2d +#define TclBN_mp_neg mp_neg +#define TclBN_mp_or mp_or +#define TclBN_mp_radix_size mp_radix_size +#define TclBN_mp_reverse mp_reverse +#define TclBN_mp_read_radix mp_read_radix +#define TclBN_mp_rshd mp_rshd +#define TclBN_mp_set_i64 mp_set_i64 +#define TclBN_mp_set_u64 mp_set_u64 +#define TclBN_mp_shrink mp_shrink +#define TclBN_mp_sqr mp_sqr +#define TclBN_mp_sqrt mp_sqrt +#define TclBN_mp_sub mp_sub +#define TclBN_mp_signed_rsh mp_signed_rsh +#define TclBN_mp_tc_and TclBN_mp_and +#define TclBN_mp_tc_div_2d mp_signed_rsh +#define TclBN_mp_tc_or TclBN_mp_or +#define TclBN_mp_tc_xor TclBN_mp_xor +#define TclBN_mp_to_radix mp_to_radix +#define TclBN_mp_to_ubin mp_to_ubin +#define TclBN_mp_ubin_size mp_ubin_size +#define TclBN_mp_xor mp_xor +#define TclBN_mp_zero mp_zero +#define TclBN_s_mp_add s_mp_add +#define TclBN_s_mp_balance_mul mp_balance_mul +#define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul +#define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr +#define TclBN_s_mp_mul_digs s_mp_mul_digs +#define TclBN_s_mp_mul_digs_fast s_mp_mul_digs_fast +#define TclBN_s_mp_reverse s_mp_reverse +#define TclBN_s_mp_sqr s_mp_sqr +#define TclBN_s_mp_sqr_fast s_mp_sqr_fast +#define TclBN_s_mp_sub s_mp_sub +#define TclBN_mp_toom_mul s_mp_toom_mul +#define TclBN_mp_toom_sqr s_mp_toom_sqr +#define TclUnusedStubEntry NULL + +/* See bug 510001: TclSockMinimumBuffers needs plat imp */ +#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 +# define TclSockMinimumBuffersOld 0 +#else +#define TclSockMinimumBuffersOld sockMinimumBuffersOld +static int TclSockMinimumBuffersOld(int sock, int size) +{ + return TclSockMinimumBuffers(INT2PTR(sock), size); +} +#endif + +mp_err TclBN_mp_set_int(mp_int *a, unsigned long i) +{ + TclBN_mp_set_u64(a, i); + return MP_OKAY; +} + +static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i) +{ + TclBN_mp_set_u64(a, i); + return MP_OKAY; +} + +#define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))(void *)TclBN_mp_set_long + +mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) { + return mp_expt_u32(a, b, c); +} +mp_err TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) { + return mp_add_d(a, b, c); +} +mp_err TclBN_mp_cmp_d(const mp_int *a, unsigned int b) { + return mp_cmp_d(a, b); +} +mp_err TclBN_mp_sub_d(const mp_int *a, unsigned int b, mp_int *c) { + return mp_sub_d(a, b, c); +} +mp_err TclBN_mp_div_d(const mp_int *a, unsigned int b, mp_int *c, unsigned int *d) { + mp_digit d2; + mp_err result = mp_div_d(a, b, c, (d ? &d2 : NULL)); + if (d) { + *d = d2; + } + return result; +} +mp_err TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *c, uint64_t *d) { + mp_err result; + mp_digit d2; + + if ((b | (mp_digit)-1) != (mp_digit)-1) { + return MP_VAL; + } + result = mp_div_d(a, b, c, (d ? &d2 : NULL)); + if (d) { + *d = d2; + } + return result; +} +mp_err TclBN_mp_init_set(mp_int *a, unsigned int b) { + return mp_init_set(a, b); +} +mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) { + return mp_mul_d(a, b, c); +} + +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 +# define TclBN_mp_expt_d_ex 0 +# define TclBN_mp_to_unsigned_bin 0 +# define TclBN_mp_to_unsigned_bin_n 0 +# define TclBN_mp_toradix_n 0 +# undef TclBN_mp_sqr +# define TclBN_mp_sqr 0 +# undef TclBN_mp_div_3 +# define TclBN_mp_div_3 0 +# define TclBN_mp_init_l 0 +# define TclBN_mp_init_ul 0 +# define TclBN_mp_set 0 +# define TclSetStartupScriptPath 0 +# define TclGetStartupScriptPath 0 +# define TclSetStartupScriptFileName 0 +# define TclGetStartupScriptFileName 0 +# define TclPrecTraceProc 0 +# define TclpInetNtoa 0 +# define TclWinGetServByName 0 +# define TclWinGetSockOpt 0 +# define TclWinSetSockOpt 0 +# define TclWinNToHS 0 +# define TclWinGetPlatformId 0 +# define TclWinResetInterfaces 0 +# define TclWinSetInterfaces 0 +# define TclWinGetPlatformId 0 +# define Tcl_Backslash 0 +# define Tcl_GetDefaultEncodingDir 0 +# define Tcl_SetDefaultEncodingDir 0 +# define Tcl_EvalTokens 0 +# define Tcl_CreateMathFunc 0 +# define Tcl_GetMathFuncInfo 0 +# define Tcl_ListMathFuncs 0 +# define Tcl_SetIntObj 0 +# define Tcl_SetLongObj 0 +# define Tcl_NewIntObj 0 +# define Tcl_NewLongObj 0 +# define Tcl_DbNewLongObj 0 +# define Tcl_BackgroundError 0 +# define Tcl_FreeResult 0 +# define Tcl_ChannelSeekProc 0 +# define Tcl_ChannelCloseProc 0 +# define Tcl_Close 0 +# define Tcl_MacOSXOpenBundleResources 0 +#else + +mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) { + mp_digit d2; + mp_err result = mp_div_d(a, 3, c, &d2); + if (d) { + *d = d2; + } + return result; +} + +int TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, + TCL_UNUSED(int) /*fast*/) +{ + return TclBN_mp_expt_u32(a, b, c); +} + +mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) +{ + return TclBN_mp_to_ubin(a, b, INT_MAX, NULL); +} + +mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) +{ + size_t n = TclBN_mp_ubin_size(a); + if (*outlen < (unsigned long)n) { + return MP_VAL; + } + *outlen = (unsigned long)n; + return TclBN_mp_to_ubin(a, b, n, NULL); +} + +void TclBN_reverse(unsigned char *s, int len) +{ + if (len > 0) { + TclBN_s_mp_reverse(s, (size_t)len); + } +} + +mp_err TclBN_mp_init_ul(mp_int *a, unsigned long b) +{ + return TclBN_mp_init_u64(a,b); +} + +mp_err TclBN_mp_init_l(mp_int *a, long b) +{ + return TclBN_mp_init_i64(a,b); +} + +void TclBN_mp_set(mp_int *a, unsigned int b) { + TclBN_mp_set_u64(a, b); +} + +mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) +{ + if (maxlen < 0) { + return MP_VAL; + } + return TclBN_mp_to_radix(a, str, (size_t)maxlen, NULL, radix); +} + +#define TclSetStartupScriptPath setStartupScriptPath +static void TclSetStartupScriptPath(Tcl_Obj *path) +{ + Tcl_SetStartupScript(path, NULL); +} +#define TclGetStartupScriptPath getStartupScriptPath +static Tcl_Obj *TclGetStartupScriptPath(void) +{ + return Tcl_GetStartupScript(NULL); +} +#define TclSetStartupScriptFileName setStartupScriptFileName +static void TclSetStartupScriptFileName( + const char *fileName) +{ + Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); +} +#define TclGetStartupScriptFileName getStartupScriptFileName +static const char *TclGetStartupScriptFileName(void) +{ + Tcl_Obj *path = Tcl_GetStartupScript(NULL); + if (path == NULL) { + return NULL; + } + return Tcl_GetString(path); +} +#if defined(_WIN32) || defined(__CYGWIN__) +#undef TclWinNToHS +#undef TclWinGetPlatformId +#undef TclWinResetInterfaces +#undef TclWinSetInterfaces +static void +doNothing(void) +{ + /* dummy implementation, no need to do anything */ +} +#define TclWinNToHS winNToHS +static unsigned short TclWinNToHS(unsigned short ns) { + return ntohs(ns); +} +#define TclWinGetPlatformId winGetPlatformId +static int +TclWinGetPlatformId(void) +{ + return 2; /* VER_PLATFORM_WIN32_NT */; +} +#define TclWinResetInterfaces doNothing +#define TclWinSetInterfaces (void (*) (int)) doNothing +#endif +#endif /* TCL_NO_DEPRECATED */ + +#define TclpCreateTempFile_ TclpCreateTempFile +#define TclUnixWaitForFile_ TclUnixWaitForFile +#ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */ +#define TclMacOSXGetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj **))(void *)TclpCreateProcess +#define TclMacOSXSetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj *))(void *)isatty +#define TclMacOSXCopyFileAttributes (int (*)(const char *, const char *, const Tcl_StatBuf *))(void *)TclUnixCopyFile +#define TclMacOSXMatchType (int (*)(Tcl_Interp *, const char *, const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))(void *)TclpMakeFile +#define TclMacOSXNotifierAddRunLoopMode (void (*)(const void *))(void *)TclpOpenFile #endif #ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 +# define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) -# define TclpIsAtty TclPlatIsAtty +# define TclpIsAtty isatty +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 static void doNothing(void) { /* dummy implementation, no need to do anything */ } -# define TclWinAddProcess (void (*) (void *, size_t)) doNothing +#endif +# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#define TclWinSetSockOpt winSetSockOpt +static int +TclWinSetSockOpt(SOCKET s, int level, int optname, + const char *optval, int optlen) +{ + return setsockopt((int) s, level, optname, optval, optlen); +} + +#define TclWinGetSockOpt winGetSockOpt static int -TclpIsAtty(int fd) -{ - return isatty(fd); -} - -void *TclWinGetTclInstance() -{ - void *hInstance = NULL; - GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, - (const char *)&TclpIsAtty, &hInstance); - return hInstance; -} +TclWinGetSockOpt(SOCKET s, int level, int optname, + char *optval, int *optlen) +{ + return getsockopt((int) s, level, optname, optval, optlen); +} + +#define TclWinGetServByName winGetServByName +static struct servent * +TclWinGetServByName(const char *name, const char *proto) +{ + return getservbyname(name, proto); +} +#endif /* TCL_NO_DEPRECATED */ #define TclWinNoBackslash winNoBackslash static char * TclWinNoBackslash(char *path) { @@ -96,46 +437,46 @@ } } return path; } -size_t +void *TclWinGetTclInstance() +{ + void *hInstance = NULL; + GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, + (const wchar_t *)&TclWinNoBackslash, &hInstance); + return hInstance; +} + +int TclpGetPid(Tcl_Pid pid) { - return (size_t) pid; + return (int) (size_t) pid; } +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#undef Tcl_WinUtfToTChar char * Tcl_WinUtfToTChar( const char *string, - size_t len, + int len, Tcl_DString *dsPtr) { Tcl_DStringInit(dsPtr); - if (!string) { - return NULL; - } - return (char *)TclUtfToWCharDString(string, len, dsPtr); + return (char *)Tcl_UtfToChar16DString(string, len, dsPtr); } - +#undef Tcl_WinTCharToUtf char * Tcl_WinTCharToUtf( const char *string, - size_t len, + int len, Tcl_DString *dsPtr) { Tcl_DStringInit(dsPtr); - if (!string) { - return NULL; - } - if (len == TCL_AUTO_LENGTH) { - len = wcslen((wchar_t *)string); - } else { - len /= 2; - } - return TclWCharToUtfDString((const WCHAR *)string, len, dsPtr); -} + return Tcl_Char16ToUtfDString((const unsigned short *)string, len >> 1, dsPtr); +} +#endif /* !defined(TCL_NO_DEPRECATED) */ #if defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the Win64 * signature. Tcl 9 must find a better solution, but that cannot be done @@ -171,13 +512,196 @@ } } return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj +#if TCL_UTF_MAX < 4 && !defined(TCL_NO_DEPRECATED) +static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ + return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); +} +#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcmp +static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ + return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); +} +#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcasecmp +#endif +static int utfNcmp(const char *s1, const char *s2, unsigned int n){ + return Tcl_UtfNcmp(s1, s2, (unsigned long)n); +} +#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp +static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ + return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); +} +#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp + #endif /* TCL_WIDE_INT_IS_LONG */ #endif /* __CYGWIN__ */ + +#if defined(TCL_NO_DEPRECATED) +# define Tcl_SeekOld 0 +# define Tcl_TellOld 0 +# undef Tcl_SetBooleanObj +# define Tcl_SetBooleanObj 0 +# undef Tcl_PkgPresent +# define Tcl_PkgPresent 0 +# undef Tcl_PkgProvide +# define Tcl_PkgProvide 0 +# undef Tcl_PkgRequire +# define Tcl_PkgRequire 0 +# undef Tcl_GetIndexFromObj +# define Tcl_GetIndexFromObj 0 +# define Tcl_NewBooleanObj 0 +# undef Tcl_DbNewBooleanObj +# define Tcl_DbNewBooleanObj 0 +# undef Tcl_SetBooleanObj +# define Tcl_SetBooleanObj 0 +# undef Tcl_SetVar +# define Tcl_SetVar 0 +# undef Tcl_UnsetVar +# define Tcl_UnsetVar 0 +# undef Tcl_GetVar +# define Tcl_GetVar 0 +# undef Tcl_TraceVar +# define Tcl_TraceVar 0 +# undef Tcl_UntraceVar +# define Tcl_UntraceVar 0 +# undef Tcl_VarTraceInfo +# define Tcl_VarTraceInfo 0 +# undef Tcl_UpVar +# define Tcl_UpVar 0 +# undef Tcl_AddErrorInfo +# define Tcl_AddErrorInfo 0 +# undef Tcl_AddObjErrorInfo +# define Tcl_AddObjErrorInfo 0 +# undef Tcl_Eval +# define Tcl_Eval 0 +# undef Tcl_GlobalEval +# define Tcl_GlobalEval 0 +# undef Tcl_GetStringResult +# define Tcl_GetStringResult 0 +# undef Tcl_SaveResult +# define Tcl_SaveResult 0 +# undef Tcl_RestoreResult +# define Tcl_RestoreResult 0 +# undef Tcl_DiscardResult +# define Tcl_DiscardResult 0 +# undef Tcl_SetResult +# define Tcl_SetResult 0 +# undef Tcl_EvalObj +# define Tcl_EvalObj 0 +# undef Tcl_GlobalEvalObj +# define Tcl_GlobalEvalObj 0 +# define TclBackgroundException 0 +# undef TclpReaddir +# define TclpReaddir 0 +# define TclSetStartupScript 0 +# define TclGetStartupScript 0 +# define TclGetIntForIndex 0 +# define TclCreateNamespace 0 +# define TclDeleteNamespace 0 +# define TclAppendExportList 0 +# define TclExport 0 +# define TclImport 0 +# define TclForgetImport 0 +# define TclGetCurrentNamespace_ 0 +# define TclGetGlobalNamespace_ 0 +# define TclFindNamespace 0 +# define TclFindCommand 0 +# define TclGetCommandFromObj 0 +# define TclGetCommandFullName 0 +# define TclCopyChannelOld 0 +# define Tcl_AppendResultVA 0 +# define Tcl_AppendStringsToObjVA 0 +# define Tcl_SetErrorCodeVA 0 +# define Tcl_PanicVA 0 +# define Tcl_VarEvalVA 0 +# undef TclpGetDate +# define TclpGetDate 0 +# undef TclpLocaltime +# define TclpLocaltime 0 +# undef TclpGmtime +# define TclpGmtime 0 +# define TclpLocaltime_unix 0 +# define TclpGmtime_unix 0 +# define Tcl_SetExitProc 0 +# define Tcl_SetPanicProc 0 +# define Tcl_FindExecutable 0 +# define Tcl_GetUnicode 0 +#if TCL_UTF_MAX < 4 +# define Tcl_AppendUnicodeToObj 0 +# define Tcl_UniCharCaseMatch 0 +# define Tcl_UniCharLen 0 +# define Tcl_UniCharNcasecmp 0 +# define Tcl_UniCharNcmp 0 +#endif +# undef Tcl_StringMatch +# define Tcl_StringMatch 0 +# define TclBN_reverse 0 +# undef TclBN_s_mp_mul_digs_fast +# define TclBN_s_mp_mul_digs_fast 0 +# undef TclBN_s_mp_sqr_fast +# define TclBN_s_mp_sqr_fast 0 +# undef TclBN_mp_karatsuba_mul +# define TclBN_mp_karatsuba_mul 0 +# undef TclBN_mp_karatsuba_sqr +# define TclBN_mp_karatsuba_sqr 0 +# undef TclBN_mp_toom_mul +# define TclBN_mp_toom_mul 0 +# undef TclBN_mp_toom_sqr +# define TclBN_mp_toom_sqr 0 +# undef TclBN_s_mp_add +# define TclBN_s_mp_add 0 +# undef TclBN_s_mp_mul_digs +# define TclBN_s_mp_mul_digs 0 +# undef TclBN_s_mp_sqr +# define TclBN_s_mp_sqr 0 +# undef TclBN_s_mp_sub +# define TclBN_s_mp_sub 0 +#else /* TCL_NO_DEPRECATED */ +# define Tcl_SeekOld seekOld +# define Tcl_TellOld tellOld +# define TclBackgroundException Tcl_BackgroundException +# define TclSetStartupScript Tcl_SetStartupScript +# define TclGetStartupScript Tcl_GetStartupScript +# define TclGetIntForIndex Tcl_GetIntForIndex +# define TclCreateNamespace Tcl_CreateNamespace +# define TclDeleteNamespace Tcl_DeleteNamespace +# define TclAppendExportList Tcl_AppendExportList +# define TclExport Tcl_Export +# define TclImport Tcl_Import +# define TclForgetImport Tcl_ForgetImport +# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace +# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace +# define TclFindNamespace Tcl_FindNamespace +# define TclFindCommand Tcl_FindCommand +# define TclGetCommandFromObj Tcl_GetCommandFromObj +# define TclGetCommandFullName Tcl_GetCommandFullName +# define TclpLocaltime_unix TclpLocaltime +# define TclpGmtime_unix TclpGmtime + +static int +seekOld( + Tcl_Channel chan, /* The channel on which to seek. */ + int offset, /* Offset to seek to. */ + int mode) /* Relative to which location to seek? */ +{ + return Tcl_Seek(chan, offset, mode); +} + +static int +tellOld( + Tcl_Channel chan) /* The channel to return pos for. */ +{ + return Tcl_Tell(chan); +} +#endif /* !TCL_NO_DEPRECATED */ + +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 +#define Tcl_WinUtfToTChar 0 +#define Tcl_WinTCharToUtf 0 +#endif /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. @@ -206,11 +730,11 @@ TclAllocateFreeObjects, /* 3 */ 0, /* 4 */ TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - 0, /* 8 */ + TclCopyChannelOld, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ TclDeleteVars, /* 12 */ 0, /* 13 */ @@ -232,11 +756,11 @@ 0, /* 29 */ 0, /* 30 */ TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ - 0, /* 34 */ + TclGetIntForIndex, /* 34 */ 0, /* 35 */ 0, /* 36 */ TclGetLoadedPackages, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ @@ -275,11 +799,11 @@ 0, /* 72 */ 0, /* 73 */ TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - 0, /* 77 */ + TclpGetTime, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ TclpRealloc, /* 81 */ 0, /* 82 */ @@ -286,11 +810,11 @@ 0, /* 83 */ 0, /* 84 */ 0, /* 85 */ 0, /* 86 */ 0, /* 87 */ - 0, /* 88 */ + TclPrecTraceProc, /* 88 */ TclPreventAliasLoop, /* 89 */ 0, /* 90 */ TclProcCleanupProc, /* 91 */ TclProcCompileProc, /* 92 */ TclProcDeleteProc, /* 93 */ @@ -302,40 +826,40 @@ 0, /* 99 */ 0, /* 100 */ TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - 0, /* 104 */ + TclSockMinimumBuffersOld, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ TclTeardownNamespace, /* 108 */ TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ - 0, /* 112 */ - 0, /* 113 */ - 0, /* 114 */ - 0, /* 115 */ - 0, /* 116 */ - 0, /* 117 */ + TclAppendExportList, /* 112 */ + TclCreateNamespace, /* 113 */ + TclDeleteNamespace, /* 114 */ + TclExport, /* 115 */ + TclFindCommand, /* 116 */ + TclFindNamespace, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ - 0, /* 121 */ - 0, /* 122 */ - 0, /* 123 */ - 0, /* 124 */ - 0, /* 125 */ + TclForgetImport, /* 121 */ + TclGetCommandFromObj, /* 122 */ + TclGetCommandFullName, /* 123 */ + TclGetCurrentNamespace_, /* 124 */ + TclGetGlobalNamespace_, /* 125 */ Tcl_GetVariableFullName, /* 126 */ - 0, /* 127 */ + TclImport, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - 0, /* 133 */ + TclpGetDate, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ 0, /* 137 */ TclGetEnv, /* 138 */ @@ -356,36 +880,36 @@ TclGetLibraryPath, /* 153 */ 0, /* 154 */ 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - 0, /* 158 */ - 0, /* 159 */ + TclSetStartupScriptFileName, /* 158 */ + TclGetStartupScriptFileName, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ TclGetInstructionTable, /* 163 */ TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - 0, /* 167 */ - 0, /* 168 */ + TclSetStartupScriptPath, /* 167 */ + TclGetStartupScriptPath, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ TclInThreadExit, /* 172 */ TclUniCharMatch, /* 173 */ 0, /* 174 */ TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - 0, /* 178 */ - 0, /* 179 */ + TclSetStartupScript, /* 178 */ + TclGetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ - 0, /* 182 */ - 0, /* 183 */ + TclpLocaltime, /* 182 */ + TclpGmtime, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ 0, /* 187 */ 0, /* 188 */ @@ -434,11 +958,11 @@ TclGetNamespaceFromObj, /* 231 */ TclEvalObjEx, /* 232 */ TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - 0, /* 236 */ + TclBackgroundException, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ TclNRRunCallbacks, /* 240 */ TclNREvalObjEx, /* 241 */ @@ -457,10 +981,12 @@ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ + TclGetBytesFromObj, /* 259 */ + TclUnusedStubEntry, /* 260 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, @@ -468,28 +994,28 @@ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclpCreateProcess, /* 4 */ - 0, /* 5 */ + TclUnixWaitForFile_, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - 0, /* 10 */ - 0, /* 11 */ - 0, /* 12 */ - 0, /* 13 */ + TclpReaddir, /* 10 */ + TclpLocaltime_unix, /* 11 */ + TclpGmtime_unix, /* 12 */ + TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ - 0, /* 15 */ - 0, /* 16 */ - 0, /* 17 */ - 0, /* 18 */ - 0, /* 19 */ + TclMacOSXGetFileAttribute, /* 15 */ + TclMacOSXSetFileAttribute, /* 16 */ + TclMacOSXCopyFileAttributes, /* 17 */ + TclMacOSXMatchType, /* 18 */ + TclMacOSXNotifierAddRunLoopMode, /* 19 */ 0, /* 20 */ 0, /* 21 */ - 0, /* 22 */ + TclpCreateTempFile_, /* 22 */ 0, /* 23 */ 0, /* 24 */ 0, /* 25 */ 0, /* 26 */ 0, /* 27 */ @@ -497,20 +1023,20 @@ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - 0, /* 1 */ - 0, /* 2 */ - 0, /* 3 */ + TclWinConvertWSAError, /* 1 */ + TclWinGetServByName, /* 2 */ + TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - 0, /* 6 */ - 0, /* 7 */ + TclWinNToHS, /* 6 */ + TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ - 0, /* 9 */ - 0, /* 10 */ + TclWinGetPlatformId, /* 9 */ + TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ @@ -517,45 +1043,45 @@ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - 0, /* 21 */ + TclpInetNtoa, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ - 0, /* 26 */ + TclWinSetInterfaces, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ - 0, /* 28 */ + TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ TclpCreateProcess, /* 4 */ - 0, /* 5 */ + TclUnixWaitForFile_, /* 5 */ TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - 0, /* 10 */ - 0, /* 11 */ - 0, /* 12 */ - 0, /* 13 */ + TclpReaddir, /* 10 */ + TclpLocaltime_unix, /* 11 */ + TclpGmtime_unix, /* 12 */ + TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ 0, /* 20 */ 0, /* 21 */ - 0, /* 22 */ + TclpCreateTempFile_, /* 22 */ 0, /* 23 */ 0, /* 24 */ 0, /* 25 */ 0, /* 26 */ 0, /* 27 */ @@ -598,11 +1124,11 @@ TclBN_mp_div_d, /* 14 */ TclBN_mp_div_2, /* 15 */ TclBN_mp_div_2d, /* 16 */ TclBN_mp_div_3, /* 17 */ TclBN_mp_exch, /* 18 */ - TclBN_mp_expt_d, /* 19 */ + TclBN_mp_expt_u32, /* 19 */ TclBN_mp_grow, /* 20 */ TclBN_mp_init, /* 21 */ TclBN_mp_init_copy, /* 22 */ TclBN_mp_init_multi, /* 23 */ TclBN_mp_init_set, /* 24 */ @@ -626,41 +1152,44 @@ TclBN_mp_sub, /* 42 */ TclBN_mp_sub_d, /* 43 */ TclBN_mp_to_unsigned_bin, /* 44 */ TclBN_mp_to_unsigned_bin_n, /* 45 */ TclBN_mp_toradix_n, /* 46 */ - TclBN_mp_unsigned_bin_size, /* 47 */ + TclBN_mp_ubin_size, /* 47 */ TclBN_mp_xor, /* 48 */ TclBN_mp_zero, /* 49 */ - 0, /* 50 */ - 0, /* 51 */ - 0, /* 52 */ - 0, /* 53 */ - 0, /* 54 */ - 0, /* 55 */ - 0, /* 56 */ - 0, /* 57 */ - 0, /* 58 */ - 0, /* 59 */ - 0, /* 60 */ - TclBN_mp_init_set_int, /* 61 */ - TclBN_mp_set_int, /* 62 */ + TclBN_reverse, /* 50 */ + TclBN_s_mp_mul_digs_fast, /* 51 */ + TclBN_s_mp_sqr_fast, /* 52 */ + TclBN_mp_karatsuba_mul, /* 53 */ + TclBN_mp_karatsuba_sqr, /* 54 */ + TclBN_mp_toom_mul, /* 55 */ + TclBN_mp_toom_sqr, /* 56 */ + TclBN_s_mp_add, /* 57 */ + TclBN_s_mp_mul_digs, /* 58 */ + TclBN_s_mp_sqr, /* 59 */ + TclBN_s_mp_sub, /* 60 */ + TclBN_mp_init_ul, /* 61 */ + TclBN_mp_set_ul, /* 62 */ TclBN_mp_cnt_lsb, /* 63 */ - 0, /* 64 */ - 0, /* 65 */ - 0, /* 66 */ + TclBN_mp_init_l, /* 64 */ + TclBN_mp_init_i64, /* 65 */ + TclBN_mp_init_u64, /* 66 */ TclBN_mp_expt_d_ex, /* 67 */ - TclBN_mp_set_long_long, /* 68 */ - TclBN_mp_get_long_long, /* 69 */ - TclBN_mp_set_long, /* 70 */ - TclBN_mp_get_long, /* 71 */ - TclBN_mp_get_int, /* 72 */ - 0, /* 73 */ - 0, /* 74 */ - 0, /* 75 */ + TclBN_mp_set_u64, /* 68 */ + TclBN_mp_get_mag_u64, /* 69 */ + TclBN_mp_set_i64, /* 70 */ + 0, /* 71 */ + 0, /* 72 */ + TclBN_mp_tc_and, /* 73 */ + TclBN_mp_tc_or, /* 74 */ + TclBN_mp_tc_xor, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ - TclBN_mp_get_bit, /* 77 */ + 0, /* 77 */ + TclBN_mp_to_ubin, /* 78 */ + TclBN_mp_div_ld, /* 79 */ + TclBN_mp_to_radix, /* 80 */ }; static const TclStubHooks tclStubHooks = { &tclPlatStubs, &tclIntStubs, @@ -706,25 +1235,25 @@ Tcl_ConcatObj, /* 17 */ Tcl_ConvertToType, /* 18 */ Tcl_DbDecrRefCount, /* 19 */ Tcl_DbIncrRefCount, /* 20 */ Tcl_DbIsShared, /* 21 */ - 0, /* 22 */ + Tcl_DbNewBooleanObj, /* 22 */ Tcl_DbNewByteArrayObj, /* 23 */ Tcl_DbNewDoubleObj, /* 24 */ Tcl_DbNewListObj, /* 25 */ - 0, /* 26 */ + Tcl_DbNewLongObj, /* 26 */ Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ - 0, /* 30 */ + TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ Tcl_GetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ - 0, /* 36 */ + Tcl_GetIndexFromObj, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ Tcl_GetObjType, /* 40 */ Tcl_GetStringFromObj, /* 41 */ @@ -733,39 +1262,39 @@ Tcl_ListObjAppendElement, /* 44 */ Tcl_ListObjGetElements, /* 45 */ Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ - 0, /* 49 */ + Tcl_NewBooleanObj, /* 49 */ Tcl_NewByteArrayObj, /* 50 */ Tcl_NewDoubleObj, /* 51 */ - 0, /* 52 */ + Tcl_NewIntObj, /* 52 */ Tcl_NewListObj, /* 53 */ - 0, /* 54 */ + Tcl_NewLongObj, /* 54 */ Tcl_NewObj, /* 55 */ Tcl_NewStringObj, /* 56 */ - 0, /* 57 */ + Tcl_SetBooleanObj, /* 57 */ Tcl_SetByteArrayLength, /* 58 */ Tcl_SetByteArrayObj, /* 59 */ Tcl_SetDoubleObj, /* 60 */ - 0, /* 61 */ + Tcl_SetIntObj, /* 61 */ Tcl_SetListObj, /* 62 */ - 0, /* 63 */ + Tcl_SetLongObj, /* 63 */ Tcl_SetObjLength, /* 64 */ Tcl_SetStringObj, /* 65 */ - 0, /* 66 */ - 0, /* 67 */ + Tcl_AddErrorInfo, /* 66 */ + Tcl_AddObjErrorInfo, /* 67 */ Tcl_AllowExceptions, /* 68 */ Tcl_AppendElement, /* 69 */ Tcl_AppendResult, /* 70 */ Tcl_AsyncCreate, /* 71 */ Tcl_AsyncDelete, /* 72 */ Tcl_AsyncInvoke, /* 73 */ Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ - 0, /* 76 */ - 0, /* 77 */ + Tcl_BackgroundError, /* 76 */ + Tcl_Backslash, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ Tcl_Close, /* 81 */ Tcl_CommandComplete, /* 82 */ @@ -779,11 +1308,11 @@ Tcl_CreateCloseHandler, /* 90 */ Tcl_CreateCommand, /* 91 */ Tcl_CreateEventSource, /* 92 */ Tcl_CreateExitHandler, /* 93 */ Tcl_CreateInterp, /* 94 */ - 0, /* 95 */ + Tcl_CreateMathFunc, /* 95 */ Tcl_CreateObjCommand, /* 96 */ Tcl_CreateSlave, /* 97 */ Tcl_CreateTimerHandler, /* 98 */ Tcl_CreateTrace, /* 99 */ Tcl_DeleteAssocData, /* 100 */ @@ -813,13 +1342,13 @@ Tcl_DStringSetLength, /* 124 */ Tcl_DStringStartSublist, /* 125 */ Tcl_Eof, /* 126 */ Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ - 0, /* 129 */ + Tcl_Eval, /* 129 */ Tcl_EvalFile, /* 130 */ - 0, /* 131 */ + Tcl_EvalObj, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ Tcl_ExposeCommand, /* 134 */ Tcl_ExprBoolean, /* 135 */ Tcl_ExprBooleanObj, /* 136 */ @@ -828,11 +1357,11 @@ Tcl_ExprLong, /* 139 */ Tcl_ExprLongObj, /* 140 */ Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ - 0, /* 144 */ + Tcl_FindExecutable, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ Tcl_FreeResult, /* 147 */ Tcl_GetAlias, /* 148 */ Tcl_GetAliasObj, /* 149 */ @@ -866,15 +1395,15 @@ Tcl_Gets, /* 169 */ Tcl_GetsObj, /* 170 */ Tcl_GetServiceMode, /* 171 */ Tcl_GetSlave, /* 172 */ Tcl_GetStdChannel, /* 173 */ - 0, /* 174 */ - 0, /* 175 */ + Tcl_GetStringResult, /* 174 */ + Tcl_GetVar, /* 175 */ Tcl_GetVar2, /* 176 */ - 0, /* 177 */ - 0, /* 178 */ + Tcl_GlobalEval, /* 177 */ + Tcl_GlobalEvalObj, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ Tcl_InputBlocked, /* 182 */ Tcl_InputBuffered, /* 183 */ @@ -912,69 +1441,69 @@ Tcl_RegExpRange, /* 215 */ Tcl_Release, /* 216 */ Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - 0, /* 220 */ + Tcl_SeekOld, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ Tcl_SetChannelBufferSize, /* 224 */ Tcl_SetChannelOption, /* 225 */ Tcl_SetCommandInfo, /* 226 */ Tcl_SetErrno, /* 227 */ Tcl_SetErrorCode, /* 228 */ Tcl_SetMaxBlockTime, /* 229 */ - 0, /* 230 */ + Tcl_SetPanicProc, /* 230 */ Tcl_SetRecursionLimit, /* 231 */ - 0, /* 232 */ + Tcl_SetResult, /* 232 */ Tcl_SetServiceMode, /* 233 */ Tcl_SetObjErrorCode, /* 234 */ Tcl_SetObjResult, /* 235 */ Tcl_SetStdChannel, /* 236 */ - 0, /* 237 */ + Tcl_SetVar, /* 237 */ Tcl_SetVar2, /* 238 */ Tcl_SignalId, /* 239 */ Tcl_SignalMsg, /* 240 */ Tcl_SourceRCFile, /* 241 */ Tcl_SplitList, /* 242 */ Tcl_SplitPath, /* 243 */ - 0, /* 244 */ - 0, /* 245 */ - 0, /* 246 */ - 0, /* 247 */ + Tcl_StaticPackage, /* 244 */ + Tcl_StringMatch, /* 245 */ + Tcl_TellOld, /* 246 */ + Tcl_TraceVar, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ Tcl_Ungets, /* 250 */ Tcl_UnlinkVar, /* 251 */ Tcl_UnregisterChannel, /* 252 */ - 0, /* 253 */ + Tcl_UnsetVar, /* 253 */ Tcl_UnsetVar2, /* 254 */ - 0, /* 255 */ + Tcl_UntraceVar, /* 255 */ Tcl_UntraceVar2, /* 256 */ Tcl_UpdateLinkedVar, /* 257 */ - 0, /* 258 */ + Tcl_UpVar, /* 258 */ Tcl_UpVar2, /* 259 */ Tcl_VarEval, /* 260 */ - 0, /* 261 */ + Tcl_VarTraceInfo, /* 261 */ Tcl_VarTraceInfo2, /* 262 */ Tcl_Write, /* 263 */ Tcl_WrongNumArgs, /* 264 */ Tcl_DumpActiveMemory, /* 265 */ Tcl_ValidateAllMemory, /* 266 */ - 0, /* 267 */ - 0, /* 268 */ + Tcl_AppendResultVA, /* 267 */ + Tcl_AppendStringsToObjVA, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ - 0, /* 271 */ + Tcl_PkgPresent, /* 271 */ Tcl_PkgPresentEx, /* 272 */ - 0, /* 273 */ - 0, /* 274 */ - 0, /* 275 */ - 0, /* 276 */ + Tcl_PkgProvide, /* 273 */ + Tcl_PkgRequire, /* 274 */ + Tcl_SetErrorCodeVA, /* 275 */ + Tcl_VarEvalVA, /* 276 */ Tcl_WaitPid, /* 277 */ - 0, /* 278 */ + Tcl_PanicVA, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ Tcl_UnstackChannel, /* 282 */ Tcl_GetStackedChannel, /* 283 */ @@ -982,11 +1511,11 @@ 0, /* 285 */ Tcl_AppendObjToObj, /* 286 */ Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ - 0, /* 290 */ + Tcl_DiscardResult, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ Tcl_EvalObjEx, /* 293 */ Tcl_ExitThread, /* 294 */ Tcl_ExternalToUtf, /* 295 */ @@ -1006,12 +1535,12 @@ Tcl_MutexUnlock, /* 309 */ Tcl_ConditionNotify, /* 310 */ Tcl_ConditionWait, /* 311 */ Tcl_NumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ - 0, /* 314 */ - 0, /* 315 */ + Tcl_RestoreResult, /* 314 */ + Tcl_SaveResult, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ Tcl_ThreadQueueEvent, /* 319 */ Tcl_UniCharAtIndex, /* 320 */ @@ -1028,17 +1557,17 @@ Tcl_UtfPrev, /* 331 */ Tcl_UtfToExternal, /* 332 */ Tcl_UtfToExternalDString, /* 333 */ Tcl_UtfToLower, /* 334 */ Tcl_UtfToTitle, /* 335 */ - Tcl_UtfToUniChar, /* 336 */ + Tcl_UtfToChar16, /* 336 */ Tcl_UtfToUpper, /* 337 */ Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ - 0, /* 341 */ - 0, /* 342 */ + Tcl_GetDefaultEncodingDir, /* 341 */ + Tcl_SetDefaultEncodingDir, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ Tcl_UniCharIsAlpha, /* 346 */ Tcl_UniCharIsDigit, /* 347 */ @@ -1046,14 +1575,14 @@ Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ Tcl_UniCharLen, /* 352 */ Tcl_UniCharNcmp, /* 353 */ - Tcl_UniCharToUtfDString, /* 354 */ - Tcl_UtfToUniCharDString, /* 355 */ + Tcl_Char16ToUtfDString, /* 354 */ + Tcl_UtfToChar16DString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ - 0, /* 357 */ + Tcl_EvalTokens, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ Tcl_ParseCommand, /* 361 */ Tcl_ParseExpr, /* 362 */ @@ -1074,11 +1603,11 @@ Tcl_RegExpGetInfo, /* 377 */ Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ Tcl_GetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ - 0, /* 382 */ + Tcl_GetUnicode, /* 382 */ Tcl_GetRange, /* 383 */ Tcl_AppendUnicodeToObj, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ Tcl_GetAllocMutex, /* 387 */ @@ -1113,12 +1642,12 @@ Tcl_SpliceChannel, /* 416 */ Tcl_ClearChannelHandlers, /* 417 */ Tcl_IsChannelExisting, /* 418 */ Tcl_UniCharNcasecmp, /* 419 */ Tcl_UniCharCaseMatch, /* 420 */ - 0, /* 421 */ - 0, /* 422 */ + Tcl_FindHashEntry, /* 421 */ + Tcl_CreateHashEntry, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ Tcl_TraceCommand, /* 426 */ Tcl_UntraceCommand, /* 427 */ @@ -1127,12 +1656,12 @@ Tcl_AttemptRealloc, /* 430 */ Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ Tcl_GetUnicodeFromObj, /* 434 */ - 0, /* 435 */ - 0, /* 436 */ + Tcl_GetMathFuncInfo, /* 435 */ + Tcl_ListMathFuncs, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ Tcl_FSCopyFile, /* 440 */ Tcl_FSCopyDirectory, /* 441 */ @@ -1211,11 +1740,11 @@ Tcl_FindNamespace, /* 514 */ Tcl_FindCommand, /* 515 */ Tcl_GetCommandFromObj, /* 516 */ Tcl_GetCommandFullName, /* 517 */ Tcl_FSEvalFileEx, /* 518 */ - 0, /* 519 */ + Tcl_SetExitProc, /* 519 */ Tcl_LimitAddHandler, /* 520 */ Tcl_LimitRemoveHandler, /* 521 */ Tcl_LimitReady, /* 522 */ Tcl_LimitCheck, /* 523 */ Tcl_LimitExceeded, /* 524 */ @@ -1338,8 +1867,11 @@ Tcl_IncrRefCount, /* 641 */ Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ + Tcl_UtfToUniChar, /* 646 */ + Tcl_UniCharToUtfDString, /* 647 */ + Tcl_UtfToUniCharDString, /* 648 */ }; /* !END!: Do not edit above this line. */ Index: generic/tclStubLib.c ================================================================== --- generic/tclStubLib.c +++ generic/tclStubLib.c @@ -63,13 +63,13 @@ * We can't optimize this check by caching tclStubsPtr because that * prevents apps from being able to load/unload Tcl dynamically multiple * times. [Bug 615304] */ - if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { - iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism"; - iPtr->legacyFreeProc = 0; /* TCL_STATIC */ + if (!stubsPtr || (stubsPtr->magic != (((exact&0xFF00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { + iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = 0; return NULL; } actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); if (actualVersion == NULL) { @@ -99,11 +99,11 @@ if (actualVersion == NULL) { return NULL; } } } - if (((exact&0xff00) < 0x900)) { + if (((exact&0xFF00) < 0x900)) { /* We are running Tcl 8.x */ stubsPtr = (TclStubs *)pkgData; } tclStubsPtr = stubsPtr; Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -18,32 +18,31 @@ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" +#ifdef TCL_WITH_EXTERNAL_TOMMATH +# include "tommath.h" +#else +# include "tclTomMath.h" +#endif #include "tclOO.h" #include /* * Required for Testregexp*Cmd */ #include "tclRegexp.h" -/* - * Required for TestlocaleCmd - */ -#include - /* * Required for the TestChannelCmd and TestChannelEventCmd */ #include "tclIO.h" /* * Declare external functions used in Windows tests. */ - DLLEXPORT int Tcltest_Init(Tcl_Interp *interp); DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect @@ -50,11 +49,10 @@ * the results of the various deletion callbacks. */ static Tcl_DString delString; static Tcl_Interp *delInterp; -static const Tcl_ObjType *properByteArrayType; /* * One of the following structures exists for each asynchronous handler * created by the "testasync" command". */ @@ -167,33 +165,26 @@ #endif static void CleanupTestSetassocdataTests( void *clientData, Tcl_Interp *interp); static void CmdDelProc1(void *clientData); static void CmdDelProc2(void *clientData); -static int CmdProc1(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int CmdProc2(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); +static Tcl_CmdProc CmdProc1; +static Tcl_CmdProc CmdProc2; static void CmdTraceDeleteProc( void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, void *cmdClientData, int argc, const char *argv[]); static void CmdTraceProc(void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, void *cmdClientData, int argc, const char *argv[]); -static int CreatedCommandProc( - void *clientData, Tcl_Interp *interp, - int argc, const char **argv); -static int CreatedCommandProc2( - void *clientData, Tcl_Interp *interp, - int argc, const char **argv); +static Tcl_CmdProc CreatedCommandProc; +static Tcl_CmdProc CreatedCommandProc2; static void DelCallbackProc(void *clientData, Tcl_Interp *interp); -static int DelCmdProc(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); +static Tcl_CmdProc DelCmdProc; static void DelDeleteProc(void *clientData); static void EncodingFreeProc(void *clientData); static int EncodingToUtfProc(void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, @@ -204,193 +195,101 @@ Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); -static int GetTimesObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc GetTimesObjCmd; +static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); -static int NoopCmd(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int NoopObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc NoopCmd; +static Tcl_ObjCmdProc NoopObjCmd; static int ObjTraceProc(void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandToken, int objc, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); -static void SpecialFree(void *blockPtr); +static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); -static int TestasyncCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestbytestringObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestpurebytesobjObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TeststringbytesObjCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestcmdinfoCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcmdtokenCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcmdtraceCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestconcatobjCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcreatecommandCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdcallCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdelCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdelassocdataCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestdoubledigitsObjCmd(void *dummy, - Tcl_Interp* interp, int objc, - Tcl_Obj* const objv[]); -static int TestdstringCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestencodingObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestevalexObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestevalobjvObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TesteventObjCmd(void *unused, - Tcl_Interp *interp, int argc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc TestasyncCmd; +static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; +static Tcl_ObjCmdProc TestbytestringObjCmd; +static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; +static Tcl_ObjCmdProc TestpurebytesobjObjCmd; +static Tcl_ObjCmdProc TeststringbytesObjCmd; +static Tcl_CmdProc TestcmdinfoCmd; +static Tcl_CmdProc TestcmdtokenCmd; +static Tcl_CmdProc TestcmdtraceCmd; +static Tcl_CmdProc TestconcatobjCmd; +static Tcl_CmdProc TestcreatecommandCmd; +static Tcl_CmdProc TestdcallCmd; +static Tcl_CmdProc TestdelCmd; +static Tcl_CmdProc TestdelassocdataCmd; +static Tcl_ObjCmdProc TestdoubledigitsObjCmd; +static Tcl_CmdProc TestdstringCmd; +static Tcl_ObjCmdProc TestencodingObjCmd; +static Tcl_ObjCmdProc TestevalexObjCmd; +static Tcl_ObjCmdProc TestevalobjvObjCmd; +static Tcl_ObjCmdProc TesteventObjCmd; static int TesteventProc(Tcl_Event *event, int flags); static int TesteventDeleteProc(Tcl_Event *event, void *clientData); -static int TestexithandlerCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexprlongCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexprlongobjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestexprdoubleCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexprdoubleobjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestexprparserObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestexprstringCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestfileCmd(void *dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestfilelinkCmd(void *dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestfeventCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetassocdataCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetintCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestlongsizeCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetplatformCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestgetvarfullnameCmd( - void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestinterpdeleteCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestlinkCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestlinkarrayCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -static int TestlocaleCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestmainthreadCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestsetmainloopCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestexitmainloopCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestpanicCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestparseargsCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestparserObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestparsevarObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestparsevarnameObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestpreferstableObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestprintObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestregexpObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestreturnObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_CmdProc TestexithandlerCmd; +static Tcl_CmdProc TestexprlongCmd; +static Tcl_ObjCmdProc TestexprlongobjCmd; +static Tcl_CmdProc TestexprdoubleCmd; +static Tcl_ObjCmdProc TestexprdoubleobjCmd; +static Tcl_ObjCmdProc TestexprparserObjCmd; +static Tcl_CmdProc TestexprstringCmd; +static Tcl_ObjCmdProc TestfileCmd; +static Tcl_ObjCmdProc TestfilelinkCmd; +static Tcl_CmdProc TestfeventCmd; +static Tcl_CmdProc TestgetassocdataCmd; +static Tcl_CmdProc TestgetintCmd; +static Tcl_CmdProc TestlongsizeCmd; +static Tcl_CmdProc TestgetplatformCmd; +static Tcl_ObjCmdProc TestgetvarfullnameCmd; +static Tcl_CmdProc TestinterpdeleteCmd; +static Tcl_CmdProc TestlinkCmd; +static Tcl_ObjCmdProc TestlinkarrayCmd; +static Tcl_ObjCmdProc TestlocaleCmd; +static Tcl_CmdProc TestmainthreadCmd; +static Tcl_CmdProc TestsetmainloopCmd; +static Tcl_CmdProc TestexitmainloopCmd; +static Tcl_CmdProc TestpanicCmd; +static Tcl_ObjCmdProc TestparseargsCmd; +static Tcl_ObjCmdProc TestparserObjCmd; +static Tcl_ObjCmdProc TestparsevarObjCmd; +static Tcl_ObjCmdProc TestparsevarnameObjCmd; +static Tcl_ObjCmdProc TestpreferstableObjCmd; +static Tcl_ObjCmdProc TestprintObjCmd; +static Tcl_ObjCmdProc TestregexpObjCmd; +static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, - size_t length, int *cflagsPtr, int *eflagsPtr); -static int TestsaveresultCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static void TestsaveresultFree(void *blockPtr); -static int TestsetassocdataCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestsetCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int Testset2Cmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestseterrorcodeCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestsetobjerrorcodeCmd( - void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestsetplatformCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TeststaticpkgCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TesttranslatefilenameCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestupvarCmd(void *dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestWrongNumArgsObjCmd( - void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestGetIndexFromObjStructObjCmd( - void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestChannelCmd(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int TestChannelEventCmd(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int TestSocketCmd(void *clientData, - Tcl_Interp *interp, int argc, const char **argv); -static int TestFilesystemObjCmd(void *dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestSimpleFilesystemObjCmd( - void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); + int length, int *cflagsPtr, int *eflagsPtr); +static Tcl_ObjCmdProc TestsaveresultCmd; +static void TestsaveresultFree(char *blockPtr); +static Tcl_CmdProc TestsetassocdataCmd; +static Tcl_CmdProc TestsetCmd; +static Tcl_CmdProc Testset2Cmd; +static Tcl_CmdProc TestseterrorcodeCmd; +static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; +static Tcl_CmdProc TestsetplatformCmd; +static Tcl_CmdProc TeststaticpkgCmd; +static Tcl_CmdProc TesttranslatefilenameCmd; +static Tcl_CmdProc TestupvarCmd; +static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; +static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; +static Tcl_CmdProc TestChannelCmd; +static Tcl_CmdProc TestChannelEventCmd; +static Tcl_CmdProc TestSocketCmd; +static Tcl_ObjCmdProc TestFilesystemObjCmd; +static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); +static Tcl_ObjCmdProc TestgetencpathObjCmd; +static Tcl_ObjCmdProc TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; @@ -419,37 +318,23 @@ static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; static Tcl_FSListVolumesProc SimpleListVolumes; static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; -static int TestNumUtfCharsCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestFindFirstCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestFindLastCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestHashSystemHashCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestUtfNextCmd; +static Tcl_ObjCmdProc TestUtfPrevCmd; +static Tcl_ObjCmdProc TestNumUtfCharsCmd; +static Tcl_ObjCmdProc TestFindFirstCmd; +static Tcl_ObjCmdProc TestFindLastCmd; +static Tcl_ObjCmdProc TestHashSystemHashCmd; static Tcl_NRPostProc NREUnwind_callback; -static int TestNREUnwind(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestNRELevels(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestInterpResolverCmd(void *clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestNREUnwind; +static Tcl_ObjCmdProc TestNRELevels; +static Tcl_ObjCmdProc TestInterpResolverCmd; #if defined(HAVE_CPUID) || defined(_WIN32) -static int TestcpuidCmd(void *dummy, - Tcl_Interp* interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestcpuidCmd; #endif static const Tcl_Filesystem testReportingFilesystem = { "reporting", sizeof(Tcl_Filesystem), @@ -563,35 +448,33 @@ }; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } +#ifndef TCL_WITH_EXTERNAL_TOMMATH if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) { return TCL_ERROR; } +#endif if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } - objPtr = Tcl_NewStringObj("abc", 3); - (void)Tcl_GetByteArrayFromObj(objPtr, &index); - properByteArrayType = objPtr->typePtr; - Tcl_DecrRefCount(objPtr); - /* * Create additional commands and math functions for testing Tcl. */ Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, @@ -599,10 +482,12 @@ Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testbumpinterpepoch", + TestbumpinterpepochObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, @@ -698,10 +583,14 @@ INT2PTR(TCL_LEAVE_ERR_MSG), NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testutfnext", + TestUtfNextCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testutfprev", + TestUtfPrevCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", @@ -728,10 +617,14 @@ Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, NULL, NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { return TCL_ERROR; } @@ -828,14 +721,13 @@ * Creates, deletes, and invokes handlers. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestasyncCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { TestAsyncHandler *asyncPtr, *prevPtr; @@ -849,12 +741,12 @@ } if (strcmp(argv[1], "create") == 0) { if (argc != 3) { goto wrongNumArgs; } - asyncPtr = Tcl_Alloc(sizeof(TestAsyncHandler)); - asyncPtr->command = Tcl_Alloc(strlen(argv[2]) + 1); + asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler)); + asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; nextId++; asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, @@ -868,12 +760,12 @@ Tcl_MutexLock(&asyncTestMutex); while (firstHandler != NULL) { asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; Tcl_AsyncDelete(asyncPtr->handler); - Tcl_Free(asyncPtr->command); - Tcl_Free(asyncPtr); + ckfree(asyncPtr->command); + ckfree(asyncPtr); } Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; } if (argc != 3) { @@ -892,12 +784,12 @@ firstHandler = asyncPtr->nextPtr; } else { prevPtr->nextPtr = asyncPtr->nextPtr; } Tcl_AsyncDelete(asyncPtr->handler); - Tcl_Free(asyncPtr->command); - Tcl_Free(asyncPtr); + ckfree(asyncPtr->command); + ckfree(asyncPtr); break; } Tcl_MutexUnlock(&asyncTestMutex); } else if (strcmp(argv[1], "mark") == 0) { if (argc != 5) { @@ -964,12 +856,11 @@ * executed, or NULL. */ int code) /* Current return code from command. */ { TestAsyncHandler *asyncPtr; int id = PTR2INT(clientData); - const char *listArgv[4]; - char *cmd; + const char *listArgv[4], *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { @@ -984,11 +875,11 @@ return TCL_OK; } TclFormatInt(string, code); listArgv[0] = asyncPtr->command; - listArgv[1] = Tcl_GetStringResult(interp); + listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp)); listArgv[2] = string; listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); if (interp != NULL) { code = Tcl_EvalEx(interp, cmd, -1, 0); @@ -996,11 +887,11 @@ /* * this should not happen, but by definition of how async handlers are * invoked, it's possible. Better error checking is needed here. */ } - Tcl_Free(cmd); + ckfree(cmd); return code; } /* *---------------------------------------------------------------------- @@ -1039,10 +930,27 @@ Tcl_MutexUnlock(&asyncTestMutex); Tcl_ExitThread(TCL_OK); TCL_THREAD_CREATE_RETURN; } #endif + +static int +TestbumpinterpepochObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Interp *iPtr = (Interp *)interp; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + iPtr->compileEpoch++; + return TCL_OK; +} /* *---------------------------------------------------------------------- * * TestcmdinfoCmd -- @@ -1058,14 +966,13 @@ * Creates and deletes various commands and modifies their data. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestcmdinfoCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; @@ -1129,29 +1036,27 @@ return TCL_ERROR; } return TCL_OK; } - /*ARGSUSED*/ static int CmdProc1( void *clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL); return TCL_OK; } - /*ARGSUSED*/ static int CmdProc2( void *clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL); return TCL_OK; } @@ -1188,14 +1093,13 @@ * Creates and deletes various commands and modifies their data. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestcmdtokenCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Command token; @@ -1252,14 +1156,13 @@ * a procedure by the command trace. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestcmdtraceCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_DString buffer; @@ -1347,17 +1250,16 @@ static void CmdTraceProc( void *clientData, /* Pointer to buffer in which the * command and arguments are appended. * Accumulates test result. */ - Tcl_Interp *interp, /* Current interpreter. */ - int level, /* Current trace level. */ + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int) /*level*/, char *command, /* The command being traced (after * substitutions). */ - Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */ - void *cmdClientData, /* Client data associated with command - * procedure. */ + TCL_UNUSED(Tcl_CmdProc *) /*cmdProc*/, + TCL_UNUSED(ClientData), int argc, /* Number of arguments. */ const char *argv[]) /* Argument strings. */ { Tcl_DString *bufPtr = (Tcl_DString *) clientData; int i; @@ -1371,20 +1273,18 @@ Tcl_DStringEndSublist(bufPtr); } static void CmdTraceDeleteProc( - void *clientData, /* Unused. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int level, /* Current trace level. */ - char *command, /* The command being traced (after - * substitutions). */ - Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */ - void *cmdClientData, /* Client data associated with command - * procedure. */ - int argc, /* Number of arguments. */ - const char *argv[]) /* Argument strings. */ + TCL_UNUSED(int) /*level*/, + TCL_UNUSED(char *) /*command*/, + TCL_UNUSED(Tcl_CmdProc *), + TCL_UNUSED(ClientData), + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { /* * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace * callback causes the for loop in TclNRExecuteByteCode that calls traces to * reference freed memory. @@ -1393,17 +1293,17 @@ Tcl_DeleteTrace(interp, cmdTrace); } static int ObjTraceProc( - void *clientData, /* unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ - int level, /* Execution level */ - const char *command, /* Command being executed */ - Tcl_Command token, /* Command information */ - int objc, /* Parameter count */ - Tcl_Obj *const objv[]) /* Parameter list */ + TCL_UNUSED(int) /*level*/, + const char *command, + TCL_UNUSED(Tcl_Command), + TCL_UNUSED(int) /*objc*/, + Tcl_Obj *const objv[]) /* Argument objects. */ { const char *word = Tcl_GetString(objv[0]); if (!strcmp(word, "Error")) { Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); @@ -1450,11 +1350,11 @@ *---------------------------------------------------------------------- */ static int TestcreatecommandCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { @@ -1480,14 +1380,14 @@ return TCL_OK; } static int CreatedCommandProc( - void *clientData, /* String to return. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { Tcl_CmdInfo info; int found; found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand", @@ -1502,14 +1402,14 @@ return TCL_OK; } static int CreatedCommandProc2( - void *clientData, /* String to return. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { Tcl_CmdInfo info; int found; found = Tcl_GetCommandInfo(interp, "value:at:", &info); @@ -1538,14 +1438,13 @@ * Creates and deletes interpreters. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestdcallCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int i, id; @@ -1603,14 +1502,13 @@ * Creates a command. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestdelCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { DelCmd *dPtr; @@ -1624,13 +1522,13 @@ slave = Tcl_GetSlave(interp, argv[1]); if (slave == NULL) { return TCL_ERROR; } - dPtr = Tcl_Alloc(sizeof(DelCmd)); + dPtr = (DelCmd *)ckalloc(sizeof(DelCmd)); dPtr->interp = interp; - dPtr->deleteCmd = Tcl_Alloc(strlen(argv[3]) + 1); + dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1); strcpy(dPtr->deleteCmd, argv[3]); Tcl_CreateCommand(slave, argv[2], DelCmdProc, dPtr, DelDeleteProc); return TCL_OK; @@ -1638,31 +1536,31 @@ static int DelCmdProc( void *clientData, /* String result to return. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { DelCmd *dPtr = (DelCmd *) clientData; Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); - Tcl_Free(dPtr->deleteCmd); - Tcl_Free(dPtr); + ckfree(dPtr->deleteCmd); + ckfree(dPtr); return TCL_OK; } static void DelDeleteProc( void *clientData) /* String command to evaluate. */ { - DelCmd *dPtr = clientData; + DelCmd *dPtr = (DelCmd *)clientData; Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); - Tcl_Free(dPtr->deleteCmd); - Tcl_Free(dPtr); + ckfree(dPtr->deleteCmd); + ckfree(dPtr); } /* *---------------------------------------------------------------------- * @@ -1681,11 +1579,11 @@ *---------------------------------------------------------------------- */ static int TestdelassocdataCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { @@ -1717,18 +1615,15 @@ * *----------------------------------------------------------------------------- */ static int -TestdoubledigitsObjCmd(void *unused, - /* NULL */ - Tcl_Interp* interp, - /* Tcl interpreter */ - int objc, - /* Parameter count */ - Tcl_Obj* const objv[]) - /* Parameter vector */ +TestdoubledigitsObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj* const objv[]) /* Parameter vector */ { static const char* options[] = { "shortest", "e", "f", @@ -1776,15 +1671,15 @@ if (objc > 4) { if (strcmp(Tcl_GetString(objv[4]), "shorten")) { Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1)); return TCL_ERROR; } - type |= TCL_DD_SHORTEN_FLAG; + type |= TCL_DD_SHORTEST; } str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr); strObj = Tcl_NewStringObj(str, endPtr-str); - Tcl_Free(str); + ckfree(str); retval = Tcl_NewListObj(1, &strObj); Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt)); strObj = Tcl_NewStringObj(signum ? "-" : "+", 1); Tcl_ListObjAppendElement(NULL, retval, strObj); Tcl_SetObjResult(interp, retval); @@ -1806,14 +1701,13 @@ * Creates, deletes, and invokes handlers. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestdstringCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int count; @@ -1858,15 +1752,15 @@ if (strcmp(argv[2], "staticsmall") == 0) { Tcl_AppendResult(interp, "short", NULL); } else if (strcmp(argv[2], "staticlarge") == 0) { Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL); } else if (strcmp(argv[2], "free") == 0) { - char *s = Tcl_Alloc(100); + char *s = (char *)ckalloc(100); strcpy(s, "This is a malloc-ed string"); Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { - char *s = (char*)Tcl_Alloc(100) + 16; + char *s = (char*)ckalloc(100) + 16; strcpy(s, "This is a specially-allocated string"); Tcl_SetResult(interp, s, SpecialFree); } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", @@ -1910,14 +1804,14 @@ /* * The procedure below is used as a special freeProc to test how well * Tcl_DStringGetResult handles freeProc's other than free. */ -static void SpecialFree(blockPtr) - void *blockPtr; /* Block to free. */ -{ - Tcl_Free(((char *)blockPtr) - 16); +static void SpecialFree( + char *blockPtr /* Block to free. */ +) { + ckfree(blockPtr - 16); } /* *---------------------------------------------------------------------- * @@ -1933,14 +1827,13 @@ * Load encodings. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestencodingObjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; @@ -1964,19 +1857,19 @@ Tcl_EncodingType type; if (objc != 5) { return TCL_ERROR; } - encodingPtr = Tcl_Alloc(sizeof(TclEncoding)); + encodingPtr = (TclEncoding*)ckalloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); - encodingPtr->toUtfCmd = Tcl_Alloc(length + 1); + encodingPtr->toUtfCmd = (char *)ckalloc(length + 1); memcpy(encodingPtr->toUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[4], &length); - encodingPtr->fromUtfCmd = Tcl_Alloc(length + 1); + encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1); memcpy(encodingPtr->fromUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[2], &length); type.encodingName = string; @@ -2005,14 +1898,14 @@ } static int EncodingToUtfProc( void *clientData, /* TclEncoding structure. */ - const char *src, /* Source string in specified encoding. */ + TCL_UNUSED(const char *) /*src*/, int srcLen, /* Source string length in bytes. */ - int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Current state. */ + TCL_UNUSED(int) /*flags*/, + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer. */ int dstLen, /* The maximum length of output buffer. */ int *srcReadPtr, /* Filled with number of bytes read. */ int *dstWrotePtr, /* Filled with number of bytes stored. */ int *dstCharsPtr) /* Filled with number of chars stored. */ @@ -2037,14 +1930,14 @@ } static int EncodingFromUtfProc( void *clientData, /* TclEncoding structure. */ - const char *src, /* Source string in specified encoding. */ + TCL_UNUSED(const char *) /*src*/, int srcLen, /* Source string length in bytes. */ - int flags, /* Conversion control flags. */ - Tcl_EncodingState *statePtr,/* Current state. */ + TCL_UNUSED(int) /*flags*/, + TCL_UNUSED(Tcl_EncodingState *), char *dst, /* Output buffer. */ int dstLen, /* The maximum length of output buffer. */ int *srcReadPtr, /* Filled with number of bytes read. */ int *dstWrotePtr, /* Filled with number of bytes stored. */ int *dstCharsPtr) /* Filled with number of chars stored. */ @@ -2070,15 +1963,15 @@ static void EncodingFreeProc( void *clientData) /* ClientData associated with type. */ { - TclEncoding *encodingPtr = clientData; + TclEncoding *encodingPtr = (TclEncoding *)clientData; - Tcl_Free(encodingPtr->toUtfCmd); - Tcl_Free(encodingPtr->fromUtfCmd); - Tcl_Free(encodingPtr); + ckfree(encodingPtr->toUtfCmd); + ckfree(encodingPtr->fromUtfCmd); + ckfree(encodingPtr); } /* *---------------------------------------------------------------------- * @@ -2096,11 +1989,11 @@ *---------------------------------------------------------------------- */ static int TestevalexObjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, flags; @@ -2141,11 +2034,11 @@ *---------------------------------------------------------------------- */ static int TestevalobjvObjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int evalGlobal; @@ -2190,11 +2083,11 @@ *---------------------------------------------------------------------- */ static int TesteventObjCmd( - void *unused, /* Not used */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { static const char *const subcommands[] = { /* Possible subcommands */ @@ -2229,11 +2122,11 @@ } if (Tcl_GetIndexFromObj(interp, objv[3], positions, "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } - ev = Tcl_Alloc(sizeof(TestEvent)); + ev = (TestEvent *)ckalloc(sizeof(TestEvent)); ev->header.proc = TesteventProc; ev->header.nextPtr = NULL; ev->interp = interp; ev->command = objv[4]; Tcl_IncrRefCount(ev->command); @@ -2275,11 +2168,11 @@ */ static int TesteventProc( Tcl_Event *event, /* Event to deliver */ - int flags) /* Current flags for Tcl_ServiceEvent */ + TCL_UNUSED(int) /*flags*/) { TestEvent *ev = (TestEvent *) event; Tcl_Interp *interp = ev->interp; Tcl_Obj *command = ev->command; int result = Tcl_EvalObjEx(interp, command, @@ -2369,11 +2262,11 @@ *---------------------------------------------------------------------- */ static int TestexithandlerCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int value; @@ -2403,29 +2296,29 @@ static void ExitProcOdd( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; - size_t len; + int len; - sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData)); + sprintf(buf, "odd %d\n", (int)PTR2INT(clientData)); len = strlen(buf); - if (len != (size_t) write(1, buf, len)) { + if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcOdd: unable to write to stdout"); } } static void ExitProcEven( void *clientData) /* Integer value to print. */ { char buf[16 + TCL_INTEGER_SPACE]; - size_t len; + int len; - sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData)); + sprintf(buf, "even %d\n", (int)PTR2INT(clientData)); len = strlen(buf); - if (len != (size_t) write(1, buf, len)) { + if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcEven: unable to write to stdout"); } } /* @@ -2445,11 +2338,11 @@ *---------------------------------------------------------------------- */ static int TestexprlongCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { long exprResult; @@ -2488,11 +2381,11 @@ *---------------------------------------------------------------------- */ static int TestexprlongobjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { long exprResult; @@ -2530,11 +2423,11 @@ *---------------------------------------------------------------------- */ static int TestexprdoubleCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { double exprResult; @@ -2574,11 +2467,11 @@ *---------------------------------------------------------------------- */ static int TestexprdoubleobjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { double exprResult; @@ -2616,11 +2509,11 @@ *---------------------------------------------------------------------- */ static int TestexprstringCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { @@ -2648,11 +2541,11 @@ *---------------------------------------------------------------------- */ static int TestfilelinkCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *contents; @@ -2715,11 +2608,11 @@ *---------------------------------------------------------------------- */ static int TestgetassocdataCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *res; @@ -2753,11 +2646,11 @@ *---------------------------------------------------------------------- */ static int TestgetplatformCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static const char *const platformStrings[] = { "unix", "mac", "windows" }; @@ -2791,14 +2684,13 @@ * Deletes one or more interpreters. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestinterpdeleteCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Interp *slaveToDelete; @@ -2832,14 +2724,13 @@ * values of the linked variables. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestlinkCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static int intVar = 43; @@ -2849,11 +2740,11 @@ static char *stringVar = NULL; static char charVar = '@'; static unsigned char ucharVar = 130; static short shortVar = 3000; static unsigned short ushortVar = 60000; - static unsigned int uintVar = 0xbeeffeed; + static unsigned int uintVar = 0xBEEFFEED; static long longVar = 123456789L; static unsigned long ulongVar = 3456789012UL; static float floatVar = 4.5; static Tcl_WideUInt uwideVar = 123; static int created = 0; @@ -2894,115 +2785,115 @@ created = 1; if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "int", (char *) &intVar, + if (Tcl_LinkVar(interp, "int", &intVar, TCL_LINK_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[3], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "real", (char *) &realVar, + if (Tcl_LinkVar(interp, "real", &realVar, TCL_LINK_DOUBLE | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[4], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "bool", (char *) &boolVar, + if (Tcl_LinkVar(interp, "bool", &boolVar, TCL_LINK_BOOLEAN | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[5], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "string", (char *) &stringVar, + if (Tcl_LinkVar(interp, "string", &stringVar, TCL_LINK_STRING | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "wide", (char *) &wideVar, + if (Tcl_LinkVar(interp, "wide", &wideVar, TCL_LINK_WIDE_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "char", (char *) &charVar, + if (Tcl_LinkVar(interp, "char", &charVar, TCL_LINK_CHAR | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[8], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "uchar", (char *) &ucharVar, + if (Tcl_LinkVar(interp, "uchar", &ucharVar, TCL_LINK_UCHAR | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[9], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "short", (char *) &shortVar, + if (Tcl_LinkVar(interp, "short", &shortVar, TCL_LINK_SHORT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[10], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "ushort", (char *) &ushortVar, + if (Tcl_LinkVar(interp, "ushort", &ushortVar, TCL_LINK_USHORT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[11], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "uint", (char *) &uintVar, + if (Tcl_LinkVar(interp, "uint", &uintVar, TCL_LINK_UINT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[12], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "long", (char *) &longVar, + if (Tcl_LinkVar(interp, "long", &longVar, TCL_LINK_LONG | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[13], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "ulong", (char *) &ulongVar, + if (Tcl_LinkVar(interp, "ulong", &ulongVar, TCL_LINK_ULONG | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[14], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "float", (char *) &floatVar, + if (Tcl_LinkVar(interp, "float", &floatVar, TCL_LINK_FLOAT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[15], &writable) != TCL_OK) { return TCL_ERROR; } flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; - if (Tcl_LinkVar(interp, "uwide", (char *) &uwideVar, + if (Tcl_LinkVar(interp, "uwide", &uwideVar, TCL_LINK_WIDE_UINT | flag) != TCL_OK) { return TCL_ERROR; } } else if (strcmp(argv[1], "delete") == 0) { @@ -3082,16 +2973,16 @@ return TCL_ERROR; } } if (argv[5][0] != 0) { if (stringVar != NULL) { - Tcl_Free(stringVar); + ckfree(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = Tcl_Alloc(strlen(argv[5]) + 1); + stringVar = (char *)ckalloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } } if (argv[6][0] != 0) { tmp = Tcl_NewStringObj(argv[6], -1); @@ -3189,16 +3080,16 @@ } Tcl_UpdateLinkedVar(interp, "bool"); } if (argv[5][0] != 0) { if (stringVar != NULL) { - Tcl_Free(stringVar); + ckfree(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = Tcl_Alloc(strlen(argv[5]) + 1); + stringVar = (char *)ckalloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } Tcl_UpdateLinkedVar(interp, "string"); } if (argv[6][0] != 0) { @@ -3303,11 +3194,11 @@ *---------------------------------------------------------------------- */ static int TestlinkarrayCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *LinkOption[] = { @@ -3421,18 +3312,17 @@ *---------------------------------------------------------------------- */ static int TestlocaleCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int index; const char *locale; - static const char *const optionStrings[] = { "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; static const int lcTypes[] = { @@ -3480,17 +3370,17 @@ * Side effects: * Releases storage. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ + static void CleanupTestSetassocdataTests( void *clientData, /* Data to be released. */ - Tcl_Interp *interp) /* Interpreter being deleted. */ + TCL_UNUSED(Tcl_Interp *)) { - Tcl_Free(clientData); + ckfree(clientData); } /* *---------------------------------------------------------------------- * @@ -3508,11 +3398,11 @@ *---------------------------------------------------------------------- */ static int TestparserObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; @@ -3564,11 +3454,11 @@ *---------------------------------------------------------------------- */ static int TestexprparserObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; @@ -3711,11 +3601,11 @@ *---------------------------------------------------------------------- */ static int TestparsevarObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *value, *name, *termPtr; @@ -3752,11 +3642,11 @@ *---------------------------------------------------------------------- */ static int TestparsevarnameObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; @@ -3815,16 +3705,17 @@ *---------------------------------------------------------------------- */ static int TestpreferstableObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* The argument objects. */ + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { Interp *iPtr = (Interp *) interp; + iPtr->packagePrefer = PKG_PREFER_STABLE; return TCL_OK; } /* @@ -3844,11 +3735,11 @@ *---------------------------------------------------------------------- */ static int TestprintObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_WideInt argv1 = 0; @@ -3883,20 +3774,18 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestregexpObjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, indices, stringLength, match, about; - size_t ii; + int i, ii, indices, stringLength, match, about; int hasxflags, cflags, eflags; Tcl_RegExp regExpr; const char *string; Tcl_Obj *objPtr; Tcl_RegExpInfo info; @@ -4005,16 +3894,16 @@ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { const char *varName; const char *value; - size_t start, end; + int start, end; char resinfo[TCL_INTEGER_SPACE * 2]; varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, -1, &start, &end); - sprintf(resinfo, "%" TCL_LL_MODIFIER "d %" TCL_LL_MODIFIER "d", TclWideIntFromSize(start), TclWideIntFromSize(end-1)); + sprintf(resinfo, "%d %d", start, end-1); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); return TCL_ERROR; @@ -4024,11 +3913,11 @@ const char *value; char resinfo[TCL_INTEGER_SPACE * 2]; Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); - sprintf(resinfo, "%" TCL_LL_MODIFIER "d", TclWideIntFromSize(info.extendStart)); + sprintf(resinfo, "%ld", info.extendStart); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); return TCL_ERROR; @@ -4045,23 +3934,23 @@ objc -= 2; objv += 2; Tcl_RegExpGetInfo(regExpr, &info); for (i = 0; i < objc; i++) { - size_t start, end; + int start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; varPtr = objv[i]; - ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i; + ii = ((cflags®_EXPECT) && i == objc-1) ? -1 : i; if (indices) { Tcl_Obj *objs[2]; - if (ii == TCL_INDEX_NONE) { + if (ii == -1) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); } else if (ii > info.nsubs) { - start = TCL_INDEX_NONE; - end = TCL_INDEX_NONE; + start = -1; + end = -1; } else { start = info.matches[ii].start; end = info.matches[ii].end; } @@ -4068,20 +3957,20 @@ /* * Adjust index so it refers to the last character in the match * instead of the first character after the match. */ - if (end != TCL_INDEX_NONE) { + if (end >= 0) { end--; } - objs[0] = TclNewWideIntObjFromSize(start); - objs[1] = TclNewWideIntObjFromSize(end); + objs[0] = Tcl_NewWideIntObj(start); + objs[1] = Tcl_NewWideIntObj(end); newPtr = Tcl_NewListObj(2, objs); } else { - if (ii == TCL_INDEX_NONE) { + if (ii == -1) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); } else if (ii > info.nsubs) { newPtr = Tcl_NewObj(); } else { @@ -4121,16 +4010,15 @@ */ static void TestregexpXflags( const char *string, /* The string of flags. */ - size_t length, /* The length of the string in bytes. */ + int length, /* The length of the string in bytes. */ int *cflagsPtr, /* compile flags word */ int *eflagsPtr) /* exec flags word */ { - size_t i; - int cflags, eflags; + int i, cflags, eflags; cflags = *cflagsPtr; eflags = *eflagsPtr; for (i = 0; i < length; i++) { switch (string[i]) { @@ -4209,17 +4097,16 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestreturnObjCmd( - void *dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { return TCL_RETURN; } /* @@ -4240,11 +4127,11 @@ *---------------------------------------------------------------------- */ static int TestsetassocdataCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *buf, *oldData; @@ -4254,21 +4141,21 @@ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], " data_key data_item\"", NULL); return TCL_ERROR; } - buf = Tcl_Alloc(strlen(argv[2]) + 1); + buf = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* * If we previously associated a malloced value with the variable, * free it before associating a new value. */ oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr); if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) { - Tcl_Free(oldData); + ckfree(oldData); } Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, buf); return TCL_OK; } @@ -4291,11 +4178,11 @@ *---------------------------------------------------------------------- */ static int TestsetplatformCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { size_t length; @@ -4340,11 +4227,11 @@ *---------------------------------------------------------------------- */ static int TeststaticpkgCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int safe, loaded; @@ -4391,11 +4278,11 @@ *---------------------------------------------------------------------- */ static int TesttranslatefilenameCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_DString buffer; @@ -4430,14 +4317,13 @@ * Creates or modifies an "upvar" reference. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestupvarCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = 0; @@ -4483,14 +4369,13 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestseterrorcodeCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc > 6) { @@ -4536,14 +4421,13 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestsetobjerrorcodeCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1)); @@ -4565,14 +4449,13 @@ * Creates and deletes interpreters. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestfeventCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static Tcl_Interp *interp2 = NULL; @@ -4640,32 +4523,30 @@ *---------------------------------------------------------------------- */ static int TestpanicCmd( - void *dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - char *argString; - /* * Put the arguments into a var args structure * Append all of the arguments together separated by spaces */ - argString = Tcl_Merge(argc-1, argv+1); + char *argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); - Tcl_Free(argString); + ckfree(argString); return TCL_OK; } static int TestfileCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ Tcl_Obj *const argv[]) /* The argument objects. */ { int force, i, j, result; @@ -4743,11 +4624,11 @@ *---------------------------------------------------------------------- */ static int TestgetvarfullnameCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *name, *arg; @@ -4817,14 +4698,14 @@ *---------------------------------------------------------------------- */ static int GetTimesObjCmd( - void *unused, /* Unused. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* The current interpreter. */ - int notused1, /* Number of arguments. */ - Tcl_Obj *const notused2[]) /* The argument objects. */ + TCL_UNUSED(int) /*cobjc*/, + TCL_UNUSED(Tcl_Obj *const *) /*cobjv*/) { Interp *iPtr = (Interp *) interp; int i, n; double timePer; Tcl_Time start, stop; @@ -4834,33 +4715,33 @@ /* alloc & free 100000 times */ fprintf(stderr, "alloc & free 100000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - objPtr = Tcl_Alloc(sizeof(Tcl_Obj)); - Tcl_Free(objPtr); + objPtr = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); + ckfree(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per alloc+free\n", timePer/100000); /* alloc 5000 times */ fprintf(stderr, "alloc 5000 6 word items\n"); - objv = Tcl_Alloc(5000 * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)ckalloc(5000 * sizeof(Tcl_Obj *)); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - objv[i] = Tcl_Alloc(sizeof(Tcl_Obj)); + objv[i] = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per alloc\n", timePer/5000); /* free 5000 times */ fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - Tcl_Free(objv[i]); + ckfree(objv[i]); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per free\n", timePer/5000); @@ -4882,11 +4763,11 @@ Tcl_DecrRefCount(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); - Tcl_Free(objv); + ckfree(objv); /* TclGetString 100000 times */ fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n"); objPtr = Tcl_NewStringObj("12345", -1); Tcl_GetTime(&start); @@ -4996,14 +4877,14 @@ *---------------------------------------------------------------------- */ static int NoopCmd( - void *unused, /* Unused. */ - Tcl_Interp *interp, /* The current interpreter. */ - int argc, /* The number of arguments. */ - const char **argv) /* The argument strings. */ + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { return TCL_OK; } /* @@ -5023,14 +4904,14 @@ *---------------------------------------------------------------------- */ static int NoopObjCmd( - void *unused, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* The argument objects. */ + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { return TCL_OK; } /* @@ -5048,11 +4929,11 @@ *---------------------------------------------------------------------- */ static int TeststringbytesObjCmd( - void *unused, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n; @@ -5088,11 +4969,11 @@ *---------------------------------------------------------------------- */ static int TestpurebytesobjObjCmd( - ClientData unused, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *objPtr; @@ -5108,17 +4989,61 @@ */ memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep)); if (objc == 2) { const char *s = Tcl_GetString(objv[1]); objPtr->length = objv[1]->length; - objPtr->bytes = Tcl_Alloc(objPtr->length + 1); + objPtr->bytes = (char *)ckalloc(objPtr->length + 1); memcpy(objPtr->bytes, s, objPtr->length); objPtr->bytes[objPtr->length] = 0; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * TestsetbytearraylengthObjCmd -- + * + * Testing command 'testsetbytearraylength` used to test the public + * interface routine Tcl_SetByteArrayLength(). + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestsetbytearraylengthObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n; + Tcl_Obj *obj = NULL; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "value length"); + return TCL_ERROR; + } + if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &n)) { + return TCL_ERROR; + } + if (Tcl_IsShared(objv[1])) { + obj = Tcl_DuplicateObj(objv[1]); + } else { + obj = objv[1]; + } + Tcl_SetByteArrayLength(obj, n); + Tcl_SetObjResult(interp, obj); + return TCL_OK; +} /* *---------------------------------------------------------------------- * * TestbytestringObjCmd -- @@ -5135,11 +5060,11 @@ *---------------------------------------------------------------------- */ static int TestbytestringObjCmd( - void *unused, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n = 0; @@ -5147,13 +5072,13 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytearray"); return TCL_ERROR; } - p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n); - if ((p == NULL) || !Tcl_FetchIntRep(objv[1], properByteArrayType)) { - Tcl_AppendResult(interp, "testbytestring expects bytes", NULL); + + p = (const char *)TclGetBytesFromObj(interp, objv[1], &n); + if (p == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); return TCL_OK; } @@ -5173,15 +5098,14 @@ * Variables may be set. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; @@ -5209,11 +5133,11 @@ } } static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ - register Tcl_Interp *interp,/* Current interpreter. */ + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; @@ -5256,18 +5180,18 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestsaveresultCmd( - void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + TCL_UNUSED(ClientData), + Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { + Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; static const char *const optionStrings[] = { "append", "dynamic", "free", "object", "small", NULL @@ -5300,11 +5224,11 @@ break; case RESULT_APPEND: Tcl_AppendResult(interp, "append result", NULL); break; case RESULT_FREE: { - char *buf = Tcl_Alloc(200); + char *buf = (char *)ckalloc(200); strcpy(buf, "free result"); Tcl_SetResult(interp, buf, TCL_DYNAMIC); break; } @@ -5331,13 +5255,16 @@ Tcl_RestoreResult(interp, &state); result = TCL_OK; } switch ((enum options) index) { - case RESULT_DYNAMIC: - Tcl_AppendElement(interp, freeCount ? "freed" : "leak"); + case RESULT_DYNAMIC: { + int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount; + + Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak"); break; + } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); break; default: @@ -5362,11 +5289,11 @@ *---------------------------------------------------------------------- */ static void TestsaveresultFree( - void *blockPtr) + TCL_UNUSED(char *)) { freeCount++; } /* @@ -5386,14 +5313,14 @@ *---------------------------------------------------------------------- */ static int TestmainthreadCmd( - void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + TCL_UNUSED(ClientData), + Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(const char **) /*argv*/) { if (argc == 1) { Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); Tcl_SetObjResult(interp, idObj); @@ -5447,18 +5374,18 @@ *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( - void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - exitMainLoop = 0; - Tcl_SetMainLoop(MainLoop); - return TCL_OK; + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) +{ + exitMainLoop = 0; + Tcl_SetMainLoop(MainLoop); + return TCL_OK; } /* *---------------------------------------------------------------------- * @@ -5476,17 +5403,17 @@ *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( - void *dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(ClientData), + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { - exitMainLoop = 1; - return TCL_OK; + exitMainLoop = 1; + return TCL_OK; } /* *---------------------------------------------------------------------- * @@ -5502,14 +5429,13 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestChannelCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter for result. */ int argc, /* Count of additional args. */ const char **argv) /* Additional arg strings. */ { const char *cmdName; /* Sub command. */ @@ -5549,11 +5475,11 @@ if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) { *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; - Tcl_Free(curPtr); + ckfree(curPtr); break; } } } else { chan = Tcl_GetChannel(interp, argv[2], &mode); @@ -5564,11 +5490,10 @@ chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; chan = (Tcl_Channel) chanPtr; } else { - /* lint */ statePtr = NULL; chan = NULL; } if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) { @@ -5619,11 +5544,11 @@ Tcl_CutChannel(chan); /* Remember the channel in the pool of detached channels */ - det = Tcl_Alloc(sizeof(TestChannel)); + det = (TestChannel *)ckalloc(sizeof(TestChannel)); det->chan = chan; det->nextPtr = firstDetached; firstDetached = det; return TCL_OK; @@ -5811,11 +5736,11 @@ return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr)); + Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr)); } return TCL_OK; } if ((cmdName[0] == 'o') && @@ -5852,11 +5777,11 @@ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chanPtr = (Channel *) Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; if (statePtr->flags & TCL_READABLE) { - Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr)); + Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr)); } } return TCL_OK; } @@ -5909,11 +5834,11 @@ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chanPtr = (Channel *) Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; if (statePtr->flags & TCL_WRITABLE) { - Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr)); + Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr)); } } return TCL_OK; } @@ -5971,14 +5896,13 @@ * Creates, deletes and returns channel event handlers. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestChannelEventCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Obj *resultListPtr; @@ -6017,11 +5941,11 @@ Tcl_AppendResult(interp, "bad event name \"", argv[3], "\": must be readable, writable, or none", NULL); return TCL_ERROR; } - esPtr = Tcl_Alloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; esPtr->chanPtr = chanPtr; esPtr->interp = interp; @@ -6074,11 +5998,11 @@ prevEsPtr->nextPtr = esPtr->nextPtr; } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - Tcl_Free(esPtr); + ckfree(esPtr); return TCL_OK; } if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) { @@ -6115,11 +6039,11 @@ esPtr = nextEsPtr) { nextEsPtr = esPtr->nextPtr; Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - Tcl_Free(esPtr); + ckfree(esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; } @@ -6184,14 +6108,13 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TestSocketCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Interpreter for result. */ int argc, /* Count of additional args. */ const char **argv) /* Additional arg strings. */ { const char *cmdName; /* Sub command. */ @@ -6254,11 +6177,11 @@ *---------------------------------------------------------------------- */ static int TestWrongNumArgsObjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, length; @@ -6310,11 +6233,11 @@ *---------------------------------------------------------------------- */ static int TestGetIndexFromObjStructObjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *const ary[] = { @@ -6364,11 +6287,11 @@ *---------------------------------------------------------------------- */ static int TestFilesystemObjCmd( - void *dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int res, boolVal; @@ -6443,11 +6366,11 @@ /* Free the path */ Tcl_DecrRefCount(nativeRep); } } -static ClientData +static void * TestReportDupInternalRep( void *clientData) { Tcl_Obj *original = (Tcl_Obj *) clientData; @@ -6464,15 +6387,10 @@ Tcl_Interp *interp = (Tcl_Interp *) Tcl_FSData(&testReportingFilesystem); if (interp == NULL) { /* This is bad, but not much we can do about it */ } else { - /* - * No idea why I decided to program this up using the old string-based - * API, but there you go. We should convert it to objects. - */ - Tcl_Obj *savedResult; Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1); @@ -6700,11 +6618,11 @@ return Tcl_FSUtime(TestReportGetNativePath(fileName), tval); } static int TestReportNormalizePath( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *pathPtr, int nextCheckpoint) { TestReport("normalizepath", pathPtr, NULL); return nextCheckpoint; @@ -6711,11 +6629,11 @@ } static int SimplePathInFilesystem( Tcl_Obj *pathPtr, - void **clientDataPtr) + TCL_UNUSED(ClientData *)) { const char *str = Tcl_GetString(pathPtr); if (strncmp(str, "simplefs:/", 10)) { return -1; @@ -6740,11 +6658,11 @@ * important features. */ static int TestSimpleFilesystemObjCmd( - void *dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int res, boolVal; @@ -6893,29 +6811,136 @@ retVal = Tcl_NewStringObj("simplefs:/", -1); Tcl_IncrRefCount(retVal); return retVal; } + +/* + * Used to check operations of Tcl_UtfNext. + * + * Usage: testutfnext -bytestring $bytes + */ + +static int +TestUtfNextCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int numBytes; + char *bytes; + const char *result, *first; + char buffer[32]; + static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF"; + const char *p = tobetested; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes"); + return TCL_ERROR; + } + bytes = Tcl_GetStringFromObj(objv[1], &numBytes); + + if (numBytes > (int)sizeof(buffer) - 4) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"testutfnext\" can only handle %d bytes", + (int)sizeof(buffer) - 4)); + return TCL_ERROR; + } + + memcpy(buffer + 1, bytes, numBytes); + buffer[0] = buffer[numBytes + 1] = buffer[numBytes + 2] = buffer[numBytes + 3] = '\xA0'; + + first = result = Tcl_UtfNext(buffer + 1); + while ((buffer[0] = *p++) != '\0') { + /* Run Tcl_UtfNext with many more possible bytes at src[-1], all should give the same result */ + result = Tcl_UtfNext(buffer + 1); + if (first != result) { + Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", NULL); + return TCL_ERROR; + } + } + p = tobetested; + while ((buffer[numBytes + 1] = *p++) != '\0') { + /* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */ + result = Tcl_UtfNext(buffer + 1); + if (first != result) { + first = buffer; + break; + } + } + + Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1)); + + return TCL_OK; +} +/* + * Used to check operations of Tcl_UtfPrev. + * + * Usage: testutfprev $bytes $offset + */ + +static int +TestUtfPrevCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int numBytes, offset; + char *bytes; + const char *result; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?"); + return TCL_ERROR; + } + + bytes = Tcl_GetStringFromObj(objv[1], &numBytes); + + if (objc == 3) { + if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) { + return TCL_ERROR; + } + if (offset < 0) { + offset = 0; + } + if (offset > numBytes) { + offset = numBytes; + } + } else { + offset = numBytes; + } + result = TclUtfPrev(bytes + offset, bytes); + Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes)); + return TCL_OK; +} /* * Used to check correct string-length determining in Tcl_NumUtfChars */ static int TestNumUtfCharsCmd( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { - int len = -1; + int numBytes, len, limit = -1; + const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); if (objc > 2) { - (void) Tcl_GetIntFromObj(interp, objv[2], &len); + if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) { + return TCL_ERROR; + } + if (limit > numBytes + 1) { + limit = numBytes + 1; + } } - len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len); + len = Tcl_NumUtfChars(bytes, limit); Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); } return TCL_OK; } @@ -6923,11 +6948,11 @@ * Used to check correct operation of Tcl_UtfFindFirst */ static int TestFindFirstCmd( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -6945,11 +6970,11 @@ * Used to check correct operation of Tcl_UtfFindLast */ static int TestFindLastCmd( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -6987,11 +7012,11 @@ *---------------------------------------------------------------------- */ static int TestcpuidCmd( - void *dummy, + TCL_UNUSED(ClientData), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int status, index, i; @@ -7023,11 +7048,11 @@ * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag */ static int TestHashSystemHashCmd( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { @@ -7059,11 +7084,11 @@ return TCL_ERROR; } Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } - if (hash.numEntries != (size_t)limit) { + if (hash.numEntries != limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } @@ -7099,11 +7124,11 @@ * Used for testing Tcl_GetInt which is no longer used directly by the * core very much. */ static int TestgetintCmd( - void *dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int argc, const char **argv) { if (argc < 2) { @@ -7126,28 +7151,28 @@ /* * Used for determining sizeof(long) at script level. */ static int TestlongsizeCmd( - void *dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int argc, - const char **argv) + TCL_UNUSED(const char **) /*argv*/) { if (argc != 1) { Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(sizeof(long))); + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long))); return TCL_OK; } static int NREUnwind_callback( void *data[], Tcl_Interp *interp, - int result) + TCL_UNUSED(int) /*result*/) { int none; if (data[0] == INT2PTR(-1)) { Tcl_NRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1), @@ -7158,24 +7183,24 @@ } else if (data[2] == INT2PTR(-1)) { Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1], &none, NULL); } else { Tcl_Obj *idata[3]; - idata[0] = Tcl_NewIntObj(((char *) data[1] - (char *) data[0])); - idata[1] = Tcl_NewIntObj(((char *) data[2] - (char *) data[0])); - idata[2] = Tcl_NewIntObj(((char *) &none - (char *) data[0])); + idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0])); + idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0])); + idata[2] = Tcl_NewIntObj((int) ((char *) &none - (char *) data[0])); Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); } return TCL_OK; } static int TestNREUnwind( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { /* * Insure that callbacks effectively run at the proper level during the * unwinding of the NRE stack. */ @@ -7186,14 +7211,14 @@ } static int TestNRELevels( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { Interp *iPtr = (Interp *) interp; static ptrdiff_t *refDepth = NULL; ptrdiff_t depth; Tcl_Obj *levels[6]; @@ -7242,14 +7267,14 @@ *---------------------------------------------------------------------- */ static int TestconcatobjCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) { Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr; int result = TCL_OK, len; Tcl_Obj *objv[3]; @@ -7522,10 +7547,76 @@ } /* *---------------------------------------------------------------------- * + * TestgetencpathObjCmd -- + * + * This function implements the "testgetencpath" command. It is used to + * test Tcl_GetEncodingSearchPath(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestgetencpathObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestsetencpathCmd -- + * + * This function implements the "testsetencpath" command. It is used to + * test Tcl_SetDefaultEncodingDir(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestsetencpathObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ +{ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); + return TCL_ERROR; + } + + Tcl_SetEncodingSearchPath(objv[1]); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to * test that Tcl_ParseArgsObjv does indeed return the right number of * arguments. In other words, that [Bug 3413857] was fixed properly. @@ -7539,11 +7630,11 @@ *---------------------------------------------------------------------- */ static int TestparseargsCmd( - void *dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Arguments. */ { static int foo = 0; @@ -7560,11 +7651,11 @@ } result[0] = Tcl_NewIntObj(foo); result[1] = Tcl_NewIntObj(count); result[2] = Tcl_NewListObj(count, remObjv); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); - Tcl_Free(remObjv); + ckfree(remObjv); return TCL_OK; } /** * Test harness for command and variable resolvers. @@ -7572,12 +7663,12 @@ static int InterpCmdResolver( Tcl_Interp *interp, const char *name, - Tcl_Namespace *context, - int flags, + TCL_UNUSED(Tcl_Namespace *), + TCL_UNUSED(int) /*flags*/, Tcl_Command *rPtr) { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? @@ -7663,15 +7754,15 @@ return TCL_CONTINUE; } static int InterpVarResolver( - Tcl_Interp *interp, - const char *name, - Tcl_Namespace *context, - int flags, - Tcl_Var *rPtr) + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(const char *), + TCL_UNUSED(Tcl_Namespace *), + TCL_UNUSED(int), + TCL_UNUSED(Tcl_Var *)) { /* * Don't resolve the variable; use standard rules. */ @@ -7687,11 +7778,11 @@ static inline void HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { - Tcl_Free(var); + ckfree(var); } else { VarHashRefCount(var)--; } } @@ -7703,11 +7794,11 @@ Tcl_DecrRefCount(resVarInfo->nameObj); if (resVarInfo->var) { HashVarFree(resVarInfo->var); } - Tcl_Free(vInfoPtr); + ckfree(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) @@ -7746,28 +7837,28 @@ var = NULL; } resVarInfo->var = var; /* - * Increment the reference counter to avoid Tcl_Free() of the variable in + * Increment the reference counter to avoid ckfree() of the variable in * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree(); */ VarHashRefCount(var)++; return var; } static int InterpCompiledVarResolver( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), const char *name, - int length, - Tcl_Namespace *context, + TCL_UNUSED(int) /*length*/, + TCL_UNUSED(Tcl_Namespace *), Tcl_ResolvedVarInfo **rPtr) { if (*name == 'T') { - MyResolvedVarInfo *resVarInfo = Tcl_Alloc(sizeof(MyResolvedVarInfo)); + MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)ckalloc(sizeof(MyResolvedVarInfo)); resVarInfo->vInfo.fetchProc = MyCompiledVarFetch; resVarInfo->vInfo.deleteProc = MyCompiledVarFree; resVarInfo->var = NULL; resVarInfo->nameObj = Tcl_NewStringObj(name, -1); @@ -7778,11 +7869,11 @@ return TCL_CONTINUE; } static int TestInterpResolverCmd( - void *clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const table[] = { Index: generic/tclTestObj.c ================================================================== --- generic/tclTestObj.c +++ generic/tclTestObj.c @@ -16,52 +16,55 @@ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" -#include "tommath.h" +#ifdef TCL_WITH_EXTERNAL_TOMMATH +# include "tommath.h" +#else +# include "tclTomMath.h" +#endif #include "tclStringRep.h" +#ifdef __GNUC__ +/* + * The rest of this file shouldn't warn about deprecated functions; they're + * there because we intend them to be so and know that this file is OK to + * touch those fields. + */ +#pragma GCC diagnostic ignored "-Wdeprecated-declarations" +#endif /* * Forward declarations for functions defined later in this file: */ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex); static int GetVariableIndex(Tcl_Interp *interp, const char *string, int *indexPtr); static void SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr); -static int TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestbooleanobjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestlistobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TestobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); -static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestbignumobjCmd; +static Tcl_ObjCmdProc TestbooleanobjCmd; +static Tcl_ObjCmdProc TestdoubleobjCmd; +static Tcl_ObjCmdProc TestindexobjCmd; +static Tcl_ObjCmdProc TestintobjCmd; +static Tcl_ObjCmdProc TestlistobjCmd; +static Tcl_ObjCmdProc TestobjCmd; +static Tcl_ObjCmdProc TeststringobjCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 -static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) +static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp) { - register int i; + int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } Tcl_DeleteAssocData(interp, VARPTR_KEY); - Tcl_Free(varPtr); + ckfree(varPtr); } static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) { Tcl_InterpDeleteProc *proc; @@ -89,19 +92,19 @@ int TclObjTest_Init( Tcl_Interp *interp) { - register int i; + int i; /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's * Tcl_Obj *. */ Tcl_Obj **varPtr; - varPtr = (Tcl_Obj **) Tcl_Alloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); + varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); if (!varPtr) { return TCL_ERROR; } Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr); for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { @@ -129,11 +132,11 @@ /* *---------------------------------------------------------------------- * * TestbignumobjCmd -- * - * This function implmenets the "testbignumobj" command. It is used + * This function implements the "testbignumobj" command. It is used * to exercise the bignum Tcl object type implementation. * * Results: * Returns a standard Tcl object result. * @@ -144,11 +147,11 @@ *---------------------------------------------------------------------- */ static int TestbignumobjCmd( - ClientData clientData, /* unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { const char *const subcmds[] = { @@ -158,11 +161,11 @@ BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN, BIGNUM_RADIXSIZE }; int index, varIndex; const char *string; - mp_int bignumValue, newValue; + mp_int bignumValue; Tcl_Obj **varPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; @@ -231,23 +234,20 @@ } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } - if (mp_init(&newValue) != MP_OKAY - || (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) { + if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); - mp_clear(&newValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_mul_d", -1)); return TCL_ERROR; } - mp_clear(&bignumValue); if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetBignumObj(varPtr[varIndex], &newValue); + Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_DIV10: if (objc != 3) { @@ -259,23 +259,20 @@ } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } - if (mp_init(&newValue) != MP_OKAY - || (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) { + if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) { mp_clear(&bignumValue); - mp_clear(&newValue); Tcl_SetObjResult(interp, Tcl_NewStringObj("error in mp_div_d", -1)); return TCL_ERROR; } - mp_clear(&bignumValue); if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetBignumObj(varPtr[varIndex], &newValue); + Tcl_SetBignumObj(varPtr[varIndex], &bignumValue); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue)); } break; case BIGNUM_ISEVEN: if (objc != 3) { @@ -286,15 +283,21 @@ return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; + } + if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) { + mp_clear(&bignumValue); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("error in mp_mod_2d", -1)); + return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetIntObj(varPtr[varIndex], !mp_isodd(&bignumValue)); + Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue)); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(!mp_isodd(&bignumValue))); + SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue))); } mp_clear(&bignumValue); break; case BIGNUM_RADIXSIZE: @@ -343,11 +346,11 @@ *---------------------------------------------------------------------- */ static int TestbooleanobjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex, boolValue; @@ -443,11 +446,11 @@ *---------------------------------------------------------------------- */ static int TestdoubleobjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex; @@ -561,25 +564,26 @@ *---------------------------------------------------------------------- */ static int TestindexobjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowAbbrev, index, index2, setError, i, result; const char **argv; static const char *const tablePtr[] = {"a", "b", "check", NULL}; + /* * Keep this structure declaration in sync with tclIndexObj.c */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ - size_t offset; /* Offset between table entries. */ - size_t index; /* Selected index into table. */ + int offset; /* Offset between table entries. */ + int index; /* Selected index into table. */ }; struct IndexRep *indexRep; if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "check") == 0)) { @@ -592,11 +596,11 @@ if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) { return TCL_ERROR; } Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); - indexRep = objv[1]->internalRep.twoPtrValue.ptr1; + indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1; indexRep->index = index2; result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); @@ -614,20 +618,20 @@ } if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) { return TCL_ERROR; } - argv = Tcl_Alloc((objc-3) * sizeof(char *)); + argv = (const char **)ckalloc((objc-3) * sizeof(char *)); for (i = 4; i < objc; i++) { argv[i-4] = Tcl_GetString(objv[i]); } argv[objc-4] = NULL; result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT), &index); - Tcl_Free((void *)argv); + ckfree(argv); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); } return result; } @@ -650,11 +654,11 @@ *---------------------------------------------------------------------- */ static int TestintobjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int intValue, varIndex, i; @@ -854,11 +858,11 @@ *----------------------------------------------------------------------------- */ static int TestlistobjCmd( - ClientData clientData, /* Not used */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { /* Subcommands supported by this command */ @@ -951,11 +955,11 @@ *---------------------------------------------------------------------- */ static int TestobjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex, destIndex, i; @@ -1163,11 +1167,11 @@ *---------------------------------------------------------------------- */ static int TeststringobjCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; @@ -1176,12 +1180,12 @@ const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", - "set", "set2", "setlength", "maxchars", "getunicode", - "appendself", "appendself2", NULL + "set", "set2", "setlength", "maxchars", "appendself", + "appendself2", NULL }; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); @@ -1271,21 +1275,21 @@ break; case 4: /* length */ if (objc != 3) { goto wrongNumArgs; } - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) - ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1); + Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) + ? varPtr[varIndex]->length : -1); break; case 5: /* length2 */ if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); - strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; + strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = (int) strPtr->allocated; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); @@ -1335,24 +1339,18 @@ goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); - strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; + strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; - case 10: /* getunicode */ - if (objc != 3) { - goto wrongNumArgs; - } - Tcl_GetUnicode(varPtr[varIndex]); - break; - case 11: /* appendself */ + case 10: /* appendself */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); @@ -1379,11 +1377,11 @@ } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; - case 12: /* appendself2 */ + case 11: /* appendself2 */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); Index: generic/tclTestProcBodyObj.c ================================================================== --- generic/tclTestProcBodyObj.c +++ generic/tclTestProcBodyObj.c @@ -33,27 +33,27 @@ /* * this struct describes an entry in the table of command names and command * procs */ -typedef struct { +typedef struct CmdTable { const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ } CmdTable; /* * Declarations for functions defined in this file. */ -static int ProcBodyTestProcObjCmd(ClientData dummy, +static int ProcBodyTestProcObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ProcBodyTestCheckObjCmd(ClientData dummy, +static int ProcBodyTestCheckObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, - const char *namespace, const CmdTable *cmdTablePtr); + const char *namesp, const CmdTable *cmdTablePtr); /* * List of commands to create when the package is loaded; must go after the * declarations of the enable command procedure. */ @@ -137,25 +137,25 @@ static int RegisterCommand( Tcl_Interp* interp, /* the Tcl interpreter for which the operation * is performed */ - const char *namespace, /* the namespace in which the command is + const char *namesp, /* the namespace in which the command is * registered */ const CmdTable *cmdTablePtr)/* the command to register */ { char buf[128]; if (cmdTablePtr->exportIt) { sprintf(buf, "namespace eval %s { namespace export %s }", - namespace, cmdTablePtr->cmdName); + namesp, cmdTablePtr->cmdName); if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { return TCL_ERROR; } } - sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName); + sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName); Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0); return TCL_OK; } /* @@ -188,11 +188,11 @@ if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) { return TCL_ERROR; } } - return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); + return Tcl_PkgProvide(interp, packageName, packageVersion); } /* *---------------------------------------------------------------------- * @@ -226,11 +226,11 @@ *---------------------------------------------------------------------- */ static int ProcBodyTestProcObjCmd( - ClientData dummy, /* context; not used */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* the current interpreter */ int objc, /* argument count */ Tcl_Obj *const objv[]) /* arguments */ { const char *fullName; @@ -325,11 +325,11 @@ *---------------------------------------------------------------------- */ static int ProcBodyTestCheckObjCmd( - ClientData dummy, /* context; not used */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* the current interpreter */ int objc, /* argument count */ Tcl_Obj *const objv[]) /* arguments */ { const char *version; @@ -337,11 +337,11 @@ if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } - version = Tcl_PkgPresentEx(interp, packageName, packageVersion, 1, NULL); + version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); Tcl_SetObjResult(interp, Tcl_NewWideIntObj( strcmp(version, packageVersion) == 0)); return TCL_OK; } Index: generic/tclThread.c ================================================================== --- generic/tclThread.c +++ generic/tclThread.c @@ -59,11 +59,11 @@ */ void * Tcl_GetThreadData( Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */ - size_t size) /* Size of storage block */ + int size) /* Size of storage block */ { void *result; #if TCL_THREADS /* * Initialize the key for this thread. @@ -70,17 +70,17 @@ */ result = TclThreadStorageKeyGet(keyPtr); if (result == NULL) { - result = Tcl_Alloc(size); + result = ckalloc(size); memset(result, 0, size); TclThreadStorageKeySet(keyPtr, result); } #else /* TCL_THREADS */ if (*keyPtr == NULL) { - result = Tcl_Alloc(size); + result = ckalloc(size); memset(result, 0, size); *keyPtr = result; RememberSyncObject(keyPtr, &keyRecord); } else { result = *keyPtr; @@ -162,18 +162,18 @@ * pointers to the new list. */ if (recPtr->num >= recPtr->max) { recPtr->max += 8; - newList = Tcl_Alloc(recPtr->max * sizeof(void *)); + newList = (void **)ckalloc(recPtr->max * sizeof(void *)); for (i=0,j=0 ; inum ; i++) { if (recPtr->list[i] != NULL) { newList[j++] = recPtr->list[i]; } } if (recPtr->list != NULL) { - Tcl_Free(recPtr->list); + ckfree(recPtr->list); } recPtr->list = newList; recPtr->num = j; } @@ -348,10 +348,12 @@ /* * Quick exit principle makes it useless to terminate allocators */ TclFinalizeThreadAllocThread(); } +#else + (void)quick; #endif } /* *---------------------------------------------------------------------- @@ -390,13 +392,13 @@ if (keyRecord.list != NULL) { for (i=0 ; i= sizeof(size_t)) { + /* An unsigned int overflow can also be a size_t overflow */ + const size_t zero = 0; + const size_t max = ~zero; + + if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { + /* Requested allocation exceeds memory */ + return NULL; + } + } +#endif GETCACHE(cachePtr); /* * Increment the requested size to include room for the Block structure. @@ -322,11 +335,11 @@ #if RCHECK size++; #endif if (size > MAXALLOC) { bucket = NBUCKETS; - blockPtr = TclpSysAlloc(size); + blockPtr = (Block *)TclpSysAlloc(size, 0); if (blockPtr != NULL) { cachePtr->totalAssigned += reqSize; } } else { bucket = 0; @@ -423,11 +436,11 @@ */ void * TclpRealloc( void *ptr, - size_t reqSize) + unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; void *newPtr; size_t size, min; @@ -434,10 +447,23 @@ int bucket; if (ptr == NULL) { return TclpAlloc(reqSize); } + +#ifndef __LP64__ + if (sizeof(int) >= sizeof(size_t)) { + /* An unsigned int overflow can also be a size_t overflow */ + const size_t zero = 0; + const size_t max = ~zero; + + if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { + /* Requested allocation exceeds memory */ + return NULL; + } + } +#endif GETCACHE(cachePtr); /* * If the block is not a system block and fits in place, simply return the @@ -463,11 +489,11 @@ return Block2Ptr(blockPtr, bucket, reqSize); } } else if (size > MAXALLOC) { cachePtr->totalAssigned -= blockPtr->blockReqSize; cachePtr->totalAssigned += reqSize; - blockPtr = TclpSysRealloc(blockPtr, size); + blockPtr = (Block*)TclpSysRealloc(blockPtr, size); if (blockPtr == NULL) { return NULL; } return Block2Ptr(blockPtr, NBUCKETS, reqSize); } @@ -509,22 +535,22 @@ */ Tcl_Obj * TclThreadAllocObj(void) { - register Cache *cachePtr; - register Tcl_Obj *objPtr; + Cache *cachePtr; + Tcl_Obj *objPtr; GETCACHE(cachePtr); /* * Get this thread's obj list structure and move or allocate new objs if * necessary. */ if (cachePtr->numObjects == 0) { - register int numMove; + int numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; if (numMove > 0) { if (numMove > NOBJALLOC) { @@ -535,11 +561,11 @@ Tcl_MutexUnlock(objLockPtr); if (cachePtr->numObjects == 0) { Tcl_Obj *newObjsPtr; cachePtr->numObjects = numMove = NOBJALLOC; - newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove); + newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0); if (newObjsPtr == NULL) { Tcl_Panic("alloc: could not allocate %d new objects", numMove); } cachePtr->lastPtr = newObjsPtr + numMove - 1; objPtr = cachePtr->firstObjPtr; /* NULL */ @@ -554,11 +580,11 @@ /* * Pop the first object. */ objPtr = cachePtr->firstObjPtr; - cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; + cachePtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; cachePtr->numObjects--; return objPtr; } /* @@ -643,12 +669,12 @@ } else { sprintf(buf, "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { - sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", - bucketInfo[n].blockSize, + sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld", + (unsigned long) bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, cachePtr->buckets[n].totalAssigned, cachePtr->buckets[n].numLocks, @@ -681,11 +707,11 @@ MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { - register Tcl_Obj *objPtr = fromPtr->firstObjPtr; + Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; toPtr->numObjects += numMove; fromPtr->numObjects -= numMove; @@ -693,13 +719,13 @@ * Find the last object to be moved; set the next one (the first one not * to be moved) as the first object in the 'from' cache. */ while (--numMove) { - objPtr = objPtr->internalRep.twoPtrValue.ptr1; + objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; } - fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; + fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1; /* * Move all objects as a block - they are already linked to each other, we * just have to update the first and last. */ @@ -738,11 +764,11 @@ if (keep == 0) { fromPtr->firstObjPtr = NULL; } else { do { lastPtr = firstPtr; - firstPtr = firstPtr->internalRep.twoPtrValue.ptr1; + firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1; } while (--keep > 0); lastPtr->internalRep.twoPtrValue.ptr1 = NULL; } /* @@ -776,33 +802,33 @@ * Invalid blocks will abort the server. * *---------------------------------------------------------------------- */ -static char * +static void * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { - register void *ptr; + void *ptr; blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC; blockPtr->sourceBucket = bucket; blockPtr->blockReqSize = reqSize; ptr = ((void *) (blockPtr + 1)); #if RCHECK ((unsigned char *)(ptr))[reqSize] = MAGIC; #endif - return (char *) ptr; + return ptr; } static Block * Ptr2Block( - char *ptr) + void *ptr) { - register Block *blockPtr; + Block *blockPtr; blockPtr = (((Block *) ptr) - 1); if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) { Tcl_Panic("alloc: invalid block: %p: %x %x", blockPtr, blockPtr->magicNum1, blockPtr->magicNum2); @@ -844,11 +870,11 @@ sharedPtr->buckets[bucket].numLocks++; } static void UnlockBucket( - Cache *cachePtr, + TCL_UNUSED(Cache *), int bucket) { Tcl_MutexUnlock(bucketInfo[bucket].lockPtr); } @@ -932,12 +958,12 @@ static int GetBlocks( Cache *cachePtr, int bucket) { - register Block *blockPtr; - register size_t n; + Block *blockPtr; + int n; /* * First, atttempt to move blocks from the shared cache. Note the * potentially dirty read of numFree before acquiring the lock which is a * slight performance enhancement. The value is verified after the lock is @@ -978,21 +1004,21 @@ } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { - register size_t size; + size_t size; /* * If no blocks could be moved from shared, first look for a larger * block in this cache to split up. */ blockPtr = NULL; n = NBUCKETS; - size = 0; /* lint */ - while (--n > (size_t)bucket) { + size = 0; + while (--n > bucket) { if (cachePtr->buckets[n].numFree > 0) { size = bucketInfo[n].blockSize; blockPtr = cachePtr->buckets[n].firstPtr; cachePtr->buckets[n].firstPtr = blockPtr->nextBlock; cachePtr->buckets[n].numFree--; @@ -1004,11 +1030,11 @@ * Otherwise, allocate a big new block directly. */ if (blockPtr == NULL) { size = MAXALLOC; - blockPtr = TclpSysAlloc(size); + blockPtr = (Block*)TclpSysAlloc(size, 0); if (blockPtr == NULL) { return 0; } } @@ -1034,11 +1060,11 @@ *---------------------------------------------------------------------- * * TclInitThreadAlloc -- * * Initializes the allocator cache-maintenance structures. - * It is done early and protected during the TclInitSubsystems(). + * It is done early and protected during the Tcl_InitSubsystems(). * * Results: * None. * * Side effects: @@ -1054,11 +1080,11 @@ listLockPtr = TclpNewAllocMutex(); objLockPtr = TclpNewAllocMutex(); for (i = 0; i < NBUCKETS; ++i) { bucketInfo[i].blockSize = MINALLOC << i; - bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i); + bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i); bucketInfo[i].numMove = i < NBUCKETS - 1 ? 1 << (NBUCKETS - 2 - i) : 1; bucketInfo[i].lockPtr = TclpNewAllocMutex(); } TclpInitAllocCache(); @@ -1119,11 +1145,11 @@ */ void TclFinalizeThreadAllocThread(void) { - Cache *cachePtr = TclpGetAllocCache(); + Cache *cachePtr = (Cache *)TclpGetAllocCache(); if (cachePtr != NULL) { TclpFreeAllocCache(cachePtr); } } @@ -1144,11 +1170,11 @@ *---------------------------------------------------------------------- */ void Tcl_GetMemoryInfo( - Tcl_DString *dsPtr) + TCL_UNUSED(Tcl_DString *)) { Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use"); } /* Index: generic/tclThreadJoin.c ================================================================== --- generic/tclThreadJoin.c +++ generic/tclThreadJoin.c @@ -199,11 +199,11 @@ *result = threadPtr->result; Tcl_ConditionFinalize(&threadPtr->cond); Tcl_MutexFinalize(&threadPtr->threadMutex); - Tcl_Free(threadPtr); + ckfree(threadPtr); return TCL_OK; } /* @@ -228,11 +228,11 @@ TclRememberJoinableThread( Tcl_ThreadId id) /* The thread to remember as joinable */ { JoinableThread *threadPtr; - threadPtr = Tcl_Alloc(sizeof(JoinableThread)); + threadPtr = (JoinableThread *)ckalloc(sizeof(JoinableThread)); threadPtr->id = id; threadPtr->done = 0; threadPtr->waitedUpon = 0; threadPtr->threadMutex = (Tcl_Mutex) NULL; threadPtr->cond = (Tcl_Condition) NULL; Index: generic/tclThreadStorage.c ================================================================== --- generic/tclThreadStorage.c +++ generic/tclThreadStorage.c @@ -45,11 +45,11 @@ /* * The type of the data held per thread in a system TSD. */ -typedef struct { +typedef struct TSDTable { ClientData *tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ } TSDTable; @@ -83,18 +83,18 @@ TSDTableCreate(void) { TSDTable *tsdTablePtr; sig_atomic_t i; - tsdTablePtr = TclpSysAlloc(sizeof(TSDTable)); + tsdTablePtr = (TSDTable *)TclpSysAlloc(sizeof(TSDTable), 0); if (tsdTablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } tsdTablePtr->allocated = 8; tsdTablePtr->tablePtr = - TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated); + (void **)TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0); if (tsdTablePtr->tablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } for (i = 0; i < tsdTablePtr->allocated; ++i) { @@ -115,11 +115,11 @@ /* * These values were allocated in Tcl_GetThreadData in tclThread.c * and must now be deallocated or they will leak. */ - Tcl_Free(tsdTablePtr->tablePtr[i]); + ckfree(tsdTablePtr->tablePtr[i]); } } TclpSysFree(tsdTablePtr->tablePtr); TclpSysFree(tsdTablePtr); @@ -146,19 +146,19 @@ TSDTableGrow( TSDTable *tsdTablePtr, sig_atomic_t atLeast) { sig_atomic_t newAllocated = tsdTablePtr->allocated * 2; - ClientData *newTablePtr; + void **newTablePtr; sig_atomic_t i; if (newAllocated <= atLeast) { newAllocated = atLeast + 10; } - newTablePtr = TclpSysRealloc(tsdTablePtr->tablePtr, - sizeof(ClientData) * newAllocated); + newTablePtr = (void **)TclpSysRealloc(tsdTablePtr->tablePtr, + sizeof(void *) * newAllocated); if (newTablePtr == NULL) { Tcl_Panic("unable to reallocate TSDTable"); } for (i = tsdTablePtr->allocated; i < newAllocated; ++i) { @@ -187,11 +187,11 @@ void * TclThreadStorageKeyGet( Tcl_ThreadDataKey *dataKeyPtr) { - TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key); + TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key); ClientData resultPtr = NULL; TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr; sig_atomic_t offset = keyPtr->offset; if ((tsdTablePtr != NULL) && (offset > 0) @@ -221,11 +221,11 @@ void TclThreadStorageKeySet( Tcl_ThreadDataKey *dataKeyPtr, void *value) { - TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key); + TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key); TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr; if (tsdTablePtr == NULL) { tsdTablePtr = TSDTableCreate(); TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr); @@ -286,11 +286,11 @@ */ void TclFinalizeThreadDataThread(void) { - TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key); + TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key); if (tsdTablePtr != NULL) { TSDTableDelete(tsdTablePtr); TclpThreadSetMasterTSD(tsdMaster.key, NULL); } Index: generic/tclThreadTest.c ================================================================== --- generic/tclThreadTest.c +++ generic/tclThreadTest.c @@ -117,11 +117,11 @@ * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) -static int ThreadObjCmd(ClientData clientData, +static int ThreadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ThreadCreate(Tcl_Interp *interp, const char *script, int joinable); static int ThreadList(Tcl_Interp *interp); @@ -128,19 +128,19 @@ static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, const char *script, int wait); static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id, const char *result, int flags); -static Tcl_ThreadCreateType NewTestThread(ClientData clientData); +static Tcl_ThreadCreateType NewTestThread(void *clientData); static void ListRemove(ThreadSpecificData *tsdPtr); static void ListUpdateInner(ThreadSpecificData *tsdPtr); static int ThreadEventProc(Tcl_Event *evPtr, int mask); static void ThreadErrorProc(Tcl_Interp *interp); -static void ThreadFreeProc(ClientData clientData); +static void ThreadFreeProc(void *clientData); static int ThreadDeleteEvent(Tcl_Event *eventPtr, - ClientData clientData); -static void ThreadExitProc(ClientData clientData); + void *clientData); +static void ThreadExitProc(void *clientData); extern int Tcltest_Init(Tcl_Interp *interp); /* *---------------------------------------------------------------------- * @@ -201,14 +201,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ThreadObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -292,11 +291,11 @@ */ script = Tcl_GetStringFromObj(objv[2], &len); if ((len > 1) && (script[0] == '-') && (script[1] == 'j') && - (0 == strncmp(script, "-joinable", len))) { + (0 == strncmp(script, "-joinable", (size_t) len))) { joinable = 1; script = "testthread wait"; /* Just enter event loop */ } else { /* * Remember the script @@ -309,11 +308,11 @@ * Definitely a script available, but is the flag -joinable? */ script = Tcl_GetStringFromObj(objv[2], &len); joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j') - && (0 == strncmp(script, "-joinable", len))); + && (0 == strncmp(script, "-joinable", (size_t) len))); script = Tcl_GetString(objv[3]); } else { Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); return TCL_ERROR; } @@ -430,14 +429,14 @@ return TCL_ERROR; } Tcl_MutexLock(&threadMutex); errorThreadId = Tcl_GetCurrentThread(); if (errorProcString) { - Tcl_Free(errorProcString); + ckfree(errorProcString); } proc = Tcl_GetString(objv[2]); - errorProcString = Tcl_Alloc(strlen(proc) + 1); + errorProcString = (char *)ckalloc(strlen(proc) + 1); strcpy(errorProcString, proc); Tcl_MutexUnlock(&threadMutex); return TCL_OK; } case THREAD_WAIT: @@ -489,11 +488,10 @@ * Create a thread. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ThreadCreate( Tcl_Interp *interp, /* Current interpreter. */ const char *script, /* Script to execute */ int joinable) /* Flag, joinable thread or not */ @@ -554,13 +552,13 @@ *------------------------------------------------------------------------ */ Tcl_ThreadCreateType NewTestThread( - ClientData clientData) + void *clientData) { - ThreadCtrl *ctrlPtr = clientData; + ThreadCtrl *ctrlPtr = (ThreadCtrl *)clientData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int result; char *threadEvalScript; /* @@ -593,11 +591,11 @@ /* * We need to keep a pointer to the alloc'ed mem of the script we are * eval'ing, for the case that we exit during evaluation */ - threadEvalScript = Tcl_Alloc(strlen(ctrlPtr->script) + 1); + threadEvalScript = (char *)ckalloc(strlen(ctrlPtr->script) + 1); strcpy(threadEvalScript, ctrlPtr->script); Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript); /* @@ -668,11 +666,11 @@ argv[0] = errorProcString; argv[1] = buf; argv[2] = errorInfo; script = Tcl_Merge(3, argv); ThreadSend(interp, errorThreadId, script, 0); - Tcl_Free(script); + ckfree(script); } } /* @@ -838,17 +836,17 @@ /* * Create the event for its event queue. */ - threadEventPtr = Tcl_Alloc(sizeof(ThreadEvent)); - threadEventPtr->script = Tcl_Alloc(strlen(script) + 1); + threadEventPtr = (ThreadEvent*)ckalloc(sizeof(ThreadEvent)); + threadEventPtr->script = (char *)ckalloc(strlen(script) + 1); strcpy(threadEventPtr->script, script); if (!wait) { resultPtr = threadEventPtr->resultPtr = NULL; } else { - resultPtr = Tcl_Alloc(sizeof(ThreadEventResult)); + resultPtr = (ThreadEventResult *)ckalloc(sizeof(ThreadEventResult)); threadEventPtr->resultPtr = resultPtr; /* * Initialize the result fields. */ @@ -916,23 +914,23 @@ Tcl_MutexUnlock(&threadMutex); if (resultPtr->code != TCL_OK) { if (resultPtr->errorCode) { Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL); - Tcl_Free(resultPtr->errorCode); + ckfree(resultPtr->errorCode); } if (resultPtr->errorInfo) { Tcl_AddErrorInfo(interp, resultPtr->errorInfo); - Tcl_Free(resultPtr->errorInfo); + ckfree(resultPtr->errorInfo); } } Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; - Tcl_Free(resultPtr->result); - Tcl_Free(resultPtr); + ckfree(resultPtr->result); + ckfree(resultPtr); return code; } /* @@ -1008,11 +1006,11 @@ */ static int ThreadEventProc( Tcl_Event *evPtr, /* Really ThreadEvent */ - int mask) + TCL_UNUSED(int) /*mask*/) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr; ThreadEventResult *resultPtr = threadEventPtr->resultPtr; Tcl_Interp *interp = tsdPtr->interp; @@ -1036,22 +1034,22 @@ } else { errorCode = errorInfo = NULL; } result = Tcl_GetStringResult(interp); } - Tcl_Free(threadEventPtr->script); + ckfree(threadEventPtr->script); if (resultPtr) { Tcl_MutexLock(&threadMutex); resultPtr->code = code; - resultPtr->result = Tcl_Alloc(strlen(result) + 1); + resultPtr->result = (char *)ckalloc(strlen(result) + 1); strcpy(resultPtr->result, result); if (errorCode != NULL) { - resultPtr->errorCode = Tcl_Alloc(strlen(errorCode) + 1); + resultPtr->errorCode = (char *)ckalloc(strlen(errorCode) + 1); strcpy(resultPtr->errorCode, errorCode); } if (errorInfo != NULL) { - resultPtr->errorInfo = Tcl_Alloc(strlen(errorInfo) + 1); + resultPtr->errorInfo = (char *)ckalloc(strlen(errorInfo) + 1); strcpy(resultPtr->errorInfo, errorInfo); } Tcl_ConditionNotify(&resultPtr->done); Tcl_MutexUnlock(&threadMutex); } @@ -1071,22 +1069,21 @@ * * Results: * None. * * Side effects: - * Clears up mem specified in ClientData + * Clears up mem specified in clientData * *------------------------------------------------------------------------ */ - /* ARGSUSED */ static void ThreadFreeProc( - ClientData clientData) + void *clientData) { if (clientData) { - Tcl_Free(clientData); + ckfree(clientData); } } /* *------------------------------------------------------------------------ @@ -1103,18 +1100,17 @@ * It cleans up our events in the event queue for this thread. * *------------------------------------------------------------------------ */ - /* ARGSUSED */ static int ThreadDeleteEvent( Tcl_Event *eventPtr, /* Really ThreadEvent */ - ClientData clientData) /* dummy */ + TCL_UNUSED(ClientData)) { if (eventPtr->proc == ThreadEventProc) { - Tcl_Free(((ThreadEvent *) eventPtr)->script); + ckfree(((ThreadEvent *) eventPtr)->script); return 1; } /* * If it was NULL, we were in the middle of servicing the event and it @@ -1139,16 +1135,15 @@ * up any events in the event queue for this thread. * *------------------------------------------------------------------------ */ - /* ARGSUSED */ static void ThreadExitProc( - ClientData clientData) + void *clientData) { - char *threadEvalScript = clientData; + char *threadEvalScript = (char *)clientData; ThreadEventResult *resultPtr, *nextPtr; Tcl_ThreadId self = Tcl_GetCurrentThread(); ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->interp != NULL) { @@ -1157,18 +1152,18 @@ Tcl_MutexLock(&threadMutex); if (self == errorThreadId) { if (errorProcString) { /* Extra safety */ - Tcl_Free(errorProcString); + ckfree(errorProcString); errorProcString = NULL; } errorThreadId = 0; } if (threadEvalScript) { - Tcl_Free(threadEvalScript); + ckfree(threadEvalScript); threadEvalScript = NULL; } Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL); for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) { @@ -1187,21 +1182,21 @@ if (resultPtr->nextPtr) { resultPtr->nextPtr->prevPtr = resultPtr->prevPtr; } resultPtr->nextPtr = resultPtr->prevPtr = 0; resultPtr->eventPtr->resultPtr = NULL; - Tcl_Free(resultPtr); + ckfree(resultPtr); } else if (resultPtr->dstThreadId == self) { /* * Dang. The target is going away. Unblock the caller. The result * string must be dynamically allocated because the main thread is * going to call free on it. */ const char *msg = "target thread died"; - resultPtr->result = Tcl_Alloc(strlen(msg) + 1); + resultPtr->result = (char *)ckalloc(strlen(msg) + 1); strcpy(resultPtr->result, msg); resultPtr->code = TCL_ERROR; Tcl_ConditionNotify(&resultPtr->done); } } Index: generic/tclTimer.c ================================================================== --- generic/tclTimer.c +++ generic/tclTimer.c @@ -180,11 +180,11 @@ */ static ThreadSpecificData * InitTimer(void) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); Tcl_CreateThreadExitHandler(TimerExitProc, NULL); @@ -209,22 +209,22 @@ *---------------------------------------------------------------------- */ static void TimerExitProc( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { - register TimerHandler *timerHandlerPtr; + TimerHandler *timerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - Tcl_Free(timerHandlerPtr); + ckfree(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } } } @@ -292,14 +292,14 @@ TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { - register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; + TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); - timerHandlerPtr = Tcl_Alloc(sizeof(TimerHandler)); + timerHandlerPtr = (TimerHandler *)ckalloc(sizeof(TimerHandler)); /* * Fill in fields for the event. */ @@ -353,11 +353,11 @@ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { - register TimerHandler *timerHandlerPtr, *prevPtr; + TimerHandler *timerHandlerPtr, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } @@ -371,11 +371,11 @@ if (prevPtr == NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; } else { prevPtr->nextPtr = timerHandlerPtr->nextPtr; } - Tcl_Free(timerHandlerPtr); + ckfree(timerHandlerPtr); return; } } /* @@ -396,11 +396,11 @@ *---------------------------------------------------------------------- */ static void TimerSetupProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); @@ -454,11 +454,11 @@ *---------------------------------------------------------------------- */ static void TimerCheckProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Event *timerEvPtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); @@ -486,11 +486,11 @@ */ if (blockTime.sec == 0 && blockTime.usec == 0 && !tsdPtr->timerPending) { tsdPtr->timerPending = 1; - timerEvPtr = Tcl_Alloc(sizeof(Tcl_Event)); + timerEvPtr = (Tcl_Event *)ckalloc(sizeof(Tcl_Event)); timerEvPtr->proc = TimerHandlerEventProc; Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); } } } @@ -516,11 +516,11 @@ *---------------------------------------------------------------------- */ static int TimerHandlerEventProc( - Tcl_Event *evPtr, /* Event to service. */ + TCL_UNUSED(Tcl_Event *), int flags) /* Flags that indicate what events to handle, * such as TCL_FILE_EVENTS. */ { TimerHandler *timerHandlerPtr, **nextPtrPtr; Tcl_Time time; @@ -589,11 +589,11 @@ * potential reentrancy problems. */ *nextPtrPtr = timerHandlerPtr->nextPtr; timerHandlerPtr->proc(timerHandlerPtr->clientData); - Tcl_Free(timerHandlerPtr); + ckfree(timerHandlerPtr); } TimerSetupProc(NULL, TCL_TIMER_EVENTS); return 1; } @@ -619,15 +619,15 @@ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr; + IdleHandler *idlePtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); - idlePtr = Tcl_Alloc(sizeof(IdleHandler)); + idlePtr = (IdleHandler *)ckalloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; idlePtr->generation = tsdPtr->idleGeneration; idlePtr->nextPtr = NULL; if (tsdPtr->lastIdlePtr == NULL) { @@ -663,20 +663,20 @@ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - register IdleHandler *idlePtr, *prevPtr; + IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { while ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { nextPtr = idlePtr->nextPtr; - Tcl_Free(idlePtr); + ckfree(idlePtr); idlePtr = nextPtr; if (prevPtr == NULL) { tsdPtr->idleList = idlePtr; } else { prevPtr->nextPtr = idlePtr; @@ -747,11 +747,11 @@ tsdPtr->idleList = idlePtr->nextPtr; if (tsdPtr->idleList == NULL) { tsdPtr->lastIdlePtr = NULL; } idlePtr->proc(idlePtr->clientData); - Tcl_Free(idlePtr); + ckfree(idlePtr); } if (tsdPtr->idleList) { blockTime.sec = 0; blockTime.usec = 0; Tcl_SetMaxBlockTime(&blockTime); @@ -774,23 +774,22 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_AfterObjCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt ms = 0; /* Number of milliseconds to wait */ Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; - size_t length; + int length; int index = -1; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL }; enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; @@ -804,13 +803,13 @@ /* * Create the "after" information associated for this interpreter, if it * doesn't already exist. */ - assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL); + assocPtr = (AfterAssocData *)Tcl_GetAssocData(interp, "tclAfter", NULL); if (assocPtr == NULL) { - assocPtr = Tcl_Alloc(sizeof(AfterAssocData)); + assocPtr = (AfterAssocData *)ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); } @@ -819,11 +818,11 @@ */ if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK) { - const char *arg = TclGetString(objv[1]); + const char *arg = Tcl_GetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument \"%s\": must be" " cancel, idle, info, or an integer", arg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", @@ -843,11 +842,11 @@ ms = 0; } if (objc == 2) { return AfterDelay(interp, ms); } - afterPtr = Tcl_Alloc(sizeof(AfterInfo)); + afterPtr = (AfterInfo *)ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); @@ -881,20 +880,20 @@ return TCL_OK; } case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; - size_t tempLength; + int tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); return TCL_ERROR; } if (objc == 3) { commandPtr = objv[2]; } else { - commandPtr = Tcl_ConcatObj(objc-2, objv+2);; + commandPtr = Tcl_ConcatObj(objc-2, objv+2); } command = TclGetStringFromObj(commandPtr, &length); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { tempCommand = TclGetStringFromObj(afterPtr->commandPtr, @@ -923,11 +922,11 @@ case AFTER_IDLE: if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); return TCL_ERROR; } - afterPtr = Tcl_Alloc(sizeof(AfterInfo)); + afterPtr = (AfterInfo *)ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); @@ -1148,11 +1147,11 @@ static void AfterProc( ClientData clientData) /* Describes command to execute. */ { - AfterInfo *afterPtr = clientData; + AfterInfo *afterPtr = (AfterInfo *)clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; AfterInfo *prevPtr; int result; Tcl_Interp *interp; @@ -1188,11 +1187,11 @@ /* * Free the memory for the callback. */ Tcl_DecrRefCount(afterPtr->commandPtr); - Tcl_Free(afterPtr); + ckfree(afterPtr); } /* *---------------------------------------------------------------------- * @@ -1226,11 +1225,11 @@ /* Empty loop body. */ } prevPtr->nextPtr = afterPtr->nextPtr; } Tcl_DecrRefCount(afterPtr->commandPtr); - Tcl_Free(afterPtr); + ckfree(afterPtr); } /* *---------------------------------------------------------------------- * @@ -1246,18 +1245,17 @@ * After commands are removed. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void AfterCleanupProc( ClientData clientData, /* Points to AfterAssocData for the * interpreter. */ - Tcl_Interp *interp) /* Interpreter that is being deleted. */ + TCL_UNUSED(Tcl_Interp *)) { - AfterAssocData *assocPtr = clientData; + AfterAssocData *assocPtr = (AfterAssocData *)clientData; AfterInfo *afterPtr; while (assocPtr->firstAfterPtr != NULL) { afterPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr->nextPtr; @@ -1265,13 +1263,13 @@ Tcl_DeleteTimerHandler(afterPtr->token); } else { Tcl_CancelIdleCall(AfterProc, afterPtr); } Tcl_DecrRefCount(afterPtr->commandPtr); - Tcl_Free(afterPtr); + ckfree(afterPtr); } - Tcl_Free(assocPtr); + ckfree(assocPtr); } /* * Local Variables: * mode: c Index: generic/tclTomMath.decls ================================================================== --- generic/tclTomMath.decls +++ generic/tclTomMath.decls @@ -21,24 +21,24 @@ scspec EXTERN # Declare each of the functions in the Tcl tommath interface declare 0 { - int TclBN_epoch(void) + int MP_WUR TclBN_epoch(void) } declare 1 { - int TclBN_revision(void) + int MP_WUR TclBN_revision(void) } declare 2 { - int TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c) + mp_err MP_WUR TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c) } declare 3 { - int TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c) + mp_err MP_WUR TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) } declare 4 { - int TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c) + mp_err MP_WUR TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c) } declare 5 { void TclBN_mp_clamp(mp_int *a) } declare 6 { @@ -46,201 +46,231 @@ } declare 7 { void TclBN_mp_clear_multi(mp_int *a, ...) } declare 8 { - int TclBN_mp_cmp(const mp_int *a, const mp_int *b) + mp_ord MP_WUR TclBN_mp_cmp(const mp_int *a, const mp_int *b) } declare 9 { - int TclBN_mp_cmp_d(const mp_int *a, mp_digit b) + mp_ord MP_WUR TclBN_mp_cmp_d(const mp_int *a, unsigned int b) } declare 10 { - int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) + mp_ord MP_WUR TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) } declare 11 { - int TclBN_mp_copy(const mp_int *a, mp_int *b) + mp_err MP_WUR TclBN_mp_copy(const mp_int *a, mp_int *b) } declare 12 { - int TclBN_mp_count_bits(const mp_int *a) + int MP_WUR TclBN_mp_count_bits(const mp_int *a) } declare 13 { - int TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) + mp_err MP_WUR TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) } declare 14 { - int TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r) + mp_err MP_WUR TclBN_mp_div_d(const mp_int *a, unsigned int b, mp_int *q, unsigned int *r) } declare 15 { - int TclBN_mp_div_2(const mp_int *a, mp_int *q) + mp_err MP_WUR TclBN_mp_div_2(const mp_int *a, mp_int *q) } declare 16 { - int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) + mp_err MP_WUR TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) } -declare 17 { - int TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r) +declare 17 {deprecated {is private function in libtommath}} { + mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, unsigned int *r) } declare 18 { void TclBN_mp_exch(mp_int *a, mp_int *b) } declare 19 { - int TclBN_mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) + mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) } declare 20 { - int TclBN_mp_grow(mp_int *a, int size) + mp_err MP_WUR TclBN_mp_grow(mp_int *a, int size) } declare 21 { - int TclBN_mp_init(mp_int *a) + mp_err MP_WUR TclBN_mp_init(mp_int *a) } declare 22 { - int TclBN_mp_init_copy(mp_int *a, const mp_int *b) + mp_err MP_WUR TclBN_mp_init_copy(mp_int *a, const mp_int *b) } declare 23 { - int TclBN_mp_init_multi(mp_int *a, ...) + mp_err MP_WUR TclBN_mp_init_multi(mp_int *a, ...) } declare 24 { - int TclBN_mp_init_set(mp_int *a, mp_digit b) + mp_err MP_WUR TclBN_mp_init_set(mp_int *a, unsigned int b) } declare 25 { - int TclBN_mp_init_size(mp_int *a, int size) + mp_err MP_WUR TclBN_mp_init_size(mp_int *a, int size) } declare 26 { - int TclBN_mp_lshd(mp_int *a, int shift) + mp_err MP_WUR TclBN_mp_lshd(mp_int *a, int shift) } declare 27 { - int TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r) + mp_err MP_WUR TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r) } declare 28 { - int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) + mp_err MP_WUR TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) } declare 29 { - int TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p) + mp_err MP_WUR TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p) } declare 30 { - int TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p) + mp_err MP_WUR TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *p) } declare 31 { - int TclBN_mp_mul_2(const mp_int *a, mp_int *p) + mp_err MP_WUR TclBN_mp_mul_2(const mp_int *a, mp_int *p) } declare 32 { - int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) + mp_err MP_WUR TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) } declare 33 { - int TclBN_mp_neg(const mp_int *a, mp_int *b) + mp_err MP_WUR TclBN_mp_neg(const mp_int *a, mp_int *b) } declare 34 { - int TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c) + mp_err MP_WUR TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c) } declare 35 { - int TclBN_mp_radix_size(const mp_int *a, int radix, int *size) + mp_err MP_WUR TclBN_mp_radix_size(const mp_int *a, int radix, int *size) } declare 36 { - int TclBN_mp_read_radix(mp_int *a, const char *str, int radix) + mp_err MP_WUR TclBN_mp_read_radix(mp_int *a, const char *str, int radix) } declare 37 { void TclBN_mp_rshd(mp_int *a, int shift) } declare 38 { - int TclBN_mp_shrink(mp_int *a) + mp_err MP_WUR TclBN_mp_shrink(mp_int *a) } -declare 39 { - void TclBN_mp_set(mp_int *a, mp_digit b) +declare 39 {deprecated {macro calling mp_set_u64}} { + void TclBN_mp_set(mp_int *a, unsigned int b) } -declare 40 { - int TclBN_mp_sqr(const mp_int *a, mp_int *b) +declare 40 {nostub {is private function in libtommath}} { + mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b) } declare 41 { - int TclBN_mp_sqrt(const mp_int *a, mp_int *b) + mp_err MP_WUR TclBN_mp_sqrt(const mp_int *a, mp_int *b) } declare 42 { - int TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) + mp_err MP_WUR TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) } declare 43 { - int TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) + mp_err MP_WUR TclBN_mp_sub_d(const mp_int *a, unsigned int b, mp_int *c) } -declare 44 { - int TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) +declare 44 {deprecated {Use mp_to_ubin}} { + mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) } -declare 45 { - int TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, +declare 45 {deprecated {Use mp_to_ubin}} { + mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) } -declare 46 { - int TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) +declare 46 {deprecated {Use mp_to_radix}} { + mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) } declare 47 { - int TclBN_mp_unsigned_bin_size(const mp_int *a) + size_t TclBN_mp_ubin_size(const mp_int *a) } declare 48 { - int TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c) + mp_err MP_WUR TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c) } declare 49 { void TclBN_mp_zero(mp_int *a) } -declare 61 { - int TclBN_mp_init_set_int(mp_int *a, unsigned long i) + +# internal routines to libtommath - should not be called but must be +# exported to accommodate the "tommath" extension + +declare 50 {deprecated {is private function in libtommath}} { + void TclBN_reverse(unsigned char *s, int len) +} +declare 51 {deprecated {is private function in libtommath}} { + mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) +} +declare 52 {deprecated {is private function in libtommath}} { + mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b) +} +declare 53 {deprecated {is private function in libtommath}} { + mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) +} +declare 54 {deprecated {is private function in libtommath}} { + mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b) +} +declare 55 {deprecated {is private function in libtommath}} { + mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) +} +declare 56 {deprecated {is private function in libtommath}} { + mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b) +} +declare 57 {deprecated {is private function in libtommath}} { + mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) +} +declare 58 {deprecated {is private function in libtommath}} { + mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) +} +declare 59 {deprecated {is private function in libtommath}} { + mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b) +} +declare 60 {deprecated {is private function in libtommath}} { + mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) +} +declare 61 {deprecated {macro calling mp_init_u64}} { + mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i) } -declare 62 { - int TclBN_mp_set_int(mp_int *a, unsigned long i) +declare 62 {deprecated {macro calling mp_set_u64}} { + void TclBN_mp_set_ul(mp_int *a, unsigned long i) } declare 63 { - int TclBN_mp_cnt_lsb(const mp_int *a) -} - -# Formerly internal API to allow initialisation of bignums without knowing the -# typedefs of how a bignum works internally. -# Removed in 9.0 -#declare 64 { -# void TclBNInitBignumFromLong(mp_int *bignum, long initVal) -#} -# Removed in 9.0 -#declare 65 { -# void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal) -#} -# Removed in 9.0 -#declare 66 { -# void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal) -#} + int MP_WUR TclBN_mp_cnt_lsb(const mp_int *a) +} +declare 64 {deprecated {macro calling mp_init_i64}} { + int TclBN_mp_init_l(mp_int *bignum, long initVal) +} +declare 65 { + int MP_WUR TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) +} +declare 66 { + int MP_WUR TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) +} # Added in libtommath 1.0 -declare 67 { - int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) +declare 67 {deprecated {Use mp_expt_u32}} { + mp_err TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, int fast) } # Added in libtommath 1.0.1 declare 68 { - int TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i) + void TclBN_mp_set_u64(mp_int *a, uint64_t i) } declare 69 { - Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a) + uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a) } declare 70 { - int TclBN_mp_set_long(mp_int *a, unsigned long i) -} -declare 71 { - unsigned long TclBN_mp_get_long(const mp_int *a) -} -declare 72 { - unsigned long TclBN_mp_get_int(const mp_int *a) + void TclBN_mp_set_i64(mp_int *a, int64_t i) } # Added in libtommath 1.1.0 -# No longer in use: replaced by mp_and() -#declare 73 { -# int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) -#} -# No longer in use: replaced by mp_or() -#declare 74 { -# int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) -#} -# No longer in use: replaced by mp_xor() -#declare 75 { -# int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) -#} +declare 73 {deprecated {merged with mp_and}} { + mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) +} +declare 74 {deprecated {merged with mp_or}} { + mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) +} +declare 75 {deprecated {merged with mp_xor}} { + mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) +} declare 76 { - int TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) + mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) +} + +# Added in libtommath 1.2.0 +declare 78 { + int MP_WUR TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) +} +declare 79 { + mp_err MP_WUR TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *q, uint64_t *r) } -declare 77 { - int TclBN_mp_get_bit(const mp_int *a, int b) +declare 80 { + int MP_WUR TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) } # Local Variables: # mode: tcl # End: Index: generic/tclTomMath.h ================================================================== --- generic/tclTomMath.h +++ generic/tclTomMath.h @@ -1,850 +1,47 @@ -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -#ifndef BN_H_ -#define BN_H_ - -#include "tclTomMathDecls.h" -#ifndef MODULE_SCOPE -#define MODULE_SCOPE extern -#endif - - - -#ifdef __cplusplus -extern "C" { -#endif - -/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */ -#if defined(_WIN32) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__) -# define MP_32BIT -#endif - -/* detect 64-bit mode if possible */ -#if defined(NEVER) -# if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT)) -# if defined(__GNUC__) -/* we support 128bit integers only via: __attribute__((mode(TI))) */ -# define MP_64BIT -# else -/* otherwise we fall back to MP_32BIT even on 64bit platforms */ -# define MP_32BIT -# endif -# endif -#endif - -/* some default configurations. - * - * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits - * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits - * - * At the very least a mp_digit must be able to hold 7 bits - * [any size beyond that is ok provided it doesn't overflow the data type] - */ -#ifdef MP_8BIT -#ifndef MP_DIGIT_DECLARED -typedef unsigned char mp_digit; -#define MP_DIGIT_DECLARED -#endif -#ifndef MP_WORD_DECLARED -typedef unsigned short mp_word; -#define MP_WORD_DECLARED -#endif -# define MP_SIZEOF_MP_DIGIT 1 -# ifdef DIGIT_BIT -# error You must not define DIGIT_BIT when using MP_8BIT -# endif -#elif defined(MP_16BIT) -#ifndef MP_DIGIT_DECLARED -typedef unsigned short mp_digit; -#define MP_DIGIT_DECLARED -#endif -#ifndef MP_WORD_DECLARED -typedef unsigned int mp_word; -#define MP_WORD_DECLARED -#endif -# define MP_SIZEOF_MP_DIGIT 2 -# ifdef DIGIT_BIT -# error You must not define DIGIT_BIT when using MP_16BIT -# endif -#elif defined(MP_64BIT) -/* for GCC only on supported platforms */ -#ifndef MP_DIGIT_DECLARED -typedef unsigned long long mp_digit; -#define MP_DIGIT_DECLARED -#endif -typedef unsigned long mp_word __attribute__((mode(TI))); -# define DIGIT_BIT 60 -#else -/* this is the default case, 28-bit digits */ - -/* this is to make porting into LibTomCrypt easier :-) */ -#ifndef MP_DIGIT_DECLARED -typedef unsigned int mp_digit; -#define MP_DIGIT_DECLARED -#endif -#ifndef MP_WORD_DECLARED -#ifdef _WIN32 -typedef unsigned __int64 mp_word; -#else -typedef unsigned long long mp_word; -#endif -#define MP_WORD_DECLARED -#endif - -# ifdef MP_31BIT -/* this is an extension that uses 31-bit digits */ -# define DIGIT_BIT 31 -# else -/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */ -# define DIGIT_BIT 28 -# define MP_28BIT -# endif -#endif - -/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */ -#ifndef DIGIT_BIT -# define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1)) /* bits per digit */ -#endif - -#define MP_DIGIT_BIT DIGIT_BIT -#define MP_MASK ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1)) -#define MP_DIGIT_MAX MP_MASK - -typedef int mp_sign; -#define MP_ZPOS 0 /* positive integer */ -#define MP_NEG 1 /* negative */ -typedef int mp_ord; -#define MP_LT -1 /* less than */ -#define MP_EQ 0 /* equal to */ -#define MP_GT 1 /* greater than */ -typedef int mp_bool; -#define MP_YES 1 /* yes response */ -#define MP_NO 0 /* no response */ -typedef int mp_err; -#define MP_OKAY 0 /* ok result */ -#define MP_ERR -1 /* unknown error */ -#define MP_MEM -2 /* out of mem */ -#define MP_VAL -3 /* invalid input */ -#define MP_RANGE MP_VAL -#define MP_ITER -4 /* Max. iterations reached */ - -/* Primality generation flags */ -#define LTM_PRIME_BBS 0x0001 /* BBS style prime */ -#define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ -#define LTM_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */ - -/* tunable cutoffs */ - -/* define this to use lower memory usage routines (exptmods mostly) */ -/* #define MP_LOW_MEM */ - -/* default precision */ -#ifndef MP_PREC -# ifndef MP_LOW_MEM -# define MP_PREC 32 /* default digits of precision */ -# elif defined(MP_8BIT) -# define MP_PREC 16 /* default digits of precision */ -# else -# define MP_PREC 8 /* default digits of precision */ -# endif -#endif - -/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */ -#define MP_WARRAY (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1)) - -/* - * MP_WUR - warn unused result - * --------------------------- - * - * The result of functions annotated with MP_WUR must be - * checked and cannot be ignored. - * - * Most functions in libtommath return an error code. - * This error code must be checked in order to prevent crashes or invalid - * results. - * - * If you still want to avoid the error checks for quick and dirty programs - * without robustness guarantees, you can `#define MP_WUR` before including - * tommath.h, disabling the warnings. - */ -#ifndef MP_WUR -# if defined(__GNUC__) && __GNUC__ >= 4 -# define MP_WUR __attribute__((warn_unused_result)) -# else -# define MP_WUR -# endif -#endif - -#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301) -# define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) -# define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s) -# define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s) -#elif defined(_MSC_VER) && _MSC_VER >= 1500 -# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) -# define MP_DEPRECATED_PRAGMA(s) __pragma(message(s)) -#else -# define MP_DEPRECATED -# define MP_DEPRECATED_PRAGMA(s) -#endif - -#define USED(m) ((m)->used) -#define DIGIT(m,k) ((m)->dp[(k)]) -#define SIGN(m) ((m)->sign) - -/* the infamous mp_int structure */ -#ifndef MP_INT_DECLARED -#define MP_INT_DECLARED -typedef struct mp_int mp_int; -#endif -struct mp_int { - int used, alloc, sign; - mp_digit *dp; +#ifndef BN_TCL_H_ +#define BN_TCL_H_ + +#ifdef MP_NO_STDINT +# ifdef HAVE_STDINT_H +# include +#else +# include "../compat/stdint.h" +# endif +#endif +#if defined(TCL_NO_TOMMATH_H) + typedef size_t mp_digit; + typedef int mp_sign; +# define MP_ZPOS 0 /* positive integer */ +# define MP_NEG 1 /* negative */ + typedef int mp_ord; +# define MP_LT -1 /* less than */ +# define MP_EQ 0 /* equal to */ +# define MP_GT 1 /* greater than */ + typedef int mp_err; +# define MP_OKAY 0 /* no error */ +# define MP_ERR -1 /* unknown error */ +# define MP_MEM -2 /* out of mem */ +# define MP_VAL -3 /* invalid input */ +# define MP_ITER -4 /* maximum iterations reached */ +# define MP_BUF -5 /* buffer overflow, supplied buffer too small */ +# define MP_WUR /* nothing */ +# define mp_iszero(a) ((a)->used == 0) +# define mp_isneg(a) ((a)->sign != 0) + + /* the infamous mp_int structure */ +# ifndef MP_INT_DECLARED +# define MP_INT_DECLARED + typedef struct mp_int mp_int; +# endif + struct mp_int { + int used, alloc; + mp_sign sign; + mp_digit *dp; }; -/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */ -typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat); - - -/* error code to char* string */ -/* -const char *mp_error_to_string(mp_err code); -*/ - -/* ---> init and deinit bignum functions <--- */ -/* init a bignum */ -/* -mp_err mp_init(mp_int *a); -*/ - -/* free a bignum */ -/* -void mp_clear(mp_int *a); -*/ - -/* init a null terminated series of arguments */ -/* -mp_err mp_init_multi(mp_int *mp, ...); -*/ - -/* clear a null terminated series of arguments */ -/* -void mp_clear_multi(mp_int *mp, ...); -*/ - -/* exchange two ints */ -/* -void mp_exch(mp_int *a, mp_int *b); -*/ - -/* shrink ram required for a bignum */ -/* -mp_err mp_shrink(mp_int *a); -*/ - -/* grow an int to a given size */ -/* -mp_err mp_grow(mp_int *a, int size); -*/ - -/* init to a given number of digits */ -/* -mp_err mp_init_size(mp_int *a, int size); -*/ - -/* ---> Basic Manipulations <--- */ -#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO) -#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO) -#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO) -#define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO) - -/* set to zero */ -/* -void mp_zero(mp_int *a); -*/ - -/* set to a digit */ -/* -void mp_set(mp_int *a, mp_digit b); -*/ - -/* set a 32-bit const */ -/* -int mp_set_int(mp_int *a, unsigned long b); -*/ - -/* set a platform dependent unsigned long value */ -/* -int mp_set_long(mp_int *a, unsigned long b); -*/ - -/* set a platform dependent unsigned long long value */ -/* -int mp_set_long_long(mp_int *a, unsigned long long b); -*/ - -/* get a 32-bit value */ -/* -unsigned long mp_get_int(const mp_int *a); -*/ - -/* get a platform dependent unsigned long value */ -/* -unsigned long mp_get_long(const mp_int *a); -*/ - -/* get a platform dependent unsigned long long value */ -/* -unsigned long long mp_get_long_long(const mp_int *a); -*/ - -/* initialize and set a digit */ -/* -int mp_init_set(mp_int *a, mp_digit b); -*/ - -/* initialize and set 32-bit value */ -/* -int mp_init_set_int(mp_int *a, unsigned long b); -*/ - -/* copy, b = a */ -/* -int mp_copy(const mp_int *a, mp_int *b); -*/ - -/* inits and copies, a = b */ -/* -int mp_init_copy(mp_int *a, const mp_int *b); -*/ - -/* trim unused digits */ -/* -void mp_clamp(mp_int *a); -*/ - -/* import binary data */ -/* -int mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op); -*/ - -/* export binary data */ -/* -int mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op); -*/ - -/* ---> digit manipulation <--- */ - -/* right shift by "b" digits */ -/* -void mp_rshd(mp_int *a, int b); -*/ - -/* left shift by "b" digits */ -/* -int mp_lshd(mp_int *a, int b); -*/ - -/* c = a / 2**b, implemented as c = a >> b */ -/* -int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d); -*/ - -/* b = a/2 */ -/* -int mp_div_2(const mp_int *a, mp_int *b); -*/ - -/* c = a * 2**b, implemented as c = a << b */ -/* -int mp_mul_2d(const mp_int *a, int b, mp_int *c); -*/ - -/* b = a*2 */ -/* -int mp_mul_2(const mp_int *a, mp_int *b); -*/ - -/* c = a mod 2**b */ -/* -int mp_mod_2d(const mp_int *a, int b, mp_int *c); -*/ - -/* computes a = 2**b */ -/* -int mp_2expt(mp_int *a, int b); -*/ - -/* Counts the number of lsbs which are zero before the first zero bit */ -/* -int mp_cnt_lsb(const mp_int *a); -*/ - -/* I Love Earth! */ - -/* makes a pseudo-random mp_int of a given size */ -/* -int mp_rand(mp_int *a, int digits); -*/ -/* makes a pseudo-random small int of a given size */ -/* -int mp_rand_digit(mp_digit *r); -*/ - -#ifdef MP_PRNG_ENABLE_LTM_RNG -/* A last resort to provide random data on systems without any of the other - * implemented ways to gather entropy. - * It is compatible with `rng_get_bytes()` from libtomcrypt so you could - * provide that one and then set `ltm_rng = rng_get_bytes;` */ -extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); -extern void (*ltm_rng_callback)(void); -#endif - -/* ---> binary operations <--- */ -/* c = a XOR b */ -/* -int mp_xor(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* c = a OR b */ -/* -int mp_or(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* c = a AND b */ -/* -int mp_and(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* right shift (two complement) */ -/* -int mp_signed_rsh(const mp_int *a, int b, mp_int *c); -*/ - -/* ---> Basic arithmetic <--- */ - -/* b = ~a */ -/* -int mp_complement(const mp_int *a, mp_int *b); -*/ - -/* b = -a */ -/* -int mp_neg(const mp_int *a, mp_int *b); -*/ - -/* b = |a| */ -/* -int mp_abs(const mp_int *a, mp_int *b); -*/ - -/* compare a to b */ -/* -int mp_cmp(const mp_int *a, const mp_int *b); -*/ - -/* compare |a| to |b| */ -/* -int mp_cmp_mag(const mp_int *a, const mp_int *b); -*/ - -/* c = a + b */ -/* -int mp_add(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* c = a - b */ -/* -int mp_sub(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* c = a * b */ -/* -int mp_mul(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* b = a*a */ -/* -int mp_sqr(const mp_int *a, mp_int *b); -*/ - -/* a/b => cb + d == a */ -/* -int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d); -*/ - -/* c = a mod b, 0 <= c single digit functions <--- */ - -/* compare against a single digit */ -/* -int mp_cmp_d(const mp_int *a, mp_digit b); -*/ - -/* c = a + b */ -/* -int mp_add_d(const mp_int *a, mp_digit b, mp_int *c); -*/ - -/* c = a - b */ -/* -int mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); -*/ - -/* c = a * b */ -/* -int mp_mul_d(const mp_int *a, mp_digit b, mp_int *c); -*/ - -/* a/b => cb + d == a */ -/* -int mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d); -*/ - -/* a/3 => 3c + d == a */ -/* -int mp_div_3(const mp_int *a, mp_int *c, mp_digit *d); -*/ - -/* c = a**b */ -/* -int mp_expt_d(const mp_int *a, mp_digit b, mp_int *c); -*/ -/* -int mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); -*/ - -/* c = a mod b, 0 <= c number theory <--- */ - -/* d = a + b (mod c) */ -/* -int mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d); -*/ - -/* d = a - b (mod c) */ -/* -int mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d); -*/ - -/* d = a * b (mod c) */ -/* -int mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d); -*/ - -/* c = a * a (mod b) */ -/* -int mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* c = 1/a (mod b) */ -/* -int mp_invmod(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* c = (a, b) */ -/* -int mp_gcd(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* produces value such that U1*a + U2*b = U3 */ -/* -int mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3); -*/ - -/* c = [a, b] or (a*b)/(a, b) */ -/* -int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c); -*/ - -/* finds one of the b'th root of a, such that |c|**b <= |a| - * - * returns error if a < 0 and b is even - */ -/* -int mp_n_root(const mp_int *a, mp_digit b, mp_int *c); -*/ -/* -int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); -*/ - -/* special sqrt algo */ -/* -int mp_sqrt(const mp_int *arg, mp_int *ret); -*/ - -/* special sqrt (mod prime) */ -/* -int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret); -*/ - -/* is number a square? */ -/* -int mp_is_square(const mp_int *arg, int *ret); -*/ - -/* computes the jacobi c = (a | n) (or Legendre if b is prime) */ -/* -int mp_jacobi(const mp_int *a, const mp_int *n, int *c); -*/ - -/* used to setup the Barrett reduction for a given modulus b */ -/* -int mp_reduce_setup(mp_int *a, const mp_int *b); -*/ - -/* Barrett Reduction, computes a (mod b) with a precomputed value c - * - * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely - * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code]. - */ -/* -int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu); -*/ - -/* setups the montgomery reduction */ -/* -int mp_montgomery_setup(const mp_int *n, mp_digit *rho); -*/ - -/* computes a = B**n mod b without division or multiplication useful for - * normalizing numbers in a Montgomery system. - */ -/* -int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b); -*/ - -/* computes x/R == x (mod N) via Montgomery Reduction */ -/* -int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho); -*/ - -/* returns 1 if a is a valid DR modulus */ -/* -int mp_dr_is_modulus(const mp_int *a); -*/ - -/* sets the value of "d" required for mp_dr_reduce */ -/* -void mp_dr_setup(const mp_int *a, mp_digit *d); -*/ - -/* reduces a modulo n using the Diminished Radix method */ -/* -int mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k); -*/ - -/* returns true if a can be reduced with mp_reduce_2k */ -/* -int mp_reduce_is_2k(const mp_int *a); -*/ - -/* determines k value for 2k reduction */ -/* -int mp_reduce_2k_setup(const mp_int *a, mp_digit *d); -*/ - -/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ -/* -int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d); -*/ - -/* returns true if a can be reduced with mp_reduce_2k_l */ -/* -int mp_reduce_is_2k_l(const mp_int *a); -*/ - -/* determines k value for 2k reduction */ -/* -int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d); -*/ - -/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ -/* -int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d); -*/ - -/* Y = G**X (mod P) */ -/* -int mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y); -*/ - -/* ---> Primes <--- */ - -/* number of primes */ -#ifdef MP_8BIT -# define PRIME_SIZE 31 -#else -# define PRIME_SIZE 256 -#endif - -/* table of first PRIME_SIZE primes */ -#if defined(BUILD_tcl) || !defined(_WIN32) -MODULE_SCOPE const mp_digit ltm_prime_tab[PRIME_SIZE]; -#endif - -/* result=1 if a is divisible by one of the first PRIME_SIZE primes */ -/* -int mp_prime_is_divisible(const mp_int *a, int *result); -*/ - -/* performs one Fermat test of "a" using base "b". - * Sets result to 0 if composite or 1 if probable prime - */ -/* -int mp_prime_fermat(const mp_int *a, const mp_int *b, int *result); -*/ - -/* performs one Miller-Rabin test of "a" using base "b". - * Sets result to 0 if composite or 1 if probable prime - */ -/* -int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result); -*/ - -/* This gives [for a given bit size] the number of trials required - * such that Miller-Rabin gives a prob of failure lower than 2^-96 - */ -/* -int mp_prime_rabin_miller_trials(int size); -*/ - -/* performs t random rounds of Miller-Rabin on "a" additional to - * bases 2 and 3. Also performs an initial sieve of trial - * division. Determines if "a" is prime with probability - * of error no more than (1/4)**t. - * Both a strong Lucas-Selfridge to complete the BPSW test - * and a separate Frobenius test are available at compile time. - * With t<0 a deterministic test is run for primes up to - * 318665857834031151167461. With t<13 (abs(t)-13) additional - * tests with sequential small primes are run starting at 43. - * Is Fips 186.4 compliant if called with t as computed by - * mp_prime_rabin_miller_trials(); - * - * Sets result to 1 if probably prime, 0 otherwise - */ -/* -int mp_prime_is_prime(const mp_int *a, int t, int *result); -*/ - -/* finds the next prime after the number "a" using "t" trials - * of Miller-Rabin. - * - * bbs_style = 1 means the prime must be congruent to 3 mod 4 - */ -/* -int mp_prime_next_prime(mp_int *a, int t, int bbs_style); -*/ - -/* makes a truly random prime of a given size (bytes), - * call with bbs = 1 if you want it to be congruent to 3 mod 4 - * - * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can - * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself - * so it can be NULL - * - * The prime generated will be larger than 2^(8*size). - */ -#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat) - -/* makes a truly random prime of a given size (bits), - * - * Flags are as follows: - * - * LTM_PRIME_BBS - make prime congruent to 3 mod 4 - * LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS) - * LTM_PRIME_2MSB_ON - make the 2nd highest bit one - * - * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can - * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself - * so it can be NULL - * - */ -/* -int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat); -*/ - -/* ---> radix conversion <--- */ -/* -int mp_count_bits(const mp_int *a); -*/ - -/* -int mp_unsigned_bin_size(const mp_int *a); -*/ -/* -int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c); -*/ -/* -int mp_to_unsigned_bin(const mp_int *a, unsigned char *b); -*/ -/* -int mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen); -*/ - -/* -int mp_signed_bin_size(const mp_int *a); -*/ -/* -int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c); -*/ -/* -int mp_to_signed_bin(const mp_int *a, unsigned char *b); -*/ -/* -int mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen); -*/ - -/* -int mp_read_radix(mp_int *a, const char *str, int radix); -*/ -/* -int mp_toradix(const mp_int *a, char *str, int radix); -*/ -/* -int mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen); -*/ -/* -int mp_radix_size(const mp_int *a, int radix, int *size); -*/ - -#ifndef LTM_NO_FILE -/* -int mp_fread(mp_int *a, int radix, FILE *stream); -*/ -/* -int mp_fwrite(const mp_int *a, int radix, FILE *stream); -*/ -#endif - -#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len)) -#define mp_raw_size(mp) mp_signed_bin_size(mp) -#define mp_toraw(mp, str) mp_to_signed_bin((mp), (str)) -#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len)) -#define mp_mag_size(mp) mp_unsigned_bin_size(mp) -#define mp_tomag(mp, str) mp_to_unsigned_bin((mp), (str)) - -#define mp_tobinary(M, S) mp_toradix((M), (S), 2) -#define mp_tooctal(M, S) mp_toradix((M), (S), 8) -#define mp_todecimal(M, S) mp_toradix((M), (S), 10) -#define mp_tohex(M, S) mp_toradix((M), (S), 16) - -#ifdef __cplusplus -} -#endif - -#endif - - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ - +#elif !defined(BN_H_) /* If BN_H_ already defined, don't try to include tommath.h again. */ +# include "tommath.h" +#endif +#include "tclTomMathDecls.h" + +#endif Index: generic/tclTomMathDecls.h ================================================================== --- generic/tclTomMathDecls.h +++ generic/tclTomMathDecls.h @@ -14,10 +14,14 @@ #ifndef _TCLTOMMATHDECLS #define _TCLTOMMATHDECLS #include "tcl.h" +#include +#ifndef BN_H_ +#include "tclTomMath.h" +#endif /* * Define the version of the Stubs table that's exported for tommath */ @@ -28,121 +32,138 @@ (TclTomMathInitializeStubs((interp),(version),\ TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION)) /* Define custom memory allocation for libtommath */ - /* MODULE_SCOPE void* TclBNAlloc( size_t ); */ -#define TclBNAlloc(s) ((void*)Tcl_Alloc((size_t)(s))) +#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s))) +/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */ +#define TclBNCalloc(m,s) memset(ckalloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s)) /* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */ -#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s))) +#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s))) /* MODULE_SCOPE void TclBNFree( void* ); */ -#define TclBNFree(x) (Tcl_Free((char*)(x))) +#define TclBNFree(x) (ckfree((char*)(x))) + +#undef MP_MALLOC +#undef MP_CALLOC +#undef MP_REALLOC +#undef MP_FREE +#define MP_MALLOC(size) TclBNAlloc(size) +#define MP_CALLOC(nmemb, size) TclBNCalloc(nmemb, size) +#define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize) +#define MP_FREE(mem, size) TclBNFree(mem) -#define XMALLOC(size) TclBNAlloc(size) -#define XFREE(mem, size) TclBNFree(mem) -#define XREALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize) +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +#ifdef __cplusplus +extern "C" { +#endif +MODULE_SCOPE mp_err TclBN_s_mp_add_d(const mp_int *a, mp_digit b, mp_int *c); +MODULE_SCOPE mp_ord TclBN_s_mp_cmp_d(const mp_int *a, mp_digit b); +MODULE_SCOPE mp_err TclBN_s_mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d); +MODULE_SCOPE mp_err TclBN_s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *b); +MODULE_SCOPE mp_err TclBN_s_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c); +MODULE_SCOPE mp_err TclBN_s_mp_init_set(mp_int *a, mp_digit b); +MODULE_SCOPE mp_err TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c); +MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len); +MODULE_SCOPE void TclBN_s_mp_set(mp_int *a, mp_digit b); +MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); +#ifdef __cplusplus +} +#endif /* Rename the global symbols in libtommath to avoid linkage conflicts */ +#ifndef TCL_WITH_EXTERNAL_TOMMATH #define bn_reverse TclBN_reverse -#define s_mp_reverse TclBN_reverse -#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs -#define s_mp_mul_digs_fast TclBN_fast_s_mp_mul_digs -#define fast_s_mp_sqr TclBN_fast_s_mp_sqr -#define s_mp_sqr_fast TclBN_fast_s_mp_sqr #define mp_add TclBN_mp_add -#define mp_add_d TclBN_mp_add_d +#define mp_add_d TclBN_s_mp_add_d #define mp_and TclBN_mp_and #define mp_clamp TclBN_mp_clamp #define mp_clear TclBN_mp_clear #define mp_clear_multi TclBN_mp_clear_multi #define mp_cmp TclBN_mp_cmp -#define mp_cmp_d TclBN_mp_cmp_d +#define mp_cmp_d TclBN_s_mp_cmp_d #define mp_cmp_mag TclBN_mp_cmp_mag #define mp_cnt_lsb TclBN_mp_cnt_lsb #define mp_copy TclBN_mp_copy #define mp_count_bits TclBN_mp_count_bits #define mp_div TclBN_mp_div +#define mp_div_d TclBN_s_mp_div_d #define mp_div_2 TclBN_mp_div_2 +#define mp_div_3 TclBN_s_mp_div_3 #define mp_div_2d TclBN_mp_div_2d -#define mp_div_3 TclBN_mp_div_3 -#define mp_div_d TclBN_mp_div_d #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex -#define mp_get_int TclBN_mp_get_int -#define mp_get_long TclBN_mp_get_long -#define mp_get_long_long TclBN_mp_get_long_long -#define mp_grow TclBN_mp_grow -#define s_mp_get_bit TclBN_mp_get_bit +#define mp_expt_u32 TclBN_s_mp_expt_u32 +#define mp_get_mag_u64 TclBN_mp_get_mag_u64 #define mp_grow TclBN_mp_grow #define mp_init TclBN_mp_init #define mp_init_copy TclBN_mp_init_copy +#define mp_init_i64 TclBN_mp_init_i64 #define mp_init_multi TclBN_mp_init_multi -#define mp_init_set TclBN_mp_init_set -#define mp_init_set_int TclBN_mp_init_set_int +#define mp_init_set TclBN_s_mp_init_set #define mp_init_size TclBN_mp_init_size -#define mp_karatsuba_mul TclBN_mp_karatsuba_mul -#define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul -#define mp_karatsuba_sqr TclBN_mp_karatsuba_sqr -#define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr +#define mp_init_u64 TclBN_mp_init_u64 #define mp_lshd TclBN_mp_lshd #define mp_mod TclBN_mp_mod #define mp_mod_2d TclBN_mp_mod_2d #define mp_mul TclBN_mp_mul +#define mp_mul_d TclBN_s_mp_mul_d #define mp_mul_2 TclBN_mp_mul_2 #define mp_mul_2d TclBN_mp_mul_2d -#define mp_mul_d TclBN_mp_mul_d #define mp_neg TclBN_mp_neg #define mp_or TclBN_mp_or #define mp_radix_size TclBN_mp_radix_size #define mp_read_radix TclBN_mp_read_radix #define mp_rshd TclBN_mp_rshd -#define mp_set TclBN_mp_set -#define mp_set_int TclBN_mp_set_int -#define mp_set_long TclBN_mp_set_long -#define mp_set_long_long TclBN_mp_set_long_long +#define mp_s_rmap TclBN_mp_s_rmap +#define mp_s_rmap_reverse TclBN_mp_s_rmap_reverse +#define mp_s_rmap_reverse_sz TclBN_mp_s_rmap_reverse_sz +#define mp_set TclBN_s_mp_set +#define mp_set_i64 TclBN_mp_set_i64 +#define mp_set_u64 TclBN_mp_set_u64 #define mp_shrink TclBN_mp_shrink #define mp_sqr TclBN_mp_sqr #define mp_sqrt TclBN_mp_sqrt #define mp_sub TclBN_mp_sub -#define mp_sub_d TclBN_mp_sub_d +#define mp_sub_d TclBN_s_mp_sub_d #define mp_signed_rsh TclBN_mp_signed_rsh +#define mp_tc_and TclBN_mp_and +#define mp_tc_div_2d TclBN_mp_signed_rsh +#define mp_tc_or TclBN_mp_or +#define mp_tc_xor TclBN_mp_xor #define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin #define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n -#define mp_toom_mul TclBN_mp_toom_mul -#define s_mp_toom_mul TclBN_mp_toom_mul -#define mp_toom_sqr TclBN_mp_toom_sqr -#define s_mp_toom_sqr TclBN_mp_toom_sqr #define mp_toradix_n TclBN_mp_toradix_n -#define mp_unsigned_bin_size TclBN_mp_unsigned_bin_size +#define mp_to_radix TclBN_mp_to_radix +#define mp_to_ubin TclBN_mp_to_ubin +#define mp_ubin_size TclBN_mp_ubin_size #define mp_xor TclBN_mp_xor #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add +#define s_mp_balance_mul TclBN_mp_balance_mul +#define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul +#define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs +#define s_mp_mul_digs_fast TclBN_s_mp_mul_digs_fast +#define s_mp_reverse TclBN_s_mp_reverse #define s_mp_sqr TclBN_s_mp_sqr +#define s_mp_sqr_fast TclBN_s_mp_sqr_fast #define s_mp_sub TclBN_s_mp_sub - -MODULE_SCOPE void TclBN_reverse(unsigned char *s, int len); -MODULE_SCOPE int TclBN_fast_s_mp_mul_digs(const mp_int *a, - const mp_int *b, mp_int *c, int digs); -MODULE_SCOPE int TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b); -MODULE_SCOPE int TclBN_mp_karatsuba_mul(const mp_int *a, - const mp_int *b, mp_int *c); -MODULE_SCOPE int TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b); -MODULE_SCOPE int TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, - mp_int *c); -MODULE_SCOPE int TclBN_mp_toom_sqr(const mp_int *a, mp_int *b); -MODULE_SCOPE int TclBN_s_mp_add(const mp_int *a, const mp_int *b, - mp_int *c); -MODULE_SCOPE int TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, - mp_int *c, int digs); -MODULE_SCOPE int TclBN_s_mp_sqr(const mp_int *a, mp_int *b); -MODULE_SCOPE int TclBN_s_mp_sub(const mp_int *a, const mp_int *b, - mp_int *c); +#define s_mp_toom_mul TclBN_mp_toom_mul +#define s_mp_toom_sqr TclBN_mp_toom_sqr +#endif /* !TCL_WITH_EXTERNAL_TOMMATH */ + +#define mp_init_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_init_ul") TclBN_mp_init_u64(a,(unsigned int)(b))) +#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),((unsigned int)(b))),MP_OKAY)) +#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),(long)(b)),MP_OKAY)) +#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (TclBN_mp_set_u64((a),(b)),MP_OKAY)) +#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)TclBN_mp_ubin_size(mp)) #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT #else @@ -168,253 +189,311 @@ /* * Exported function declarations: */ /* 0 */ -EXTERN int TclBN_epoch(void); +EXTERN int TclBN_epoch(void) MP_WUR; /* 1 */ -EXTERN int TclBN_revision(void); +EXTERN int TclBN_revision(void) MP_WUR; /* 2 */ -EXTERN int TclBN_mp_add(const mp_int *a, const mp_int *b, - mp_int *c); +EXTERN mp_err TclBN_mp_add(const mp_int *a, const mp_int *b, + mp_int *c) MP_WUR; /* 3 */ -EXTERN int TclBN_mp_add_d(const mp_int *a, mp_digit b, - mp_int *c); +EXTERN mp_err TclBN_mp_add_d(const mp_int *a, unsigned int b, + mp_int *c) MP_WUR; /* 4 */ -EXTERN int TclBN_mp_and(const mp_int *a, const mp_int *b, - mp_int *c); +EXTERN mp_err TclBN_mp_and(const mp_int *a, const mp_int *b, + mp_int *c) MP_WUR; /* 5 */ EXTERN void TclBN_mp_clamp(mp_int *a); /* 6 */ EXTERN void TclBN_mp_clear(mp_int *a); /* 7 */ EXTERN void TclBN_mp_clear_multi(mp_int *a, ...); /* 8 */ -EXTERN int TclBN_mp_cmp(const mp_int *a, const mp_int *b); +EXTERN mp_ord TclBN_mp_cmp(const mp_int *a, const mp_int *b) MP_WUR; /* 9 */ -EXTERN int TclBN_mp_cmp_d(const mp_int *a, mp_digit b); +EXTERN mp_ord TclBN_mp_cmp_d(const mp_int *a, unsigned int b) MP_WUR; /* 10 */ -EXTERN int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b); +EXTERN mp_ord TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR; /* 11 */ -EXTERN int TclBN_mp_copy(const mp_int *a, mp_int *b); +EXTERN mp_err TclBN_mp_copy(const mp_int *a, mp_int *b) MP_WUR; /* 12 */ -EXTERN int TclBN_mp_count_bits(const mp_int *a); +EXTERN int TclBN_mp_count_bits(const mp_int *a) MP_WUR; /* 13 */ -EXTERN int TclBN_mp_div(const mp_int *a, const mp_int *b, - mp_int *q, mp_int *r); +EXTERN mp_err TclBN_mp_div(const mp_int *a, const mp_int *b, + mp_int *q, mp_int *r) MP_WUR; /* 14 */ -EXTERN int TclBN_mp_div_d(const mp_int *a, mp_digit b, - mp_int *q, mp_digit *r); +EXTERN mp_err TclBN_mp_div_d(const mp_int *a, unsigned int b, + mp_int *q, unsigned int *r) MP_WUR; /* 15 */ -EXTERN int TclBN_mp_div_2(const mp_int *a, mp_int *q); +EXTERN mp_err TclBN_mp_div_2(const mp_int *a, mp_int *q) MP_WUR; /* 16 */ -EXTERN int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, - mp_int *r); +EXTERN mp_err TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, + mp_int *r) MP_WUR; /* 17 */ -EXTERN int TclBN_mp_div_3(const mp_int *a, mp_int *q, - mp_digit *r); +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, + unsigned int *r); /* 18 */ EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ -EXTERN int TclBN_mp_expt_d(const mp_int *a, mp_digit b, - mp_int *c); +EXTERN mp_err TclBN_mp_expt_u32(const mp_int *a, unsigned int b, + mp_int *c) MP_WUR; /* 20 */ -EXTERN int TclBN_mp_grow(mp_int *a, int size); +EXTERN mp_err TclBN_mp_grow(mp_int *a, int size) MP_WUR; /* 21 */ -EXTERN int TclBN_mp_init(mp_int *a); +EXTERN mp_err TclBN_mp_init(mp_int *a) MP_WUR; /* 22 */ -EXTERN int TclBN_mp_init_copy(mp_int *a, const mp_int *b); +EXTERN mp_err TclBN_mp_init_copy(mp_int *a, const mp_int *b) MP_WUR; /* 23 */ -EXTERN int TclBN_mp_init_multi(mp_int *a, ...); +EXTERN mp_err TclBN_mp_init_multi(mp_int *a, ...) MP_WUR; /* 24 */ -EXTERN int TclBN_mp_init_set(mp_int *a, mp_digit b); +EXTERN mp_err TclBN_mp_init_set(mp_int *a, unsigned int b) MP_WUR; /* 25 */ -EXTERN int TclBN_mp_init_size(mp_int *a, int size); +EXTERN mp_err TclBN_mp_init_size(mp_int *a, int size) MP_WUR; /* 26 */ -EXTERN int TclBN_mp_lshd(mp_int *a, int shift); +EXTERN mp_err TclBN_mp_lshd(mp_int *a, int shift) MP_WUR; /* 27 */ -EXTERN int TclBN_mp_mod(const mp_int *a, const mp_int *b, - mp_int *r); +EXTERN mp_err TclBN_mp_mod(const mp_int *a, const mp_int *b, + mp_int *r) MP_WUR; /* 28 */ -EXTERN int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r); +EXTERN mp_err TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) MP_WUR; /* 29 */ -EXTERN int TclBN_mp_mul(const mp_int *a, const mp_int *b, - mp_int *p); +EXTERN mp_err TclBN_mp_mul(const mp_int *a, const mp_int *b, + mp_int *p) MP_WUR; /* 30 */ -EXTERN int TclBN_mp_mul_d(const mp_int *a, mp_digit b, - mp_int *p); +EXTERN mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, + mp_int *p) MP_WUR; /* 31 */ -EXTERN int TclBN_mp_mul_2(const mp_int *a, mp_int *p); +EXTERN mp_err TclBN_mp_mul_2(const mp_int *a, mp_int *p) MP_WUR; /* 32 */ -EXTERN int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p); +EXTERN mp_err TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) MP_WUR; /* 33 */ -EXTERN int TclBN_mp_neg(const mp_int *a, mp_int *b); +EXTERN mp_err TclBN_mp_neg(const mp_int *a, mp_int *b) MP_WUR; /* 34 */ -EXTERN int TclBN_mp_or(const mp_int *a, const mp_int *b, - mp_int *c); +EXTERN mp_err TclBN_mp_or(const mp_int *a, const mp_int *b, + mp_int *c) MP_WUR; /* 35 */ -EXTERN int TclBN_mp_radix_size(const mp_int *a, int radix, - int *size); +EXTERN mp_err TclBN_mp_radix_size(const mp_int *a, int radix, + int *size) MP_WUR; /* 36 */ -EXTERN int TclBN_mp_read_radix(mp_int *a, const char *str, - int radix); +EXTERN mp_err TclBN_mp_read_radix(mp_int *a, const char *str, + int radix) MP_WUR; /* 37 */ EXTERN void TclBN_mp_rshd(mp_int *a, int shift); /* 38 */ -EXTERN int TclBN_mp_shrink(mp_int *a); +EXTERN mp_err TclBN_mp_shrink(mp_int *a) MP_WUR; /* 39 */ -EXTERN void TclBN_mp_set(mp_int *a, mp_digit b); +TCL_DEPRECATED("macro calling mp_set_u64") +void TclBN_mp_set(mp_int *a, unsigned int b); /* 40 */ -EXTERN int TclBN_mp_sqr(const mp_int *a, mp_int *b); +EXTERN mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b); /* 41 */ -EXTERN int TclBN_mp_sqrt(const mp_int *a, mp_int *b); +EXTERN mp_err TclBN_mp_sqrt(const mp_int *a, mp_int *b) MP_WUR; /* 42 */ -EXTERN int TclBN_mp_sub(const mp_int *a, const mp_int *b, - mp_int *c); +EXTERN mp_err TclBN_mp_sub(const mp_int *a, const mp_int *b, + mp_int *c) MP_WUR; /* 43 */ -EXTERN int TclBN_mp_sub_d(const mp_int *a, mp_digit b, - mp_int *c); +EXTERN mp_err TclBN_mp_sub_d(const mp_int *a, unsigned int b, + mp_int *c) MP_WUR; /* 44 */ -EXTERN int TclBN_mp_to_unsigned_bin(const mp_int *a, +TCL_DEPRECATED("Use mp_to_ubin") +mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b); /* 45 */ -EXTERN int TclBN_mp_to_unsigned_bin_n(const mp_int *a, +TCL_DEPRECATED("Use mp_to_ubin") +mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen); /* 46 */ -EXTERN int TclBN_mp_toradix_n(const mp_int *a, char *str, +TCL_DEPRECATED("Use mp_to_radix") +mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen); /* 47 */ -EXTERN int TclBN_mp_unsigned_bin_size(const mp_int *a); +EXTERN size_t TclBN_mp_ubin_size(const mp_int *a); /* 48 */ -EXTERN int TclBN_mp_xor(const mp_int *a, const mp_int *b, - mp_int *c); +EXTERN mp_err TclBN_mp_xor(const mp_int *a, const mp_int *b, + mp_int *c) MP_WUR; /* 49 */ EXTERN void TclBN_mp_zero(mp_int *a); -/* Slot 50 is reserved */ -/* Slot 51 is reserved */ -/* Slot 52 is reserved */ -/* Slot 53 is reserved */ -/* Slot 54 is reserved */ -/* Slot 55 is reserved */ -/* Slot 56 is reserved */ -/* Slot 57 is reserved */ -/* Slot 58 is reserved */ -/* Slot 59 is reserved */ -/* Slot 60 is reserved */ +/* 50 */ +TCL_DEPRECATED("is private function in libtommath") +void TclBN_reverse(unsigned char *s, int len); +/* 51 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, + const mp_int *b, mp_int *c, int digs); +/* 52 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b); +/* 53 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_mp_karatsuba_mul(const mp_int *a, + const mp_int *b, mp_int *c); +/* 54 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b); +/* 55 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, + mp_int *c); +/* 56 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b); +/* 57 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, + mp_int *c); +/* 58 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, + mp_int *c, int digs); +/* 59 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b); +/* 60 */ +TCL_DEPRECATED("is private function in libtommath") +mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, + mp_int *c); /* 61 */ -EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i); +TCL_DEPRECATED("macro calling mp_init_u64") +mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i); /* 62 */ -EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i); +TCL_DEPRECATED("macro calling mp_set_u64") +void TclBN_mp_set_ul(mp_int *a, unsigned long i); /* 63 */ -EXTERN int TclBN_mp_cnt_lsb(const mp_int *a); -/* Slot 64 is reserved */ -/* Slot 65 is reserved */ -/* Slot 66 is reserved */ +EXTERN int TclBN_mp_cnt_lsb(const mp_int *a) MP_WUR; +/* 64 */ +TCL_DEPRECATED("macro calling mp_init_i64") +int TclBN_mp_init_l(mp_int *bignum, long initVal); +/* 65 */ +EXTERN int TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) MP_WUR; +/* 66 */ +EXTERN int TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) MP_WUR; /* 67 */ -EXTERN int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, +TCL_DEPRECATED("Use mp_expt_u32") +mp_err TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, int fast); /* 68 */ -EXTERN int TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i); +EXTERN void TclBN_mp_set_u64(mp_int *a, uint64_t i); /* 69 */ -EXTERN Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a); +EXTERN uint64_t TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR; /* 70 */ -EXTERN int TclBN_mp_set_long(mp_int *a, unsigned long i); -/* 71 */ -EXTERN unsigned long TclBN_mp_get_long(const mp_int *a); -/* 72 */ -EXTERN unsigned long TclBN_mp_get_int(const mp_int *a); -/* Slot 73 is reserved */ -/* Slot 74 is reserved */ -/* Slot 75 is reserved */ -/* 76 */ -EXTERN int TclBN_mp_signed_rsh(const mp_int *a, int b, +EXTERN void TclBN_mp_set_i64(mp_int *a, int64_t i); +/* Slot 71 is reserved */ +/* Slot 72 is reserved */ +/* 73 */ +TCL_DEPRECATED("merged with mp_and") +mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, + mp_int *c); +/* 74 */ +TCL_DEPRECATED("merged with mp_or") +mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, + mp_int *c); +/* 75 */ +TCL_DEPRECATED("merged with mp_xor") +mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c); -/* 77 */ -EXTERN int TclBN_mp_get_bit(const mp_int *a, int b); +/* 76 */ +EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, + mp_int *c) MP_WUR; +/* Slot 77 is reserved */ +/* 78 */ +EXTERN int TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, + size_t maxlen, size_t *written) MP_WUR; +/* 79 */ +EXTERN mp_err TclBN_mp_div_ld(const mp_int *a, uint64_t b, + mp_int *q, uint64_t *r) MP_WUR; +/* 80 */ +EXTERN int TclBN_mp_to_radix(const mp_int *a, char *str, + size_t maxlen, size_t *written, int radix) MP_WUR; typedef struct TclTomMathStubs { int magic; void *hooks; - int (*tclBN_epoch) (void); /* 0 */ - int (*tclBN_revision) (void); /* 1 */ - int (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 2 */ - int (*tclBN_mp_add_d) (const mp_int *a, mp_digit b, mp_int *c); /* 3 */ - int (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 4 */ + int (*tclBN_epoch) (void) MP_WUR; /* 0 */ + int (*tclBN_revision) (void) MP_WUR; /* 1 */ + mp_err (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 2 */ + mp_err (*tclBN_mp_add_d) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 3 */ + mp_err (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 4 */ void (*tclBN_mp_clamp) (mp_int *a); /* 5 */ void (*tclBN_mp_clear) (mp_int *a); /* 6 */ void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */ - int (*tclBN_mp_cmp) (const mp_int *a, const mp_int *b); /* 8 */ - int (*tclBN_mp_cmp_d) (const mp_int *a, mp_digit b); /* 9 */ - int (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b); /* 10 */ - int (*tclBN_mp_copy) (const mp_int *a, mp_int *b); /* 11 */ - int (*tclBN_mp_count_bits) (const mp_int *a); /* 12 */ - int (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r); /* 13 */ - int (*tclBN_mp_div_d) (const mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */ - int (*tclBN_mp_div_2) (const mp_int *a, mp_int *q); /* 15 */ - int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */ - int (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, mp_digit *r); /* 17 */ + mp_ord (*tclBN_mp_cmp) (const mp_int *a, const mp_int *b) MP_WUR; /* 8 */ + mp_ord (*tclBN_mp_cmp_d) (const mp_int *a, unsigned int b) MP_WUR; /* 9 */ + mp_ord (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b) MP_WUR; /* 10 */ + mp_err (*tclBN_mp_copy) (const mp_int *a, mp_int *b) MP_WUR; /* 11 */ + int (*tclBN_mp_count_bits) (const mp_int *a) MP_WUR; /* 12 */ + mp_err (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) MP_WUR; /* 13 */ + mp_err (*tclBN_mp_div_d) (const mp_int *a, unsigned int b, mp_int *q, unsigned int *r) MP_WUR; /* 14 */ + mp_err (*tclBN_mp_div_2) (const mp_int *a, mp_int *q) MP_WUR; /* 15 */ + mp_err (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; /* 16 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, unsigned int *r); /* 17 */ void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */ - int (*tclBN_mp_expt_d) (const mp_int *a, mp_digit b, mp_int *c); /* 19 */ - int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */ - int (*tclBN_mp_init) (mp_int *a); /* 21 */ - int (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */ - int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */ - int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */ - int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */ - int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */ - int (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r); /* 27 */ - int (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */ - int (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p); /* 29 */ - int (*tclBN_mp_mul_d) (const mp_int *a, mp_digit b, mp_int *p); /* 30 */ - int (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p); /* 31 */ - int (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */ - int (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */ - int (*tclBN_mp_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 34 */ - int (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size); /* 35 */ - int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */ + mp_err (*tclBN_mp_expt_u32) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 19 */ + mp_err (*tclBN_mp_grow) (mp_int *a, int size) MP_WUR; /* 20 */ + mp_err (*tclBN_mp_init) (mp_int *a) MP_WUR; /* 21 */ + mp_err (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b) MP_WUR; /* 22 */ + mp_err (*tclBN_mp_init_multi) (mp_int *a, ...) MP_WUR; /* 23 */ + mp_err (*tclBN_mp_init_set) (mp_int *a, unsigned int b) MP_WUR; /* 24 */ + mp_err (*tclBN_mp_init_size) (mp_int *a, int size) MP_WUR; /* 25 */ + mp_err (*tclBN_mp_lshd) (mp_int *a, int shift) MP_WUR; /* 26 */ + mp_err (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r) MP_WUR; /* 27 */ + mp_err (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r) MP_WUR; /* 28 */ + mp_err (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p) MP_WUR; /* 29 */ + mp_err (*tclBN_mp_mul_d) (const mp_int *a, unsigned int b, mp_int *p) MP_WUR; /* 30 */ + mp_err (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p) MP_WUR; /* 31 */ + mp_err (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p) MP_WUR; /* 32 */ + mp_err (*tclBN_mp_neg) (const mp_int *a, mp_int *b) MP_WUR; /* 33 */ + mp_err (*tclBN_mp_or) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 34 */ + mp_err (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size) MP_WUR; /* 35 */ + mp_err (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix) MP_WUR; /* 36 */ void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */ - int (*tclBN_mp_shrink) (mp_int *a); /* 38 */ - void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */ - int (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */ - int (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b); /* 41 */ - int (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 42 */ - int (*tclBN_mp_sub_d) (const mp_int *a, mp_digit b, mp_int *c); /* 43 */ - int (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */ - int (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */ - int (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */ - int (*tclBN_mp_unsigned_bin_size) (const mp_int *a); /* 47 */ - int (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 48 */ + mp_err (*tclBN_mp_shrink) (mp_int *a) MP_WUR; /* 38 */ + TCL_DEPRECATED_API("macro calling mp_set_u64") void (*tclBN_mp_set) (mp_int *a, unsigned int b); /* 39 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */ + mp_err (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b) MP_WUR; /* 41 */ + mp_err (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 42 */ + mp_err (*tclBN_mp_sub_d) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 43 */ + TCL_DEPRECATED_API("Use mp_to_ubin") mp_err (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */ + TCL_DEPRECATED_API("Use mp_to_ubin") mp_err (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */ + TCL_DEPRECATED_API("Use mp_to_radix") mp_err (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */ + size_t (*tclBN_mp_ubin_size) (const mp_int *a); /* 47 */ + mp_err (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 48 */ void (*tclBN_mp_zero) (mp_int *a); /* 49 */ - void (*reserved50)(void); - void (*reserved51)(void); - void (*reserved52)(void); - void (*reserved53)(void); - void (*reserved54)(void); - void (*reserved55)(void); - void (*reserved56)(void); - void (*reserved57)(void); - void (*reserved58)(void); - void (*reserved59)(void); - void (*reserved60)(void); - int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */ - int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */ - int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */ - void (*reserved64)(void); - void (*reserved65)(void); - void (*reserved66)(void); - int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */ - int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */ - Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */ - int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */ - unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */ - unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */ - void (*reserved73)(void); - void (*reserved74)(void); - void (*reserved75)(void); - int (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c); /* 76 */ - int (*tclBN_mp_get_bit) (const mp_int *a, int b); /* 77 */ + TCL_DEPRECATED_API("is private function in libtommath") void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_mul_digs_fast) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 51 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sqr_fast) (const mp_int *a, mp_int *b); /* 52 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_karatsuba_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 53 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_karatsuba_sqr) (const mp_int *a, mp_int *b); /* 54 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_toom_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 55 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_toom_sqr) (const mp_int *a, mp_int *b); /* 56 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 57 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 58 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sqr) (const mp_int *a, mp_int *b); /* 59 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 60 */ + TCL_DEPRECATED_API("macro calling mp_init_u64") mp_err (*tclBN_mp_init_ul) (mp_int *a, unsigned long i); /* 61 */ + TCL_DEPRECATED_API("macro calling mp_set_u64") void (*tclBN_mp_set_ul) (mp_int *a, unsigned long i); /* 62 */ + int (*tclBN_mp_cnt_lsb) (const mp_int *a) MP_WUR; /* 63 */ + TCL_DEPRECATED_API("macro calling mp_init_i64") int (*tclBN_mp_init_l) (mp_int *bignum, long initVal); /* 64 */ + int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */ + int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */ + TCL_DEPRECATED_API("Use mp_expt_u32") mp_err (*tclBN_mp_expt_d_ex) (const mp_int *a, unsigned int b, mp_int *c, int fast); /* 67 */ + void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */ + uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */ + void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */ + void (*reserved71)(void); + void (*reserved72)(void); + TCL_DEPRECATED_API("merged with mp_and") mp_err (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */ + TCL_DEPRECATED_API("merged with mp_or") mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */ + TCL_DEPRECATED_API("merged with mp_xor") mp_err (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */ + mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */ + void (*reserved77)(void); + int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */ + mp_err (*tclBN_mp_div_ld) (const mp_int *a, uint64_t b, mp_int *q, uint64_t *r) MP_WUR; /* 79 */ + int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */ } TclTomMathStubs; extern const TclTomMathStubs *tclTomMathStubsPtr; #ifdef __cplusplus @@ -463,12 +542,12 @@ (tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */ #define TclBN_mp_div_3 \ (tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */ #define TclBN_mp_exch \ (tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */ -#define TclBN_mp_expt_d \ - (tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */ +#define TclBN_mp_expt_u32 \ + (tclTomMathStubsPtr->tclBN_mp_expt_u32) /* 19 */ #define TclBN_mp_grow \ (tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */ #define TclBN_mp_init \ (tclTomMathStubsPtr->tclBN_mp_init) /* 21 */ #define TclBN_mp_init_copy \ @@ -519,59 +598,157 @@ (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */ #define TclBN_mp_to_unsigned_bin_n \ (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */ #define TclBN_mp_toradix_n \ (tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */ -#define TclBN_mp_unsigned_bin_size \ - (tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */ +#define TclBN_mp_ubin_size \ + (tclTomMathStubsPtr->tclBN_mp_ubin_size) /* 47 */ #define TclBN_mp_xor \ (tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */ #define TclBN_mp_zero \ (tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */ -/* Slot 50 is reserved */ -/* Slot 51 is reserved */ -/* Slot 52 is reserved */ -/* Slot 53 is reserved */ -/* Slot 54 is reserved */ -/* Slot 55 is reserved */ -/* Slot 56 is reserved */ -/* Slot 57 is reserved */ -/* Slot 58 is reserved */ -/* Slot 59 is reserved */ -/* Slot 60 is reserved */ -#define TclBN_mp_init_set_int \ - (tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */ -#define TclBN_mp_set_int \ - (tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */ +#define TclBN_reverse \ + (tclTomMathStubsPtr->tclBN_reverse) /* 50 */ +#define TclBN_s_mp_mul_digs_fast \ + (tclTomMathStubsPtr->tclBN_s_mp_mul_digs_fast) /* 51 */ +#define TclBN_s_mp_sqr_fast \ + (tclTomMathStubsPtr->tclBN_s_mp_sqr_fast) /* 52 */ +#define TclBN_mp_karatsuba_mul \ + (tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */ +#define TclBN_mp_karatsuba_sqr \ + (tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */ +#define TclBN_mp_toom_mul \ + (tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */ +#define TclBN_mp_toom_sqr \ + (tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */ +#define TclBN_s_mp_add \ + (tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */ +#define TclBN_s_mp_mul_digs \ + (tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */ +#define TclBN_s_mp_sqr \ + (tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */ +#define TclBN_s_mp_sub \ + (tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */ +#define TclBN_mp_init_ul \ + (tclTomMathStubsPtr->tclBN_mp_init_ul) /* 61 */ +#define TclBN_mp_set_ul \ + (tclTomMathStubsPtr->tclBN_mp_set_ul) /* 62 */ #define TclBN_mp_cnt_lsb \ (tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */ -/* Slot 64 is reserved */ -/* Slot 65 is reserved */ -/* Slot 66 is reserved */ +#define TclBN_mp_init_l \ + (tclTomMathStubsPtr->tclBN_mp_init_l) /* 64 */ +#define TclBN_mp_init_i64 \ + (tclTomMathStubsPtr->tclBN_mp_init_i64) /* 65 */ +#define TclBN_mp_init_u64 \ + (tclTomMathStubsPtr->tclBN_mp_init_u64) /* 66 */ #define TclBN_mp_expt_d_ex \ (tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */ -#define TclBN_mp_set_long_long \ - (tclTomMathStubsPtr->tclBN_mp_set_long_long) /* 68 */ -#define TclBN_mp_get_long_long \ - (tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */ -#define TclBN_mp_set_long \ - (tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */ -#define TclBN_mp_get_long \ - (tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */ -#define TclBN_mp_get_int \ - (tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */ -/* Slot 73 is reserved */ -/* Slot 74 is reserved */ -/* Slot 75 is reserved */ +#define TclBN_mp_set_u64 \ + (tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */ +#define TclBN_mp_get_mag_u64 \ + (tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */ +#define TclBN_mp_set_i64 \ + (tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */ +/* Slot 71 is reserved */ +/* Slot 72 is reserved */ +#define TclBN_mp_tc_and \ + (tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */ +#define TclBN_mp_tc_or \ + (tclTomMathStubsPtr->tclBN_mp_tc_or) /* 74 */ +#define TclBN_mp_tc_xor \ + (tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ -#define TclBN_mp_get_bit \ - (tclTomMathStubsPtr->tclBN_mp_get_bit) /* 77 */ +/* Slot 77 is reserved */ +#define TclBN_mp_to_ubin \ + (tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */ +#define TclBN_mp_div_ld \ + (tclTomMathStubsPtr->tclBN_mp_div_ld) /* 79 */ +#define TclBN_mp_to_radix \ + (tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ +#if defined(USE_TCL_STUBS) +#undef mp_add_d +#define mp_add_d TclBN_mp_add_d +#undef mp_cmp_d +#define mp_cmp_d TclBN_mp_cmp_d +#undef mp_div_d +#ifdef MP_64BIT +#define mp_div_d TclBN_mp_div_ld +#else +#define mp_div_d TclBN_mp_div_d +#endif +#undef mp_sub_d +#define mp_sub_d TclBN_mp_sub_d +#undef mp_init_set +#define mp_init_set TclBN_mp_init_set +#undef mp_mul_d +#define mp_mul_d TclBN_mp_mul_d +#undef mp_set +#define mp_set TclBN_mp_set +#undef mp_expt_u32 +#define mp_expt_u32 TclBN_mp_expt_u32 +#endif /* USE_TCL_STUBS */ + +#define TclBNInitBignumFromLong(a,b) \ + do { \ + (a)->dp = NULL; \ + (void)mp_init_i64((a),(b)); \ + if ((a)->dp == NULL) { \ + Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); \ + } \ + } while (0) +#undef TclBNInitBignumFromWideInt +#define TclBNInitBignumFromWideInt(a,b) \ + do { \ + (a)->dp = NULL; \ + (void)mp_init_i64((a),(b)); \ + if ((a)->dp == NULL) { \ + Tcl_Panic("initialization failure in TclBNInitBignumFromWideInt"); \ + } \ + } while (0) +#undef TclBNInitBignumFromWideUInt +#define TclBNInitBignumFromWideUInt(a,b) \ + do { \ + (a)->dp = NULL; \ + (void)mp_init_u64((a),(b)); \ + if ((a)->dp == NULL) { \ + Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); \ + } \ + } while (0) +#undef mp_get_ll +#define mp_get_ll(a) ((long long)mp_get_i64(a)) +#undef mp_set_ll +#define mp_set_ll(a,b) mp_set_i64(a,b) +#undef mp_init_ll +#define mp_init_ll(a,b) mp_init_i64(a,b) +#undef mp_get_ull +#define mp_get_ull(a) ((unsigned long long)mp_get_i64(a)) +#undef mp_set_ull +#define mp_set_ull(a,b) mp_set_u64(a,b) +#undef mp_init_ull +#define mp_init_ull(a,b) mp_init_u64(a,b) +#undef mp_set +#define mp_set(a,b) mp_set_i64((a),(int32_t)(b)) +#define mp_set_i32(a,b) mp_set_i64((a),(int32_t)(b)) +#define mp_set_l(a,b) mp_set_i64((a),(long)(b)) +#define mp_set_u32(a,b) mp_set_u64((a),(uint32_t)(b)) +#define mp_set_ul(a,b) mp_set_u64((a),(unsigned long)(b)) +#define mp_init_i32(a,b) mp_init_i64((a),(int32_t)(b)) +#define mp_init_l(a,b) mp_init_i64((a),(long)(b)) +#define mp_init_u32(a,b) mp_init_u64((a),(uint32_t)(b)) +#define mp_init_ul(a,b) mp_init_u64((a),(unsigned long)(b)) +#undef mp_iseven +#undef mp_isodd +#define mp_iseven(a) (!mp_isodd(a)) +#define mp_isodd(a) (((a)->used != 0) && (((a)->dp[0] & 1) != 0)) +#undef mp_sqr +#define mp_sqr(a,b) mp_mul(a,a,b) + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLINTDECLS */ Index: generic/tclTomMathInterface.c ================================================================== --- generic/tclTomMathInterface.c +++ generic/tclTomMathInterface.c @@ -11,11 +11,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" +#include "tclTomMath.h" MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; /* *---------------------------------------------------------------------- @@ -87,72 +87,13 @@ int TclBN_revision(void) { return TCLTOMMATH_REVISION; } - -/* - *---------------------------------------------------------------------- - * - * TclInitBignumFromWideInt -- - * - * Allocate and initialize a 'bignum' from a Tcl_WideInt - * - * Results: - * None. - * - * Side effects: - * The 'bignum' is constructed. - * - *---------------------------------------------------------------------- - */ - -void -TclInitBignumFromWideInt( - mp_int *a, /* Bignum to initialize */ - Tcl_WideInt v) /* Initial value */ -{ - if (mp_init(a) != MP_OKAY) { - Tcl_Panic("initialization failure in TclInitBignumFromWideInt"); - } - if (v < (Tcl_WideInt)0) { - mp_set_long_long(a, (Tcl_WideUInt)(-v)); - mp_neg(a, a); - } else { - mp_set_long_long(a, (Tcl_WideUInt)v); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclInitBignumFromWideUInt -- - * - * Allocate and initialize a 'bignum' from a Tcl_WideUInt - * - * Results: - * None. - * - * Side effects: - * The 'bignum' is constructed. - * - *---------------------------------------------------------------------- - */ - -void -TclInitBignumFromWideUInt( - mp_int *a, /* Bignum to initialize */ - Tcl_WideUInt v) /* Initial value */ -{ - if (mp_init(a) != MP_OKAY) { - Tcl_Panic("initialization failure in TclInitBignumFromWideUInt"); - } - mp_set_long_long(a, v); -} /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclTomMathStubLib.c ================================================================== --- generic/tclTomMathStubLib.c +++ generic/tclTomMathStubLib.c @@ -10,10 +10,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#include "tclTomMath.h" MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; Index: generic/tclTrace.c ================================================================== --- generic/tclTrace.c +++ generic/tclTrace.c @@ -77,12 +77,11 @@ * currently executing. Therefore we don't let * further traces execute. * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly * by the command being traced, not because of * an internal trace. - * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used - * in command execution traces. + * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces. */ #define TCL_TRACE_ENTER_DURING_EXEC 4 #define TCL_TRACE_LEAVE_DURING_EXEC 8 #define TCL_TRACE_ANY_EXEC 15 @@ -119,11 +118,11 @@ /* * Declarations for local functions to this file: */ static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr, - Command *cmdPtr, const char *command, size_t numChars, + Command *cmdPtr, const char *command, int numChars, int objc, Tcl_Obj *const objv[]); static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void TraceCommandProc(ClientData clientData, Tcl_Interp *interp, const char *oldName, @@ -134,11 +133,11 @@ const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, - const char *part2, register VarTrace *tracePtr); + const char *part2, VarTrace *tracePtr); /* * The following structure holds the client data for string-based * trace procs */ @@ -180,14 +179,13 @@ * Side effects: * See the user documentation. *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_TraceObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int optionIndex; @@ -269,12 +267,11 @@ #ifndef TCL_REMOVE_OBSOLETE_TRACES case TRACE_OLD_VARIABLE: case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; Tcl_Obj *opsList; - int code; - size_t numFlags; + int code, numFlags; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); return TCL_ERROR; } @@ -322,13 +319,13 @@ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "name"); return TCL_ERROR; } resultListPtr = Tcl_NewObj(); - name = TclGetString(objv[2]); + name = Tcl_GetString(objv[2]); FOREACH_VAR_TRACE(interp, name, clientData) { - TraceVarInfo *tvarPtr = clientData; + TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *q = ops; pairObjPtr = Tcl_NewListObj(0, NULL); if (tvarPtr->flags & TCL_TRACE_READS) { *q = 'r'; @@ -402,13 +399,13 @@ Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; + int commandLength, index; const char *name, *command; - size_t commandLength, length; + size_t length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "enter", "leave", "enterstep", "leavestep", NULL @@ -466,13 +463,13 @@ flags |= TCL_TRACE_LEAVE_DURING_EXEC; break; } } command = TclGetStringFromObj(objv[5], &commandLength); - length = commandLength; + length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = Tcl_Alloc( + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; @@ -483,14 +480,14 @@ if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } memcpy(tcmdPtr->command, command, length+1); - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); return TCL_ERROR; } } else { /* * Search through all of our traces on this command to see if @@ -502,17 +499,17 @@ /* * First ensure the name given is valid. */ - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } FOREACH_COMMAND_TRACE(interp, name, clientData) { - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; /* * In checking the 'flags' field we must remove any extraneous * flags which may have been temporarily added by various * pieces of the trace mechanism. @@ -520,11 +517,11 @@ if ((tcmdPtr->length == length) && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags) && (strncmp(command, tcmdPtr->command, - length) == 0)) { + (size_t) length) == 0)) { flags |= TCL_TRACE_DELETE; if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } @@ -536,21 +533,21 @@ * we created to allow 'step' traces. */ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - Tcl_Free(tcmdPtr->startCmd); + ckfree(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion. */ tcmdPtr->flags = 0; } if (tcmdPtr->refCount-- <= 1) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); } break; } } } @@ -563,11 +560,11 @@ if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); /* * First ensure the name given is valid. */ @@ -577,11 +574,11 @@ resultListPtr = Tcl_NewListObj(0, NULL); FOREACH_COMMAND_TRACE(interp, name, clientData) { int numOps = 0; Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr; - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; /* * Build a list with the ops list as the first obj element and the * tcmdPtr->command string as the second obj element. Append this * list (as an element) to the end of the result object list. @@ -650,13 +647,13 @@ Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; + int commandLength, index; const char *name, *command; - size_t commandLength, length; + size_t length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "delete", "rename", NULL }; enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; switch ((enum traceOptions) optionIndex) { @@ -703,13 +700,13 @@ break; } } command = TclGetStringFromObj(objv[5], &commandLength); - length = commandLength; + length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = Tcl_Alloc( + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; @@ -716,14 +713,14 @@ tcmdPtr->startCmd = NULL; tcmdPtr->length = length; tcmdPtr->refCount = 1; flags |= TCL_TRACE_DELETE; memcpy(tcmdPtr->command, command, length+1); - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); return TCL_ERROR; } } else { /* * Search through all of our traces on this command to see if @@ -735,26 +732,26 @@ /* * First ensure the name given is valid. */ - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } FOREACH_COMMAND_TRACE(interp, name, clientData) { - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags) && (strncmp(command, tcmdPtr->command, - length) == 0)) { + (size_t) length) == 0)) { Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE, TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; if (tcmdPtr->refCount-- <= 1) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); } break; } } } @@ -771,20 +768,20 @@ /* * First ensure the name given is valid. */ - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } resultListPtr = Tcl_NewListObj(0, NULL); FOREACH_COMMAND_TRACE(interp, name, clientData) { int numOps = 0; Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr; - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; /* * Build a list with the ops list as the first obj element and the * tcmdPtr->command string as the second obj element. Append this * list (as an element) to the end of the result object list. @@ -844,13 +841,13 @@ Tcl_Interp *interp, /* Current interpreter. */ int optionIndex, /* Add, info or remove */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; + int commandLength, index; const char *name, *command; - size_t commandLength, length; + size_t length; ClientData clientData; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "array", "read", "unset", "write", NULL }; @@ -906,13 +903,13 @@ flags |= TCL_TRACE_WRITES; break; } } command = TclGetStringFromObj(objv[5], &commandLength); - length = commandLength; + length = (size_t) commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc( + CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; #ifndef TCL_REMOVE_OBSOLETE_TRACES @@ -924,35 +921,35 @@ flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT; memcpy(ctvarPtr->traceCmdInfo.command, command, length+1); ctvarPtr->traceInfo.traceProc = TraceVarProc; ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo; ctvarPtr->traceInfo.flags = flags; - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr) != TCL_OK) { - Tcl_Free(ctvarPtr); + ckfree(ctvarPtr); return TCL_ERROR; } } else { /* * Search through all of our traces on this variable to see if * there's one with the given command. If so, then delete the * first one that matches. */ - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { - TraceVarInfo *tvarPtr = clientData; + TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; if ((tvarPtr->length == length) && ((tvarPtr->flags #ifndef TCL_REMOVE_OBSOLETE_TRACES & ~TCL_TRACE_OLD_STYLE #endif )==flags) && (strncmp(command, tvarPtr->command, - length) == 0)) { + (size_t) length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); break; } @@ -967,14 +964,14 @@ Tcl_WrongNumArgs(interp, 3, objv, "name"); return TCL_ERROR; } resultListPtr = Tcl_NewObj(); - name = TclGetString(objv[3]); + name = Tcl_GetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr; - TraceVarInfo *tvarPtr = clientData; + TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; /* * Build a list with the ops list as the first obj element and the * tcmdPtr->command string as the second obj element. Append this * list (as an element) to the end of the result object list. @@ -1039,20 +1036,19 @@ ClientData Tcl_CommandTraceInfo( Tcl_Interp *interp, /* Interpreter containing command. */ const char *cmdName, /* Name of command. */ - int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY (can be 0). */ + TCL_UNUSED(int) /*flags*/, Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; - register CommandTrace *tracePtr; + CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return NULL; @@ -1113,11 +1109,11 @@ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; - register CommandTrace *tracePtr; + CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return TCL_ERROR; @@ -1125,11 +1121,11 @@ /* * Set up trace information. */ - tracePtr = Tcl_Alloc(sizeof(CommandTrace)); + tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC); tracePtr->nextPtr = cmdPtr->tracePtr; @@ -1176,11 +1172,11 @@ * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - register CommandTrace *tracePtr; + CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; Interp *iPtr = (Interp *) interp; ActiveCommandTrace *activePtr; int hasExecTraces = 0; @@ -1231,11 +1227,11 @@ prevPtr->nextPtr = tracePtr->nextPtr; } tracePtr->flags = 0; if (tracePtr->refCount-- <= 1) { - Tcl_Free(tracePtr); + ckfree(tracePtr); } if (hasExecTraces) { for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { @@ -1278,11 +1274,10 @@ * Depends on the command associated with the trace. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void TraceCommandProc( ClientData clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ const char *oldName, /* Name of command being changed. */ @@ -1290,11 +1285,11 @@ * means command is being deleted (renamed to * ""). */ int flags) /* OR-ed bits giving operation and other * information. */ { - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; int code; Tcl_DString cmd; tcmdPtr->refCount++; @@ -1304,11 +1299,11 @@ * Generate a command to execute by appending list elements for the * old and new command name and the operation. */ Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); + Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length); Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { TclDStringAppendLiteral(&cmd, " rename"); } else if (flags & TCL_TRACE_DELETE) { @@ -1346,11 +1341,11 @@ Tcl_InterpState state; if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - Tcl_Free(tcmdPtr->startCmd); + ckfree(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion, until exec trace returns. */ @@ -1388,11 +1383,11 @@ TraceCommandProc, clientData); Tcl_RestoreInterpState(interp, state); tcmdPtr->refCount--; } if (tcmdPtr->refCount-- <= 1) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); } } /* *---------------------------------------------------------------------- @@ -1422,12 +1417,11 @@ int TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - size_t numChars, /* The number of characters in 'command' which - * are part of the command string. */ + TCL_UNUSED(int) /*numChars*/, Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ @@ -1468,11 +1462,11 @@ } else { active.reverseScan = 0; active.nextTracePtr = tracePtr->nextPtr; } if (tracePtr->traceProc == TraceCommandProc) { - TraceCommandInfo *tcmdPtr = tracePtr->clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData; if (tcmdPtr->flags != 0) { tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; tcmdPtr->curCode = code; tcmdPtr->refCount++; @@ -1480,11 +1474,11 @@ state = Tcl_SaveInterpState(interp, code); } traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); if (tcmdPtr->refCount-- <= 1) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); } } } if (active.nextTracePtr) { lastTracePtr = active.nextTracePtr->nextPtr; @@ -1528,11 +1522,11 @@ int TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - size_t numChars, /* The number of characters in 'command' which + int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ int objc, /* Number of arguments for the command. */ @@ -1609,11 +1603,11 @@ * New style trace. */ if (tracePtr->flags & traceFlags) { if (tracePtr->proc == TraceExecutionProc) { - TraceCommandInfo *tcmdPtr = tracePtr->clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData; tcmdPtr->curFlags = traceFlags; tcmdPtr->curCode = code; } traceCode = tracePtr->proc(tracePtr->clientData, interp, @@ -1671,17 +1665,17 @@ */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ - register Trace *tracePtr, /* Describes the trace function to call. */ + Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ - size_t numChars, /* The number of characters in the command's + int numChars, /* The number of characters in the command's * source. */ - register int objc, /* Number of arguments for the command. */ + int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; char *commandCopy; int traceCode; @@ -1688,11 +1682,11 @@ /* * Copy the command characters into a new string. */ - commandCopy = TclStackAlloc(interp, numChars + 1); + commandCopy = (char *)TclStackAlloc(interp, numChars + 1); memcpy(commandCopy, command, numChars); commandCopy[numChars] = '\0'; /* * Call the trace function then free allocated storage. @@ -1724,14 +1718,14 @@ static void CommandObjTraceDeleted( ClientData clientData) { - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; if (tcmdPtr->refCount-- <= 1) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); } } /* *---------------------------------------------------------------------- @@ -1762,17 +1756,17 @@ TraceExecutionProc( ClientData clientData, Tcl_Interp *interp, int level, const char *command, - Tcl_Command cmdInfo, + TCL_UNUSED(Tcl_Command), int objc, struct Tcl_Obj *const objv[]) { int call = 0; Interp *iPtr = (Interp *) interp; - TraceCommandInfo *tcmdPtr = clientData; + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; int flags = tcmdPtr->curFlags; int code = tcmdPtr->curCode; int traceCode = TCL_OK; if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { @@ -1809,11 +1803,11 @@ if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel) && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - Tcl_Free(tcmdPtr->startCmd); + ckfree(tcmdPtr->startCmd); } /* * Second, create the tcl callback, if required. */ @@ -1821,19 +1815,19 @@ if (call) { Tcl_DString cmd, sub; int i, saveInterpFlags; Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); + Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length); /* * Append command with arguments. */ Tcl_DStringInit(&sub); for (i = 0; i < objc; i++) { - Tcl_DStringAppendElement(&sub, TclGetString(objv[i])); + Tcl_DStringAppendElement(&sub, Tcl_GetString(objv[i])); } Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub)); Tcl_DStringFree(&sub); if (flags & TCL_TRACE_ENTER_EXEC) { @@ -1853,11 +1847,11 @@ /* * Append result code. */ resultCode = Tcl_NewIntObj(code); - resultCodeStr = TclGetString(resultCode); + resultCodeStr = Tcl_GetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); /* * Append result string. @@ -1919,14 +1913,14 @@ */ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { - register unsigned len = strlen(command) + 1; + unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; - tcmdPtr->startCmd = Tcl_Alloc(len); + tcmdPtr->startCmd = (char *)ckalloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted); @@ -1934,16 +1928,16 @@ } if (flags & TCL_TRACE_DESTROYED) { if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - Tcl_Free(tcmdPtr->startCmd); + ckfree(tcmdPtr->startCmd); } } if (call) { if (tcmdPtr->refCount-- <= 1) { - Tcl_Free(tcmdPtr); + ckfree(tcmdPtr); } } return traceCode; } @@ -1963,11 +1957,10 @@ * Depends on the command associated with the trace. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static char * TraceVarProc( ClientData clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable or array. */ @@ -1974,11 +1967,11 @@ const char *name2, /* Name of element within array; NULL means * scalar variable is being referenced. */ int flags) /* OR-ed bits giving operation and other * information. */ { - TraceVarInfo *tvarPtr = clientData; + TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *result; int code, destroy = 0; Tcl_DString cmd; int rewind = ((Interp *)interp)->execEnvPtr->rewind; @@ -1990,18 +1983,18 @@ */ result = NULL; if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { - if (tvarPtr->length) { + if (tvarPtr->length != (size_t) 0) { /* * Generate a command to execute by appending list elements for * the two variable names and the operation. */ Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length); + Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { @@ -2064,11 +2057,11 @@ } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { - register Tcl_Obj *errMsgObj = (Tcl_Obj *) result; + Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; } return result; @@ -2141,12 +2134,12 @@ Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { - register Trace *tracePtr; - register Interp *iPtr = (Interp *) interp; + Trace *tracePtr; + Interp *iPtr = (Interp *) interp; /* * Test if this trace allows inline compilation of commands. */ @@ -2166,11 +2159,11 @@ iPtr->flags |= DONT_COMPILE_CMDS_INLINE; } iPtr->tracesForbiddingInline++; } - tracePtr = Tcl_Alloc(sizeof(Trace)); + tracePtr = (Trace *)ckalloc(sizeof(Trace)); tracePtr->level = level; tracePtr->proc = proc; tracePtr->clientData = clientData; tracePtr->delProc = delProc; tracePtr->nextPtr = iPtr->tracePtr; @@ -2229,11 +2222,11 @@ * level<=argument level (1=>top level). */ Tcl_CmdTraceProc *proc, /* Function to call before executing each * command. */ ClientData clientData) /* Arbitrary value word to pass to proc. */ { - StringTraceData *data = Tcl_Alloc(sizeof(StringTraceData)); + StringTraceData *data = (StringTraceData *)ckalloc(sizeof(StringTraceData)); data->clientData = clientData; data->proc = proc; return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc, data, StringTraceDeleteProc); @@ -2263,11 +2256,11 @@ const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const *objv) { - StringTraceData *data = clientData; + StringTraceData *data = (StringTraceData *)clientData; Command *cmdPtr = (Command *) commandInfo; const char **argv; /* Args to pass to string trace proc */ int i; /* @@ -2276,11 +2269,11 @@ */ argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(const char *)); for (i = 0; i < objc; i++) { - argv[i] = TclGetString(objv[i]); + argv[i] = Tcl_GetString(objv[i]); } argv[objc] = 0; /* * Invoke the command function. Note that we cast away const-ness on two @@ -2313,11 +2306,11 @@ static void StringTraceDeleteProc( ClientData clientData) { - Tcl_Free(clientData); + ckfree(clientData); } /* *---------------------------------------------------------------------- * @@ -2341,11 +2334,11 @@ Tcl_Trace trace) /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; - register Trace **tracePtr2 = &iPtr->tracePtr; + Trace **tracePtr2 = &iPtr->tracePtr; ActiveInterpTrace *activePtr; /* * Locate the trace entry in the interpreter's trace list, and remove it * from the list. @@ -2533,11 +2526,11 @@ */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - register Var *arrayPtr, /* Pointer to array variable that contains the + Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, /* Variable's two-part name. */ @@ -2564,14 +2557,17 @@ return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } +#undef TCL_INTERP_DESTROYED +#define TCL_INTERP_DESTROYED 0x100 + int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - register Var *arrayPtr, /* Pointer to array variable that contains the + Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ const char *part1, const char *part2, /* Variable's two-part name. */ @@ -2580,11 +2576,11 @@ * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ int leaveErrMsg) /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ { - register VarTrace *tracePtr; + VarTrace *tracePtr; ActiveVarTrace active; char *result; const char *openParen, *p; Tcl_DString nameCopy; int copiedName; @@ -2661,11 +2657,11 @@ Tcl_Preserve(iPtr); if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) { hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr); active.varPtr = arrayPtr; - for (tracePtr = Tcl_GetHashValue(hPtr); + for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } @@ -2705,11 +2701,11 @@ flags |= TCL_TRACE_DESTROYED; } active.varPtr = varPtr; if (varPtr->flags & traceflags) { hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); - for (tracePtr = Tcl_GetHashValue(hPtr); + for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; } @@ -2779,11 +2775,11 @@ "\n (%s trace on \"%s%s%s%s\")", type, part1, (part2 ? "(" : ""), (part2 ? part2 : ""), (part2 ? ")" : "") )); if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, - TclGetString((Tcl_Obj *) result)); + Tcl_GetString((Tcl_Obj *) result)); } else { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result); } iPtr->flags &= ~(ERR_ALREADY_LOGGED); Tcl_DiscardInterpState(state); @@ -2838,16 +2834,51 @@ * proper disposal method. */ char *result) /* The result returned from a trace function * to be disposed. */ { if (flags & TCL_TRACE_RESULT_DYNAMIC) { - Tcl_Free(result); + ckfree(result); } else if (flags & TCL_TRACE_RESULT_OBJECT) { Tcl_DecrRefCount((Tcl_Obj *) result); } } +/* + *---------------------------------------------------------------------- + * + * Tcl_UntraceVar -- + * + * Remove a previously-created trace for a variable. + * + * Results: + * None. + * + * Side effects: + * If there exists a trace for the variable given by varName with the + * given flags, proc, and clientData, then that trace is removed. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_UntraceVar +void +Tcl_UntraceVar( + Tcl_Interp *interp, /* Interpreter containing variable. */ + const char *varName, /* Name of variable; may end with "(index)" to + * signify an array reference. */ + int flags, /* OR-ed collection of bits describing current + * trace, including any of TCL_TRACE_READS, + * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, + * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */ + Tcl_VarTraceProc *proc, /* Function assocated with trace. */ + ClientData clientData) /* Arbitrary argument to pass to proc. */ +{ + Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData); +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_UntraceVar2 -- * @@ -2875,11 +2906,11 @@ * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - register VarTrace *tracePtr; + VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; int flagMask, allFlags = 0; @@ -2908,11 +2939,11 @@ flagMask |= TCL_TRACE_OLD_STYLE; #endif flags &= flagMask; hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); - for (tracePtr = Tcl_GetHashValue(hPtr), prevPtr = NULL; ; + for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr), prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { goto updateFlags; } if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags) @@ -2977,10 +3008,53 @@ } /* *---------------------------------------------------------------------- * + * Tcl_VarTraceInfo -- + * + * Return the clientData value associated with a trace on a variable. + * This function can also be used to step through all of the traces on a + * particular variable that have the same trace function. + * + * Results: + * The return value is the clientData value associated with a trace on + * the given variable. Information will only be returned for a trace with + * proc as trace function. If the clientData argument is NULL then the + * first such trace is returned; otherwise, the next relevant one after + * the one given by clientData will be returned. If the variable doesn't + * exist, or if there are no (more) traces for it, then NULL is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_VarTraceInfo +ClientData +Tcl_VarTraceInfo( + Tcl_Interp *interp, /* Interpreter containing variable. */ + const char *varName, /* Name of variable; may end with "(index)" to + * signify an array reference. */ + int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, + * TCL_NAMESPACE_ONLY (can be 0). */ + Tcl_VarTraceProc *proc, /* Function assocated with trace. */ + ClientData prevClientData) /* If non-NULL, gives last value returned by + * this function, so this call will return the + * next trace after that one. If NULL, this + * call will return the first trace. */ +{ + return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, + prevClientData); +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * Tcl_VarTraceInfo2 -- * * Same as Tcl_VarTraceInfo, except takes name in two pieces instead of * one. * @@ -3024,11 +3098,11 @@ */ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { - register VarTrace *tracePtr = Tcl_GetHashValue(hPtr); + VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); if (prevClientData != NULL) { for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { @@ -3044,10 +3118,51 @@ } } return NULL; } +/* + *---------------------------------------------------------------------- + * + * Tcl_TraceVar -- + * + * Arrange for reads and/or writes to a variable to cause a function to + * be invoked, which can monitor the operations and/or change their + * actions. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * A trace is set up on the variable given by varName, such that future + * references to the variable will be intermediated by proc. See the + * manual entry for complete details on the calling sequence for proc. + * The variable's flags are updated. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_TraceVar +int +Tcl_TraceVar( + Tcl_Interp *interp, /* Interpreter in which variable is to be + * traced. */ + const char *varName, /* Name of variable; may end with "(index)" to + * signify an array reference. */ + int flags, /* OR-ed collection of bits, including any of + * TCL_TRACE_READS, TCL_TRACE_WRITES, + * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and + * TCL_NAMESPACE_ONLY. */ + Tcl_VarTraceProc *proc, /* Function to call when specified ops are + * invoked upon varName. */ + ClientData clientData) /* Arbitrary argument to pass to proc. */ +{ + return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_TraceVar2 -- * @@ -3081,22 +3196,22 @@ * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { - register VarTrace *tracePtr; + VarTrace *tracePtr; int result; - tracePtr = Tcl_Alloc(sizeof(VarTrace)); + tracePtr = (VarTrace *)ckalloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; result = TraceVarEx(interp, part1, part2, tracePtr); if (result != TCL_OK) { - Tcl_Free(tracePtr); + ckfree(tracePtr); } return result; } /* @@ -3126,13 +3241,13 @@ * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ - register VarTrace *tracePtr)/* Structure containing flags, traceProc and + VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left - * blank. Will be Tcl_Free()d (eventually) if + * blank. Will be ckfree()d (eventually) if * this function returns TCL_OK, and up to * caller to free if this function returns * TCL_ERROR. */ { Interp *iPtr = (Interp *) interp; @@ -3178,11 +3293,11 @@ hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew); if (isNew) { tracePtr->nextPtr = NULL; } else { - tracePtr->nextPtr = Tcl_GetHashValue(hPtr); + tracePtr->nextPtr = (VarTrace *)Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, tracePtr); /* * Mark the variable as traced so we know to call them. Index: generic/tclUniData.c ================================================================== --- generic/tclUniData.c +++ generic/tclUniData.c @@ -39,26 +39,26 @@ 3968, 1344, 4000, 1344, 4032, 4064, 4096, 4128, 4128, 4160, 4192, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4224, 4256, 1344, 1344, 4288, 4320, 4352, 4384, 4416, 1344, 4448, 4480, 4512, 4544, 1344, 4576, 4608, 4640, 4672, 1344, 4704, 4736, 4768, 4800, 4832, 1344, 4864, 4896, 4928, 4960, 1344, - 4992, 5024, 5056, 5088, 1824, 1824, 5120, 5152, 5184, 5216, 5248, 5280, - 1344, 5312, 1344, 5344, 5376, 5408, 5440, 5472, 5504, 5536, 5568, 5600, - 5632, 5664, 5696, 5632, 704, 5728, 224, 224, 224, 224, 5760, 224, 224, - 224, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, - 6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496, - 6528, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6592, 6624, 4928, - 6656, 6688, 6720, 6752, 6784, 4928, 6816, 6848, 6880, 6912, 6944, 6976, - 7008, 4928, 4928, 4928, 4928, 4928, 7040, 7072, 7104, 4928, 4928, 4928, - 7136, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7168, 7200, 4928, 7232, - 7264, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6560, 6560, 6560, - 6560, 7296, 6560, 7328, 7360, 6560, 6560, 6560, 6560, 6560, 6560, 6560, - 6560, 4928, 7392, 7424, 7456, 7488, 4928, 4928, 4928, 7520, 7552, 7584, - 7616, 224, 224, 224, 7648, 7680, 7712, 1344, 7744, 7776, 7808, 7808, - 704, 7840, 7872, 7904, 1824, 7936, 4928, 4928, 7968, 4928, 4928, 4928, - 4928, 4928, 4928, 8000, 8032, 8064, 8096, 3232, 1344, 8128, 4192, 1344, - 8160, 8192, 8224, 1344, 1344, 8256, 8288, 4928, 8320, 8352, 8384, 8416, + 4992, 5024, 5056, 5088, 5120, 1824, 5152, 5184, 5216, 5248, 5280, 5312, + 1344, 5344, 1344, 5376, 5408, 5440, 5472, 5504, 5536, 5568, 5600, 5632, + 5664, 5696, 5728, 5664, 704, 5760, 224, 224, 224, 224, 5792, 224, 224, + 224, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144, + 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496, 6528, + 6560, 6592, 6592, 6592, 6592, 6592, 6592, 6592, 6592, 6624, 6656, 4928, + 6688, 6720, 6752, 6784, 6816, 4928, 6848, 6880, 6912, 6944, 6976, 7008, + 7040, 4928, 4928, 4928, 4928, 4928, 7072, 7104, 7136, 4928, 4928, 4928, + 7168, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7200, 7232, 4928, 7264, + 7296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6592, 6592, 6592, + 6592, 7328, 6592, 7360, 7392, 6592, 6592, 6592, 6592, 6592, 6592, 6592, + 6592, 4928, 7424, 7456, 7488, 7520, 4928, 4928, 4928, 7552, 7584, 7616, + 7648, 224, 224, 224, 7680, 7712, 7744, 1344, 7776, 7808, 7840, 7840, + 704, 7872, 7904, 7936, 1824, 7968, 4928, 4928, 8000, 4928, 4928, 4928, + 4928, 4928, 4928, 8032, 8064, 8096, 8128, 3232, 1344, 8160, 4192, 1344, + 8192, 8224, 8256, 1344, 1344, 8288, 1344, 4928, 8320, 8352, 8384, 8416, 4928, 8384, 8448, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -73,11 +73,11 @@ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 4704, 4928, 4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 4928, 4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -131,16 +131,16 @@ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8480, 8512, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 8544, 4928, 8576, 5408, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 8544, 4928, 8576, 5440, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 8608, 8640, 224, 8672, 8704, 1344, 1344, 8736, 8768, 8800, 224, 8832, 8864, 8896, 8928, 8960, 8992, 9024, 1344, 9056, 9088, 9120, 9152, - 9184, 1632, 9216, 9248, 9280, 1952, 9312, 9344, 9376, 1344, 9408, 9440, - 9472, 1344, 9504, 9536, 9568, 9600, 9632, 9664, 9696, 9728, 9728, 1344, - 9760, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 9184, 1632, 9216, 9248, 8480, 1952, 9280, 9312, 9344, 1344, 9376, 9408, + 9440, 1344, 9472, 9504, 9536, 9568, 9600, 9632, 9664, 9696, 9696, 1344, + 9728, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -165,216 +165,387 @@ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 9792, 9824, 9856, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 1344, 1344, 9760, 9792, 9824, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, + 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, + 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, - 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, 9920, - 9920, 9920, 9920, 9920, 9920, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 9952, 1344, 1344, 9984, 1824, 10016, 10048, - 10080, 1344, 1344, 10112, 10144, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 10176, 10208, 1344, 10240, 1344, 10272, 10304, - 10336, 10368, 10400, 10432, 1344, 1344, 1344, 10464, 10496, 64, 10528, - 10560, 10592, 4736, 10624, 10656 -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 - ,10688, 10720, 10752, 1824, 1344, 1344, 1344, 8288, 10784, 10816, 10848, - 10880, 10912, 10944, 10976, 11008, 1824, 1824, 1824, 1824, 9280, 1344, - 11040, 11072, 1344, 11104, 11136, 11168, 11200, 1344, 11232, 1824, - 11264, 11296, 11328, 1344, 11360, 11392, 11424, 11456, 1344, 11488, - 1344, 11520, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 7776, 4704, 10272, 1824, 1824, 1824, 1824, - 11552, 11584, 11616, 11648, 4736, 11680, 1824, 11712, 11744, 11776, - 1824, 1824, 1344, 11808, 11840, 6880, 11872, 11904, 11936, 11968, 12000, - 1824, 12032, 12064, 1344, 12096, 12128, 12160, 12192, 12224, 1824, - 1824, 1344, 1344, 12256, 1824, 12288, 12320, 12352, 12384, 1344, 12416, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 12448, 1824, - 1824, 1824, 1824, 12000, 12480, 12512, 1824, 1824, 1824, 1824, 7776, - 12544, 12576, 12608, 12640, 5248, 12672, 12704, 12736, 12768, 12800, - 12832, 12864, 5248, 12896, 12928, 12960, 12992, 13024, 1824, 1824, - 13056, 13088, 13120, 13152, 13184, 13216, 13248, 13280, 1824, 1824, - 1824, 1824, 1344, 13312, 13344, 1824, 1344, 13376, 13408, 1824, 1824, - 1824, 1824, 1824, 1344, 13440, 13472, 1824, 1344, 13504, 13536, 13568, - 1344, 13600, 13632, 1824, 4032, 13664, 1824, 1824, 1824, 1824, 1824, - 1824, 1344, 13696, 1824, 1824, 1824, 13728, 13760, 13792, 1824, 1824, - 1824, 1824, 1824, 13824, 13856, 13888, 13920, 13952, 13984, 1344, 14016, - 14048, 1344, 4608, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 14080, 14112, 14144, 14176, 14208, 14240, 1824, 1824, 14272, 14304, - 14336, 14368, 14400, 13632, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 14432, 1824, 1824, 1824, 1824, 1824, 1824, 14464, 14496, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 9984, 1824, 1824, 1824, 10848, 10848, 10848, - 14528, 1344, 1344, 1344, 1344, 1344, 1344, 14560, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14592, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14624, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4608, 4736, 14656, - 1824, 1824, 10208, 14688, 1344, 14720, 14752, 14784, 8480, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 13728, 13760, 14816, 1824, - 1824, 1824, 1344, 1344, 14848, 14880, 14912, 1824, 1824, 14944, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14976, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15008, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 4736, 1824, 15040, 15072, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 9856, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, - 15104, 15136, 15168, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 8000, 4928, 15200, - 4928, 15232, 15264, 15296, 4928, 15328, 4928, 4928, 15360, 1824, 1824, - 1824, 1824, 15392, 4928, 4928, 15424, 15456, 1824, 1824, 1824, 1824, - 15488, 15520, 15552, 15584, 15616, 15648, 15680, 15712, 15744, 15776, - 15808, 15840, 15872, 15488, 15520, 15904, 15584, 15936, 15968, 16000, - 15712, 16032, 16064, 16096, 16128, 16160, 16192, 16224, 16256, 16288, - 16320, 16352, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, - 4928, 4928, 4928, 4928, 4928, 4928, 4928, 704, 16384, 704, 16416, 16448, - 16480, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 16512, 16544, 1824, - 1824, 1824, 1824, 1824, 1824, 1344, 16576, 16608, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 16640, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 16672, 1824, - 16704, 16736, 16768, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 16800, 6880, 16832, 1824, 1824, 16864, 16896, - 1824, 1824, 1824, 1824, 1824, 1824, 16928, 16960, 16992, 17024, 17056, - 17088, 1824, 17120, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 4928, 17152, 4928, 4928, 7968, 17184, 17216, 8000, 17248, 4928, 4928, - 17280, 4928, 17312, 1824, 17344, 17376, 17408, 17440, 17472, 1824, - 1824, 1824, 1824, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 17504, - 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, - 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 8000, 17536, - 4928, 4928, 4928, 7968, 4928, 4928, 17568, 17600, 17152, 4928, 17632, - 4928, 17664, 17696, 1824, 1824, 17728, 4928, 4928, 17760, 4928, 17792, - 17824, 4928, 4928, 4928, 7968, 17856, 17888, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 9888, 9888, 9888, 9888, 9888, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 9920, 1344, 1344, 9952, 1824, 9984, 10016, + 10048, 1344, 1344, 10080, 10112, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 10144, 10176, 1344, 10208, 1344, 10240, 10272, + 10304, 10336, 10368, 10400, 1344, 1344, 1344, 10432, 10464, 64, 10496, + 10528, 10560, 4736, 10592, 10624 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 + ,10656, 10688, 10720, 1824, 1344, 1344, 1344, 10752, 10784, 10816, + 10848, 10880, 10912, 10944, 10976, 11008, 1824, 1824, 1824, 1824, 8480, + 1344, 11040, 11072, 1344, 11104, 11136, 11168, 11200, 1344, 11232, + 1824, 11264, 11296, 11328, 1344, 11360, 11392, 11424, 11456, 1344, + 11488, 1344, 11520, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 7808, 4704, 10240, 1824, 1824, 1824, + 1824, 11552, 11584, 11616, 11648, 4736, 11680, 1824, 11712, 11744, + 11776, 1824, 1824, 1344, 11808, 11840, 6912, 11872, 11904, 11936, 11968, + 12000, 1824, 12032, 12064, 1344, 12096, 12128, 12160, 12192, 12224, + 1824, 1824, 1344, 1344, 12256, 1824, 12288, 12320, 12352, 12384, 1344, + 12416, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 12448, + 1344, 12480, 1824, 1824, 12000, 12512, 12544, 1824, 1824, 10176, 12576, + 7808, 12608, 12640, 12672, 12704, 5280, 12736, 12768, 12800, 12832, + 12864, 12896, 12928, 5280, 12960, 12992, 13024, 13056, 13088, 1824, + 1824, 13120, 13152, 13184, 13216, 13248, 13280, 13312, 13344, 1824, + 1824, 1824, 1824, 1344, 13376, 13408, 13440, 1344, 13472, 13504, 1824, + 1824, 1824, 1824, 1824, 1344, 13536, 13568, 1824, 1344, 13600, 13632, + 13664, 1344, 13696, 13728, 1824, 4032, 13760, 1824, 1824, 1824, 1824, + 1824, 1824, 1344, 13792, 1824, 1824, 1824, 13824, 13856, 13888, 13920, + 13952, 13984, 1824, 1824, 14016, 14048, 14080, 14112, 14144, 14176, + 1344, 14208, 14240, 1344, 4608, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 14272, 14304, 14336, 14368, 14400, 14432, 1824, 1824, 14464, + 14496, 14528, 14560, 14592, 13728, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 14624, 1824, 1824, 1824, 1824, 1824, 14656, 14688, + 14720, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 9952, 1824, 1824, 1824, 10848, + 10848, 10848, 14752, 1344, 1344, 1344, 1344, 1344, 1344, 14784, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14816, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14848, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4608, 4736, + 14880, 1824, 1824, 10176, 14912, 1344, 14944, 14976, 15008, 15040, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 13824, 13856, + 15072, 1824, 1824, 1824, 1344, 1344, 15104, 15136, 15168, 1824, 1824, + 15200, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 15232, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 4704, 1824, 12256, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4736, 1824, 15264, + 15296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 9824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1344, 1344, 1344, 15328, 15360, 15392, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 4928, 4928, 4928, 4928, 4928, + 4928, 4928, 8032, 4928, 15424, 4928, 15456, 15488, 15520, 4928, 15552, + 4928, 4928, 15584, 1824, 1824, 1824, 1824, 15616, 4928, 4928, 15648, + 15680, 1824, 1824, 1824, 1824, 15712, 15744, 15776, 15808, 15840, 15872, + 15904, 15936, 15968, 16000, 16032, 16064, 16096, 15712, 15744, 16128, + 15808, 16160, 16192, 16224, 15936, 16256, 16288, 16320, 16352, 16384, + 16416, 16448, 16480, 16512, 16544, 16576, 4928, 4928, 4928, 4928, 4928, + 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 704, + 16608, 704, 16640, 16672, 16704, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 16736, 16768, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 16800, 16832, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, + 16864, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, + 16896, 1824, 16928, 16960, 16992, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 17024, 6912, 17056, 1824, 1824, + 17088, 17120, 1824, 1824, 1824, 1824, 1824, 1824, 17152, 17184, 17216, + 17248, 17280, 17312, 1824, 17344, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 4928, 17376, 4928, 4928, 8000, 17408, 17440, 8032, 17472, + 4928, 4928, 4928, 4928, 17504, 1824, 17536, 17568, 17600, 17632, 17664, + 1824, 1824, 1824, 1824, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 17696, + 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, + 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 17728, + 17760, 4928, 4928, 4928, 8000, 4928, 4928, 17792, 17824, 17376, 4928, + 17856, 4928, 17888, 17920, 1824, 1824, 4928, 4928, 4928, 17952, 4928, + 4928, 17984, 4928, 4928, 4928, 8000, 18016, 18048, 18080, 18112, 1824, + 4928, 4928, 4928, 4928, 18144, 4928, 6880, 18176, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 11360, 1824, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 18208, 1344, 1344, 1344, + 1344, 1344, 1344, 11360, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 18240, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 18272, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, + 1344, 1344, 1344, 1344, 1344, 1344, 11360, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, + 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, @@ -383,165 +554,11 @@ 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 7776, 1824, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 17920, 1344, 1344, 1344, 1344, 1344, 1344, - 11360, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 17952, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 17984, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, - 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, - 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, - 1344, 1344, 1344, 11360 + 1344, 1344, 1344, 1344, 1344, 1792 #endif /* TCL_UTF_MAX > 3 */ }; /* * The groupMap is indexed by combining the alternate page number with @@ -656,111 +673,111 @@ 15, 93, 93, 93, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 17, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 93, 125, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, - 93, 125, 125, 125, 125, 93, 125, 125, 15, 93, 93, 93, 93, 93, 93, 93, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 3, 3, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 3, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, - 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 0, 0, 0, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, - 0, 0, 125, 125, 0, 0, 125, 125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 125, - 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4, 15, 3, 93, - 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, - 15, 15, 0, 15, 15, 0, 0, 93, 0, 125, 125, 125, 93, 93, 0, 0, 0, 0, - 93, 93, 0, 0, 93, 93, 93, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93, - 93, 15, 15, 15, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, - 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 0, 93, 93, 125, 0, - 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4, 0, 0, 0, - 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 0, 93, 125, 125, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, - 93, 15, 125, 93, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, - 93, 0, 0, 0, 0, 0, 0, 0, 0, 93, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, - 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18, 18, - 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 0, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15, 0, - 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 125, 125, 93, 125, - 125, 0, 0, 0, 125, 125, 125, 0, 125, 125, 125, 93, 0, 0, 15, 0, 0, - 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14, 4, 14, 0, - 0, 0, 0, 0, 93, 125, 125, 125, 93, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 93, 93, 93, 125, - 125, 125, 125, 0, 93, 93, 93, 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, - 0, 93, 93, 0, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 3, 18, 18, 18, 18, 18, - 18, 18, 14, 15, 93, 125, 125, 3, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93, 125, - 125, 125, 125, 125, 0, 93, 125, 125, 0, 125, 125, 93, 93, 0, 0, 0, - 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 93, 93, 0, - 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 93, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 15, 125, 125, 125, - 93, 93, 93, 93, 0, 125, 125, 125, 0, 125, 125, 125, 93, 15, 14, 0, - 0, 0, 0, 15, 15, 15, 125, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 93, - 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 0, 125, 125, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 0, 0, 0, 0, 125, - 125, 125, 93, 93, 93, 0, 93, 0, 125, 125, 125, 125, 125, 125, 125, - 125, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 125, 125, - 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93, 93, 93, - 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93, 93, - 93, 93, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, 15, - 0, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 15, 0, 0, 15, 15, 15, 15, 15, 0, 92, 0, 93, - 93, 93, 93, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, - 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 14, 3, 14, 14, 14, 93, 93, 14, 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 93, 14, 93, - 14, 93, 5, 6, 5, 6, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 125, 93, 93, 93, 93, 93, 3, 93, 93, 15, 15, 15, 15, 15, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, - 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, - 93, 125, 93, 93, 125, 125, 93, 93, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 15, 15, - 15, 15, 93, 93, 93, 15, 125, 125, 125, 15, 15, 125, 125, 125, 125, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 17, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 93, 125, 93, 15, 125, 125, 125, 93, 93, 93, 93, + 93, 93, 93, 93, 125, 125, 125, 125, 93, 125, 125, 15, 93, 93, 93, 93, + 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 3, 3, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, + 93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, 93, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, + 4, 15, 3, 93, 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 0, 15, 15, 0, 15, 15, 0, 0, 93, 0, 125, 125, 125, 93, 93, + 0, 0, 0, 0, 93, 93, 0, 0, 93, 93, 93, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 93, 93, 15, 15, 15, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, + 93, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, + 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 0, 93, + 93, 125, 0, 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, + 4, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 0, 93, 125, 125, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, + 15, 0, 0, 93, 15, 125, 93, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0, + 0, 125, 125, 93, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, 0, 0, 0, 15, + 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, + 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 0, + 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, + 0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 125, 125, 93, 125, 125, 0, 0, 0, 125, 125, 125, 0, 125, 125, 125, 93, + 0, 0, 15, 0, 0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, + 14, 4, 14, 0, 0, 0, 0, 0, 93, 125, 125, 125, 93, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 93, + 93, 93, 125, 125, 125, 125, 0, 93, 93, 93, 0, 93, 93, 93, 93, 0, 0, + 0, 0, 0, 0, 0, 93, 93, 0, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 93, 93, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 3, 18, 18, + 18, 18, 18, 18, 18, 14, 15, 93, 125, 125, 3, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93, + 125, 125, 125, 125, 125, 0, 93, 125, 125, 0, 125, 125, 93, 93, 0, 0, + 0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 93, 93, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 93, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 15, 125, 125, + 125, 93, 93, 93, 93, 0, 125, 125, 125, 0, 125, 125, 125, 93, 15, 14, + 0, 0, 0, 0, 15, 15, 15, 125, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, + 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 93, 125, 125, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 0, 0, 0, + 0, 125, 125, 125, 93, 93, 93, 0, 93, 0, 125, 125, 125, 125, 125, 125, + 125, 125, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 125, + 125, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93, 93, + 93, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93, + 93, 93, 93, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15, + 15, 0, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 15, 0, 0, 15, 15, 15, 15, 15, 0, 92, 0, + 93, 93, 93, 93, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, + 15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 14, 3, 14, 14, 14, 93, 93, 14, 14, 14, 14, 14, 14, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 93, 14, + 93, 14, 93, 5, 6, 5, 6, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 125, 93, 93, 93, 93, 93, 3, 93, 93, 15, 15, 15, 15, 15, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 0, 14, 14, 3, 3, 3, + 3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, + 93, 93, 125, 93, 93, 125, 125, 93, 93, 15, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 15, + 15, 15, 15, 93, 93, 93, 15, 125, 125, 125, 15, 15, 125, 125, 125, 125, 125, 125, 125, 15, 15, 15, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 93, 93, 125, 125, 125, 125, 125, 125, 93, 15, 125, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 125, 125, 125, 93, 14, 14, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, @@ -836,213 +853,213 @@ 15, 15, 15, 15, 15, 125, 93, 125, 93, 93, 93, 93, 93, 93, 93, 0, 93, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 0, 0, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 0, 93, - 93, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 93, 125, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125, 125, 93, - 125, 125, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 93, 93, 93, - 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 93, 125, 93, 93, 125, 125, 125, 93, 125, 93, 93, 93, - 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 125, - 125, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, - 125, 125, 93, 93, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 3, 3, 130, - 131, 132, 133, 133, 134, 135, 136, 137, 0, 0, 0, 0, 0, 0, 0, 138, 138, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 93, 93, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 125, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 93, 93, 93, 93, 125, 93, 125, + 125, 125, 125, 125, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 0, 0, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 93, 93, 125, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93, 93, 125, 125, + 93, 93, 125, 93, 93, 93, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 93, 125, 125, + 125, 93, 125, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, + 3, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 93, 93, + 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 0, 0, 0, 3, 3, 3, 3, 3, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, + 92, 92, 92, 92, 3, 3, 130, 131, 132, 133, 133, 134, 135, 136, 137, + 0, 0, 0, 0, 0, 0, 0, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, - 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 0, - 0, 138, 138, 138, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 93, - 93, 93, 3, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, - 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, - 15, 93, 15, 15, 125, 93, 93, 15, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, + 138, 138, 138, 138, 138, 0, 0, 138, 138, 138, 3, 3, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 3, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, + 15, 93, 15, 15, 15, 15, 15, 15, 93, 15, 15, 125, 93, 93, 15, 0, 0, + 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 139, 21, 21, - 21, 140, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 141, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92, - 92, 92, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, - 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 142, 21, 21, 143, 21, 144, - 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, - 145, 144, 144, 144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145, 145, - 0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, - 145, 145, 145, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, - 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145, 145, - 145, 145, 145, 145, 0, 0, 21, 144, 21, 144, 21, 144, 21, 144, 0, 145, - 0, 145, 0, 145, 0, 145, 144, 144, 144, 144, 144, 144, 144, 144, 145, - 145, 145, 145, 145, 145, 145, 145, 146, 146, 147, 147, 147, 147, 148, - 148, 149, 149, 150, 150, 151, 151, 0, 0, 144, 144, 144, 144, 144, 144, - 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144, 144, 144, - 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144, - 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, - 144, 144, 21, 153, 21, 0, 21, 21, 145, 145, 154, 154, 155, 11, 156, - 11, 11, 11, 21, 153, 21, 0, 21, 21, 157, 157, 157, 157, 155, 11, 11, - 11, 144, 144, 21, 21, 0, 0, 21, 21, 145, 145, 158, 158, 0, 11, 11, - 11, 144, 144, 21, 21, 21, 114, 21, 21, 145, 145, 159, 159, 118, 11, - 11, 11, 0, 0, 21, 153, 21, 0, 21, 21, 160, 160, 161, 161, 155, 11, - 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, 8, 8, 8, - 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, - 162, 163, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 20, - 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, 17, 17, 0, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 92, 0, 0, 18, 18, 18, 18, - 18, 18, 7, 7, 7, 5, 6, 92, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 7, 7, 7, 5, 6, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 120, 120, 120, 120, 93, 120, 120, 120, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, - 14, 108, 14, 14, 14, 14, 108, 14, 14, 21, 108, 108, 108, 21, 21, 108, - 108, 108, 21, 14, 108, 14, 14, 7, 108, 108, 108, 108, 108, 14, 14, - 14, 14, 14, 14, 108, 14, 164, 14, 108, 14, 165, 166, 108, 108, 14, - 21, 108, 108, 167, 108, 21, 15, 15, 15, 15, 21, 14, 14, 21, 21, 108, - 108, 7, 7, 7, 7, 7, 108, 21, 21, 21, 21, 14, 7, 14, 14, 168, 14, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 169, 169, - 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, - 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, - 170, 170, 129, 129, 129, 23, 24, 129, 129, 129, 129, 18, 14, 14, 0, - 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 7, - 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, + 92, 92, 92, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 92, 139, 21, 21, 21, 140, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 141, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 92, 92, 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 0, 93, 93, 93, 93, 93, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, + 142, 21, 21, 143, 21, 144, 144, 144, 144, 144, 144, 144, 144, 145, + 145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0, + 0, 145, 145, 145, 145, 145, 145, 0, 0, 144, 144, 144, 144, 144, 144, + 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144, + 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144, + 144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145, 145, 0, 0, 21, 144, + 21, 144, 21, 144, 21, 144, 0, 145, 0, 145, 0, 145, 0, 145, 144, 144, + 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, + 146, 146, 147, 147, 147, 147, 148, 148, 149, 149, 150, 150, 151, 151, + 0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, + 152, 152, 152, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, + 152, 152, 152, 152, 152, 144, 144, 144, 144, 144, 144, 144, 144, 152, + 152, 152, 152, 152, 152, 152, 152, 144, 144, 21, 153, 21, 0, 21, 21, + 145, 145, 154, 154, 155, 11, 156, 11, 11, 11, 21, 153, 21, 0, 21, 21, + 157, 157, 157, 157, 155, 11, 11, 11, 144, 144, 21, 21, 0, 0, 21, 21, + 145, 145, 158, 158, 0, 11, 11, 11, 144, 144, 21, 21, 21, 114, 21, 21, + 145, 145, 159, 159, 118, 11, 11, 11, 0, 0, 21, 153, 21, 0, 21, 21, + 160, 160, 161, 161, 155, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 17, 17, 17, 17, 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, + 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 162, 163, 17, 17, 17, 17, 17, 2, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, + 6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 2, 17, 17, 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, + 17, 17, 18, 92, 0, 0, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 92, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 120, 120, 120, 93, 120, 120, + 120, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 108, 14, 14, 14, 14, 108, 14, + 14, 21, 108, 108, 108, 21, 21, 108, 108, 108, 21, 14, 108, 14, 14, + 7, 108, 108, 108, 108, 108, 14, 14, 14, 14, 14, 14, 108, 14, 164, 14, + 108, 14, 165, 166, 108, 108, 14, 21, 108, 108, 167, 108, 21, 15, 15, + 15, 15, 21, 14, 14, 21, 21, 108, 108, 7, 7, 7, 7, 7, 108, 21, 21, 21, + 21, 14, 7, 14, 14, 168, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 169, 169, 169, 169, 169, 169, 169, 169, 169, + 169, 169, 169, 169, 169, 169, 169, 170, 170, 170, 170, 170, 170, 170, + 170, 170, 170, 170, 170, 170, 170, 170, 170, 129, 129, 129, 23, 24, + 129, 129, 129, 129, 18, 14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, + 14, 14, 14, 7, 7, 14, 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, + 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, - 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, - 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, + 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, + 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, - 171, 171, 171, 171, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, - 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, - 172, 172, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, - 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, - 14, 14, 14, 14, 14, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, + 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 172, 172, + 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, + 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, + 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, + 7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, + 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, + 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 123, 123, + 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, - 123, 123, 123, 123, 123, 123, 123, 123, 123, 0, 124, 124, 124, 124, + 123, 123, 123, 0, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, - 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, - 124, 0, 23, 24, 173, 174, 175, 176, 177, 23, 24, 23, 24, 23, 24, 178, - 179, 180, 181, 21, 23, 24, 21, 23, 24, 21, 21, 21, 21, 21, 92, 92, - 182, 182, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14, 23, 24, 23, 24, - 93, 93, 93, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18, 3, 3, 183, 183, + 124, 124, 124, 124, 124, 124, 124, 124, 124, 0, 23, 24, 173, 174, 175, + 176, 177, 23, 24, 23, 24, 23, 24, 178, 179, 180, 181, 21, 23, 24, 21, + 23, 24, 21, 21, 21, 21, 21, 92, 92, 182, 182, 23, 24, 23, 24, 21, 14, + 14, 14, 14, 14, 14, 23, 24, 23, 24, 93, 93, 93, 23, 24, 0, 0, 0, 0, + 0, 3, 3, 3, 3, 18, 3, 3, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, - 183, 183, 183, 183, 183, 183, 183, 183, 0, 183, 0, 0, 0, 0, 0, 183, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 92, 3, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, - 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, - 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6, - 5, 6, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3, - 3, 3, 8, 3, 5, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 92, 15, 129, 5, 6, 5, 6, 5, - 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 129, - 129, 129, 129, 129, 129, 129, 129, 129, 93, 93, 93, 93, 125, 125, 8, - 92, 92, 92, 92, 92, 14, 14, 129, 129, 129, 92, 15, 3, 14, 14, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 93, 93, 11, 11, 92, 92, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 3, 92, 92, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 14, 14, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 14, - 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, - 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 92, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, + 183, 0, 183, 0, 0, 0, 0, 0, 183, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, + 3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, + 3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 92, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 14, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, + 2, 3, 3, 3, 14, 92, 15, 129, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, + 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 129, 129, 129, 129, 129, 129, + 129, 129, 129, 93, 93, 93, 93, 125, 125, 8, 92, 92, 92, 92, 92, 14, + 14, 129, 129, 129, 92, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, + 93, 11, 11, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, + 92, 92, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, + 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, + 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 92, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 15, 93, 120, 120, 120, 3, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 92, 93, 93, 15, 15, 15, 15, 15, 15, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 93, 93, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, @@ -1054,514 +1071,529 @@ 21, 21, 21, 21, 21, 21, 21, 23, 24, 23, 24, 184, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 11, 11, 23, 24, 185, 21, 15, 23, 24, 23, 24, 186, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 187, 188, 189, 190, 187, 21, 191, 192, 193, 194, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 23, 24, 195, - 196, 197, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 196, 197, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 92, 92, 21, 15, 15, 15, 15, 15, 15, 15, 93, 15, - 15, 15, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 93, - 93, 125, 14, 14, 14, 14, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14, 14, - 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, - 0, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, - 125, 125, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, - 3, 3, 3, 15, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, - 93, 93, 93, 93, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, - 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125, 125, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 0, 0, 3, 3, 15, 15, 15, 15, 15, 93, 92, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, - 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 93, 15, 15, - 15, 15, 15, 15, 15, 15, 93, 125, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 125, 93, 125, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 93, 15, 93, 93, 93, 15, 15, 93, 93, 15, 15, 15, 15, 15, 93, 93, - 15, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 125, 93, 93, 125, 125, 3, 3, 15, 92, 92, 125, 93, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, - 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21, + 0, 0, 0, 0, 0, 23, 24, 15, 92, 92, 21, 15, 15, 15, 15, 15, 15, 15, + 93, 15, 15, 15, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, + 125, 93, 93, 125, 14, 14, 14, 14, 93, 0, 0, 0, 18, 18, 18, 18, 18, + 18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, + 0, 0, 0, 0, 0, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, + 125, 125, 125, 125, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, + 15, 15, 3, 3, 3, 15, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 93, + 93, 93, 93, 93, 93, 93, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 93, 125, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125, + 125, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 92, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 93, 92, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, + 125, 125, 93, 93, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, + 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 0, 0, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 14, + 14, 14, 15, 125, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 93, 15, 93, 93, 93, 15, 15, 93, 93, 15, + 15, 15, 15, 15, 93, 93, 15, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 3, 3, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 125, 125, 3, 3, 15, 92, + 92, 125, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 198, 21, - 21, 21, 21, 21, 21, 21, 11, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21, - 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 199, 199, 199, 199, 199, 199, 199, + 21, 21, 21, 21, 198, 21, 21, 21, 21, 21, 21, 21, 11, 92, 92, 92, 92, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 11, 11, 0, 0, 0, 0, 199, 199, + 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, - 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 15, - 15, 15, 125, 125, 93, 125, 125, 93, 125, 125, 3, 125, 93, 0, 0, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, - 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, - 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, - 200, 200, 200, 200, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, + 199, 199, 199, 199, 15, 15, 15, 125, 125, 93, 125, 125, 93, 125, 125, + 3, 125, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, + 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 0, 0, 0, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, + 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, + 200, 200, 200, 200, 200, 200, 200, 200, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, - 201, 201, 201, 201, 201, 201, 201, 201, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, 93, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 15, 15, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 6, 5, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 4, 14, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 5, 6, 3, 0, 0, 0, - 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, - 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, 3, 3, 3, 8, 5, 6, - 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, 3, 3, 3, 4, 3, - 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, - 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, 7, 6, 7, 5, 6, 3, - 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15, 15, 15, 15, 15, - 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, - 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0 + 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, + 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, + 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 6, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 0, 0, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 5, + 6, 3, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, + 5, 6, 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3, + 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0, + 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5, + 7, 6, 7, 5, 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15, + 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, + 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, + 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, + 0, 0 #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, - 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, - 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, - 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 18, - 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 18, 18, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 93, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 129, 15, 15, 15, 15, 15, 15, - 15, 15, 129, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 0, - 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 3, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 129, - 129, 129, 129, 129, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 202, 202, 202, 202, - 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, - 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, - 202, 202, 202, 202, 202, 202, 202, 202, 203, 203, 203, 203, 203, 203, - 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, - 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, - 203, 203, 203, 203, 203, 203, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 202, - 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, - 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, - 202, 202, 202, 202, 202, 202, 202, 0, 0, 0, 0, 203, 203, 203, 203, - 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, - 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, - 203, 203, 203, 203, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, - 0, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, - 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, - 18, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, - 0, 0, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, - 0, 0, 0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 93, 93, 93, 0, 93, 93, - 0, 0, 0, 0, 0, 93, 93, 93, 93, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 0, 0, - 0, 0, 93, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 0, 0, 0, 0, 18, - 18, 18, 18, 18, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, - 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, + 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 0, 0, 0, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 129, 129, + 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, + 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, + 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, + 129, 129, 129, 129, 129, 129, 129, 129, 129, 18, 18, 18, 18, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, + 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 129, 15, 15, 15, 15, 15, 15, 15, 15, 129, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 3, 15, 15, 15, 15, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 3, 129, 129, 129, 129, + 129, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 202, 202, 202, 202, 202, 202, 202, + 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, + 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, + 202, 202, 202, 202, 202, 203, 203, 203, 203, 203, 203, 203, 203, 203, + 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, + 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, + 203, 203, 203, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 202, 202, 202, 202, + 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, + 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, + 202, 202, 202, 202, 0, 0, 0, 0, 203, 203, 203, 203, 203, 203, 203, + 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, + 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, + 203, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, + 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 3, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 0, 0, 0, 18, 18, 15, 15, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 15, 93, 93, 93, 0, 93, 93, 0, 0, 0, 0, 0, 93, + 93, 93, 93, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 0, 0, 0, 0, 93, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 18, 18, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 14, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 93, 93, 0, 0, 0, 0, 18, 18, 18, 18, 18, 3, 3, 3, + 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, + 18, 18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, - 98, 98, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 103, 103, 103, 103, - 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, - 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, - 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, - 103, 103, 103, 103, 103, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, - 15, 15, 15, 15, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 0, 18, 18, 18, 18, 18, 18, 18, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 125, 93, - 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, - 93, 93, 93, 93, 125, 125, 93, 93, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 17, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, - 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, - 93, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 125, 125, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 93, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 15, - 15, 15, 15, 3, 3, 3, 3, 93, 93, 93, 93, 3, 0, 0, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 15, 3, 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, - 93, 93, 93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 93, 0, 15, - 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 3, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 93, 125, 125, 125, 93, 93, 93, 93, 93, 93, - 93, 93, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, - 0, 93, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, - 15, 15, 15, 15, 15, 0, 93, 93, 15, 125, 125, 93, 125, 125, 125, 125, - 0, 0, 125, 125, 0, 0, 125, 125, 125, 0, 0, 15, 0, 0, 0, 0, 0, 0, 125, + 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 98, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, + 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, + 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, + 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 0, 0, 0, + 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 93, 93, 93, 93, + 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, + 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 8, 0, 0, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, + 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 93, 125, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, + 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, + 93, 125, 125, 93, 93, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 17, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 93, 0, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 125, 125, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 93, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, + 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 15, 15, 15, + 15, 3, 3, 3, 3, 93, 93, 93, 93, 3, 125, 93, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 15, 3, 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, + 93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 93, 0, 15, 15, 15, + 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 3, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 93, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, + 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, + 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, + 15, 15, 15, 15, 0, 93, 93, 15, 125, 125, 93, 125, 125, 125, 125, 0, + 0, 125, 125, 0, 0, 125, 125, 125, 0, 0, 15, 0, 0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 125, 125, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 93, 125, 93, 15, 15, 15, 15, 3, 3, 3, 3, 3, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 0, 3, 0, 3, 93, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, - 93, 93, 93, 125, 93, 125, 125, 125, 125, 93, 93, 125, 93, 93, 15, 15, - 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 125, 125, 125, 125, 93, 93, - 125, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 15, 15, 15, 15, 93, 93, 0, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, - 93, 93, 93, 93, 93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, - 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 93, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 125, 93, 15, 0, - 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 125, 93, 93, 93, - 93, 125, 93, 93, 93, 93, 93, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 18, 18, 3, 3, 3, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, - 3, 0, 0, 0, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 3, 93, 15, 15, 15, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 125, 125, 125, 93, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125, + 93, 93, 125, 93, 93, 15, 15, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, + 125, 125, 125, 125, 93, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 93, 93, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 125, 93, + 93, 3, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 125, 125, 93, 93, 93, + 93, 93, 93, 125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 0, 0, 0, 0, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 125, 93, 93, 3, 0, 0, 0, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, - 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 93, 93, - 125, 125, 125, 125, 93, 15, 3, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, - 93, 93, 125, 15, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 93, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 93, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 3, 3, 15, 3, - 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 125, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, - 93, 125, 93, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 125, 93, - 93, 93, 93, 93, 93, 93, 125, 93, 93, 125, 93, 93, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 93, 93, 93, 93, 93, 93, 0, 0, 0, 93, 0, 93, 93, 0, 93, 93, 93, 93, - 93, 93, 93, 15, 93, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, - 125, 125, 0, 93, 93, 0, 125, 125, 93, 125, 93, 15, 0, 0, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 93, 93, 125, 125, 3, 3, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 14, 14, 14, 14, 14, 14, 14, 14, 4, 4, 4, 4, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 3, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, - 129, 129, 129, 129, 129, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 0, 0, 93, 93, 93, 93, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, - 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 14, 14, 14, 14, 92, 92, 92, 92, - 3, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 0, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, - 15, 15, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 3, 3, 3, 3, 0, 0, 0, 0, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 93, 15, 125, 125, 125, + 13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 125, 125, + 125, 0, 125, 125, 0, 0, 93, 93, 125, 93, 15, 125, 15, 125, 93, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, + 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 125, 125, 125, 93, 93, 93, 93, 0, 0, 93, 93, 125, 125, 125, 125, 93, + 15, 3, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 15, 93, 93, + 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 93, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, + 93, 93, 93, 93, 93, 125, 125, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 125, 93, 93, 3, 3, 3, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93, + 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 125, 93, 15, 3, 3, 3, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 0, 125, 93, 93, 93, 93, 93, 93, 93, 125, + 93, 93, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, + 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 0, 0, 0, + 93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 15, 93, 0, 0, 0, 0, 0, + 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, + 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 125, 125, 125, 125, 125, 0, 93, 93, 0, 125, 125, 93, + 125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 125, 3, 3, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, + 14, 14, 14, 14, 14, 14, 4, 4, 4, 4, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 3, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, + 129, 129, 129, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, + 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, + 93, 93, 93, 93, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, + 93, 93, 3, 3, 3, 3, 3, 14, 14, 14, 14, 92, 92, 92, 92, 3, 14, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, 18, 18, + 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 3, + 3, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 0, 0, 0, 93, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, - 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 0, 0, 0, 0, 0, 0, - 0, 93, 93, 93, 93, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, - 92, 92, 92, 3, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, - 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 14, 93, 93, 3, 17, 17, 17, 17, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 125, 125, 93, 93, 93, 14, 14, 14, 125, 125, 125, - 125, 125, 125, 17, 17, 17, 17, 17, 17, 17, 17, 93, 93, 93, 93, 93, - 93, 93, 93, 14, 14, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 93, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 14, 14, 93, 93, 93, 14, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 108, 0, 108, 108, 0, 0, 108, 0, 0, 108, 108, 0, 0, 108, - 108, 108, 108, 0, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, - 21, 0, 21, 0, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 0, 108, 108, - 108, 108, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108, 0, 108, 108, - 108, 108, 108, 108, 108, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, - 108, 0, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108, 0, 108, 0, - 0, 0, 108, 108, 108, 108, 108, 108, 108, 0, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, + 125, 125, 125, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 92, 93, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 0, 0, 14, 93, 93, 3, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, + 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 125, 125, 93, 93, 93, 14, 14, 14, 125, 125, 125, 125, 125, 125, + 17, 17, 17, 17, 17, 17, 17, 17, 93, 93, 93, 93, 93, 93, 93, 93, 14, + 14, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 14, 14, 93, 93, 93, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 21, 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, + 0, 108, 108, 0, 0, 108, 0, 0, 108, 108, 0, 0, 108, 108, 108, 108, 0, + 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 0, 21, 0, 21, + 21, 21, 21, 21, 21, 21, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 0, 108, 108, 108, 108, 0, + 0, 108, 108, 108, 108, 108, 108, 108, 108, 0, 108, 108, 108, 108, 108, + 108, 108, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, 0, 108, 108, + 108, 108, 0, 108, 108, 108, 108, 108, 0, 108, 0, 0, 0, 108, 108, 108, + 108, 108, 108, 108, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 108, 108, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, - 21, 21, 21, 0, 0, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, - 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, - 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 21, - 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 21, 21, 21, 21, 21, 21, 0, 0, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, + 21, 21, 21, 21, 21, 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, + 21, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 7, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 21, 21, 7, 21, 21, 21, 21, 21, 21, 108, 21, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, - 14, 14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 93, 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, - 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, - 93, 93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 14, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, + 14, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, + 14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, + 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, + 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93, + 93, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 92, 92, 92, 92, 92, 92, 92, + 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 15, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 92, 92, 92, - 92, 92, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 15, - 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 0, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, + 15, 15, 15, 15, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, + 0, 0, 0, 4, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 204, 204, + 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, - 204, 204, 204, 204, 204, 204, 204, 205, 205, 205, 205, 205, 205, 205, + 204, 204, 204, 204, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, - 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 93, - 93, 93, 93, 93, 93, 93, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 4, 18, - 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, + 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 93, 93, 93, 93, 93, + 93, 93, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, + 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 4, 18, 18, 18, 18, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, - 0, 15, 0, 0, 0, 0, 15, 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, - 0, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, - 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, - 15, 15, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, - 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, - 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, + 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, + 15, 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 0, 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, + 15, 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, + 0, 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, + 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, + 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, + 0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, - 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 0, 0, - 0, 0, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, + 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, + 14, 14, 14, 0, 0, 0, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, + 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 @@ -1612,13 +1644,13 @@ -10818751, 237633, -12223, -10830527, -9058239, 237698, 9949314, 18, 17, 10305, 10370, 8769, 8834 }; #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 -# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= 0x2fa20) +# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x31360) #else -# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0) +# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0) #endif /* * The following constants are used to determine the category of a * Unicode character. @@ -1661,19 +1693,19 @@ * The following macros extract the fields of the character info. The * GetDelta() macro is complicated because we can't rely on the C compiler * to do sign extension on right shifts. */ -#define GetCaseType(info) (((info) & 0xe0) >> 5) -#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1f) +#define GetCaseType(info) (((info) & 0xE0) >> 5) +#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1F) #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 -# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1fffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) +# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) #else -# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) +# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) #endif Index: generic/tclUtf.c ================================================================== --- generic/tclUtf.c +++ generic/tclUtf.c @@ -53,24 +53,57 @@ */ #define UNICODE_SELF 0x80 /* - * The following structures are used when mapping between Unicode (UCS-2) and + * The following structures are used when mapping between Unicode and * UTF-8. */ static const unsigned char totalBytes[256] = { 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, +/* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */ + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, +/* End of "continuation byte section" */ + 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, +#if TCL_UTF_MAX > 3 + 4,4,4,4,4, +#else + 1,1,1,1,1, +#endif + 1,1,1,1,1,1,1,1,1,1,1 +}; + +static const unsigned char complete[256] = { + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, - 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1 +/* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */ + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, +/* End of "continuation byte section" */ + 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, + 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, +#if TCL_UTF_MAX > 3 + 4,4,4,4,4, +#else + 3,3,3,3,3, +#endif + 1,1,1,1,1,1,1,1,1,1,1 }; + +/* + * Functions used only in this module. + */ + +static int Invalid(const char *src); /* *--------------------------------------------------------------------------- * * TclUtfCount -- @@ -84,11 +117,11 @@ * None. * *--------------------------------------------------------------------------- */ -size_t +int TclUtfCount( int ch) /* The Unicode character whose size is returned. */ { if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) { return 1; @@ -99,11 +132,67 @@ if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) { return 4; } return 3; } + +/* + *--------------------------------------------------------------------------- + * + * Invalid -- + * + * Given a pointer to a two-byte prefix of a well-formed UTF-8 byte + * sequence (a lead byte followed by a trail byte) this routine + * examines those two bytes to determine whether the sequence is + * invalid in UTF-8. This might be because it is an overlong + * encoding, or because it encodes something out of the proper range. + * + * Given a pointer to the bytes \xF8 or \xFC , this routine will + * try to read beyond the end of the "bounds" table. Callers must + * prevent this. + * + * Given a pointer to something else (an ASCII byte, a trail byte, + * or another byte that can never begin a valid byte sequence such + * as \xF5) this routine returns false. That makes the routine poorly + * named, as it does not detect and report all invalid sequences. + * + * Callers have to take care that this routine does something useful + * for their needs. + * + * Results: + * A boolean. + *--------------------------------------------------------------------------- + */ +static const unsigned char bounds[28] = { + 0x80, 0x80, /* \xC0 accepts \x80 only */ + 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, + 0x80, 0xBF, /* (\xC4 - \xDC) -- all sequences valid */ + 0xA0, 0xBF, /* \xE0\x80 through \xE0\x9F are invalid prefixes */ + 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, /* (\xE4 - \xEC) -- all valid */ + 0x90, 0xBF, /* \xF0\x80 through \xF0\x8F are invalid prefixes */ + 0x80, 0x8F /* \xF4\x90 and higher are invalid prefixes */ +}; + +static int +Invalid( + const char *src) /* Points to lead byte of a UTF-8 byte sequence */ +{ + unsigned char byte = UCHAR(*src); + int index; + + if ((byte & 0xC3) == 0xC0) { + /* Only lead bytes 0xC0, 0xE0, 0xF0, 0xF4 need examination */ + index = (byte - 0xC0) >> 1; + if (UCHAR(src[1]) < bounds[index] || UCHAR(src[1]) > bounds[index+1]) { + /* Out of bounds - report invalid. */ + return 1; + } + } + return 0; +} + /* *--------------------------------------------------------------------------- * * Tcl_UniCharToUtf -- * @@ -219,73 +308,81 @@ * None. * *--------------------------------------------------------------------------- */ +#undef Tcl_UniCharToUtfDString char * Tcl_UniCharToUtfDString( - const Tcl_UniChar *uniStr, /* Unicode string to convert to UTF-8. */ - size_t uniLength, /* Length of Unicode string in Tcl_UniChars - * (must be >= 0). */ + const int *uniStr, /* Unicode string to convert to UTF-8. */ + int uniLength, /* Length of Unicode string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { - const Tcl_UniChar *w, *wEnd; + const int *w, *wEnd; char *p, *string; - size_t oldLength; - int len = 1; + int oldLength; /* * UTF-8 string length in bytes will be <= Unicode string length * 4. */ + if (uniStr == NULL) { + return NULL; + } + if (uniLength < 0) { + uniLength = 0; + w = uniStr; + while (*w != '\0') { + uniLength++; + w++; + } + } oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { - if (!len && ((*w & 0xFC00) != 0xDC00)) { - /* Special case for handling high surrogates. */ - p += Tcl_UniCharToUtf(-1, p); - } - len = Tcl_UniCharToUtf(*w, p); - p += len; - if ((*w >= 0xD800) && (len < 3)) { - len = 0; /* Indication that high surrogate was found */ - } + p += Tcl_UniCharToUtf(*w, p); w++; } - if (!len) { - /* Special case for handling high surrogates. */ - p += Tcl_UniCharToUtf(-1, p); - } Tcl_DStringSetLength(dsPtr, oldLength + (p - string)); return string; } -#if (TCL_UTF_MAX > 4) && (defined(__CYGWIN__) || defined(_WIN32)) char * -TclWCharToUtfDString( - const WCHAR *uniStr, /* WCHAR string to convert to UTF-8. */ - int uniLength, /* Length of WCHAR string in Tcl_UniChars - * (must be >= 0). */ +Tcl_Char16ToUtfDString( + const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */ + int uniLength, /* Length of Utf-16 string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { - const WCHAR *w, *wEnd; + const unsigned short *w, *wEnd; char *p, *string; int oldLength, len = 1; /* - * UTF-8 string length in bytes will be <= Unicode string length * 4. + * UTF-8 string length in bytes will be <= Utf16 string length * 3. */ + if (uniStr == NULL) { + return NULL; + } + if (uniLength < 0) { + + uniLength = 0; + w = uniStr; + while (*w != '\0') { + uniLength++; + w++; + } + } oldLength = Tcl_DStringLength(dsPtr); - Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4); + Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 3); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { @@ -306,11 +403,10 @@ } Tcl_DStringSetLength(dsPtr, oldLength + (p - string)); return string; } -#endif /* *--------------------------------------------------------------------------- * * Tcl_UtfToUniChar -- * @@ -323,11 +419,11 @@ * looking for trail bytes. If the source buffer is known to be '\0' * terminated, this cannot happen. Otherwise, the caller should call * Tcl_UtfCharComplete() before calling this routine to ensure that * enough bytes remain in the string. * - * Special handling of Surrogate pairs is handled as follows: + * If TCL_UTF_MAX <= 4, special handling of Surrogate pairs is done: * For any UTF-8 string containing a character outside of the BMP, the * first call to this function will fill *chPtr with the high surrogate * and generate a return value of 1. Calling Tcl_UtfToUniChar again * will produce the low surrogate and a return value of 3. Because *chPtr * is used to remember whether the high surrogate is already produced, it @@ -343,23 +439,24 @@ * *--------------------------------------------------------------------------- */ static const unsigned short cp1252[32] = { - 0x20ac, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021, + 0x20AC, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021, 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F, 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; +#undef Tcl_UtfToUniChar int Tcl_UtfToUniChar( - register const char *src, /* The UTF-8 string. */ - register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by + const char *src, /* The UTF-8 string. */ + int *chPtr)/* Filled with the Unicode character represented by * the UTF-8 string. */ { - Tcl_UniChar byte; + int byte; /* * Unroll 1 to 4 byte UTF-8 sequences. */ @@ -371,24 +468,10 @@ * the cp1252 table. See: * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid * characters representing themselves. */ -#if TCL_UTF_MAX <= 4 - /* If *chPtr contains a high surrogate (produced by a previous - * Tcl_UtfToUniChar() call) and the next 3 bytes are UTF-8 continuation - * bytes, then we must produce a follow-up low surrogate. We only - * do that if the high surrogate matches the bits we encounter. - */ - if ((byte >= 0x80) - && (((((byte - 0x10) << 2) & 0xFC) | 0xD800) == (*chPtr & 0xFCFC)) - && ((src[1] & 0xF0) == (((*chPtr << 4) & 0x30) | 0x80)) - && ((src[2] & 0xC0) == 0x80)) { - *chPtr = ((src[1] & 0x0F) << 6) + (src[2] & 0x3F) + 0xDC00; - return 3; - } -#endif if ((unsigned)(byte-0x80) < (unsigned)0x20) { *chPtr = cp1252[byte-0x80]; } else { *chPtr = byte; } @@ -425,32 +508,20 @@ /* * A three-byte-character lead-byte not followed by two trail-bytes * represents itself. */ } - else if (byte < 0xF8) { + else if (byte < 0xF5) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ -#if TCL_UTF_MAX <= 4 - Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2) - | ((src[2] & 0x3F) >> 4)) - 0x40; - if (high >= 0x400) { - /* out of range, < 0x10000 or > 0x10ffff */ - } else { - /* produce high surrogate, advance source pointer */ - *chPtr = 0xD800 + high; - return 1; - } -#else *chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12) | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)); if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) { return 4; } -#endif } /* * A four-byte-character lead-byte not followed by three trail-bytes * represents itself. @@ -459,24 +530,23 @@ *chPtr = byte; return 1; } -#if (TCL_UTF_MAX > 4) && (defined(__CYGWIN__) || defined(_WIN32)) int -TclUtfToWChar( +Tcl_UtfToChar16( const char *src, /* The UTF-8 string. */ - WCHAR *chPtr)/* Filled with the WCHAR represented by - * the UTF-8 string. */ + unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by + * the UTF-8 string. This could be a surrogate too. */ { - WCHAR byte; + unsigned short byte; /* * Unroll 1 to 4 byte UTF-8 sequences. */ - byte = *((unsigned char *) src); + byte = UCHAR(*src); if (byte < 0xC0) { /* * Handles properly formed UTF-8 characters between 0x01 and 0x7F. * Treats naked trail bytes 0x80 to 0x9F as valid characters from * the cp1252 table. See: @@ -487,14 +557,14 @@ /* If *chPtr contains a high surrogate (produced by a previous * Tcl_UtfToUniChar() call) and the next 3 bytes are UTF-8 continuation * bytes, then we must produce a follow-up low surrogate. We only * do that if the high surrogate matches the bits we encounter. */ - if ((byte >= 0x80) + if (((byte & 0xC0) == 0x80) + && ((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && (((((byte - 0x10) << 2) & 0xFC) | 0xD800) == (*chPtr & 0xFCFC)) - && ((src[1] & 0xF0) == (((*chPtr << 4) & 0x30) | 0x80)) - && ((src[2] & 0xC0) == 0x80)) { + && ((src[1] & 0xF0) == (((*chPtr << 4) & 0x30) | 0x80))) { *chPtr = ((src[1] & 0x0F) << 6) + (src[2] & 0x3F) + 0xDC00; return 3; } if ((unsigned)(byte-0x80) < (unsigned)0x20) { *chPtr = cp1252[byte-0x80]; @@ -534,24 +604,24 @@ /* * A three-byte-character lead-byte not followed by two trail-bytes * represents itself. */ } - else if (byte < 0xF8) { - if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { + else if (byte < 0xF5) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) { /* - * Four-byte-character lead byte followed by three trail bytes. + * Four-byte-character lead byte followed by at least two trail bytes. + * We don't test the validity of 3th trail byte, see [ed29806ba] */ - WCHAR high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2) + Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2) | ((src[2] & 0x3F) >> 4)) - 0x40; - if (high >= 0x400) { - /* out of range, < 0x10000 or > 0x10ffff */ - } else { + if (high < 0x400) { /* produce high surrogate, advance source pointer */ *chPtr = 0xD800 + high; return 1; } + /* out of range, < 0x10000 or > 0x10FFFF */ } /* * A four-byte-character lead-byte not followed by three trail-bytes * represents itself. @@ -559,12 +629,11 @@ } *chPtr = byte; return 1; } -#endif - + /* *--------------------------------------------------------------------------- * * Tcl_UtfToUniCharDString -- * @@ -579,24 +648,32 @@ * None. * *--------------------------------------------------------------------------- */ -Tcl_UniChar * +#undef Tcl_UtfToUniCharDString +int * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ - size_t length, /* Length of UTF-8 string in bytes, or -1 for + int length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized * DString. */ { - Tcl_UniChar ch = 0, *w, *wString; - const char *p, *end; - size_t oldLength; + int ch = 0, *w, *wString; + const char *p; + int oldLength; + /* Pointer to the end of string. Never read endPtr[0] */ + const char *endPtr = src + length; + /* Pointer to last byte where optimization still can be used */ + const char *optPtr = endPtr - TCL_UTF_MAX; - if (length == TCL_AUTO_LENGTH) { + if (src == NULL) { + return NULL; + } + if (length < 0) { length = strlen(src); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in @@ -604,50 +681,55 @@ */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, - oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar))); - wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); + oldLength + ((length + 1) * sizeof(int))); + wString = (int *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = src; - end = src + length - 4; - while (p < end) { - p += TclUtfToUniChar(p, &ch); + endPtr = src + length; + optPtr = endPtr - 4; + while (p <= optPtr) { + p += TclUtfToUCS4(p, &ch); + *w++ = ch; + } + while ((p < endPtr) && TclUCS4Complete(p, endPtr-p)) { + p += TclUtfToUCS4(p, &ch); *w++ = ch; } - end += 4; - while (p < end) { - if (Tcl_UtfCharComplete(p, end-p)) { - p += TclUtfToUniChar(p, &ch); - } else { - ch = UCHAR(*p++); - } - *w++ = ch; + while (p < endPtr) { + *w++ = UCHAR(*p++); } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return wString; } -#if (TCL_UTF_MAX > 4) && (defined(__CYGWIN__) || defined(_WIN32)) -WCHAR * -TclUtfToWCharDString( +unsigned short * +Tcl_UtfToChar16DString( const char *src, /* UTF-8 string to convert to Unicode. */ int length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized * DString. */ { - WCHAR ch = 0, *w, *wString; - const char *p, *end; + unsigned short ch = 0, *w, *wString; + const char *p; int oldLength; + /* Pointer to the end of string. Never read endPtr[0] */ + const char *endPtr = src + length; + /* Pointer to last byte where optimization still can be used */ + const char *optPtr = endPtr - TCL_UTF_MAX; + if (src == NULL) { + return NULL; + } if (length < 0) { length = strlen(src); } /* @@ -656,36 +738,36 @@ */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, - oldLength + (int) ((length + 1) * sizeof(WCHAR))); - wString = (WCHAR *) (Tcl_DStringValue(dsPtr) + oldLength); + oldLength + ((length + 1) * sizeof(unsigned short))); + wString = (unsigned short *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = src; - end = src + length - 4; - while (p < end) { - p += TclUtfToWChar(p, &ch); + endPtr = src + length; + optPtr = endPtr - 3; + while (p <= optPtr) { + p += Tcl_UtfToChar16(p, &ch); *w++ = ch; } - end += 4; - while (p < end) { - if (Tcl_UtfCharComplete(p, end-p)) { - p += TclUtfToWChar(p, &ch); + while (p < endPtr) { + if (TclChar16Complete(p, endPtr-p)) { + p += Tcl_UtfToChar16(p, &ch); + *w++ = ch; } else { - ch = UCHAR(*p++); + *w++ = UCHAR(*p++); } - *w++ = ch; } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return wString; } -#endif + /* *--------------------------------------------------------------------------- * * Tcl_UtfCharComplete -- * @@ -705,13 +787,13 @@ int Tcl_UtfCharComplete( const char *src, /* String to check if first few bytes contain * a complete UTF-8 character. */ - size_t length) /* Length of above string in bytes. */ + int length) /* Length of above string in bytes. */ { - return length >= totalBytes[(unsigned char)*src]; + return length >= complete[UCHAR(*src)]; } /* *--------------------------------------------------------------------------- * @@ -728,45 +810,57 @@ * None. * *--------------------------------------------------------------------------- */ -size_t +int Tcl_NumUtfChars( - register const char *src, /* The UTF-8 string to measure. */ - size_t length) /* The length of the string in bytes, or -1 - * for strlen(string). */ + const char *src, /* The UTF-8 string to measure. */ + int length) /* The length of the string in bytes, or -1 + * for strlen(string). */ { Tcl_UniChar ch = 0; - register size_t i = 0; - - /* - * The separate implementations are faster. - * - * Since this is a time-sensitive function, we also do the check for the - * single-byte char case specially. - */ - - if (length == TCL_AUTO_LENGTH) { - while (*src != '\0') { + int i = 0; + + if (length < 0) { + /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ + while ((*src != '\0') && (i < INT_MAX)) { src += TclUtfToUniChar(src, &ch); i++; } } else { - register const char *endPtr = src + length - 4; - - while (src < endPtr) { - src += TclUtfToUniChar(src, &ch); - i++; - } - endPtr += 4; - while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) { + /* Will return value between 0 and length. No overflow checks. */ + + /* Pointer to the end of string. Never read endPtr[0] */ + const char *endPtr = src + length; + /* Pointer to last byte where optimization still can be used */ + const char *optPtr = endPtr - TCL_UTF_MAX; + + /* + * Optimize away the call in this loop. Justified because... + * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr) + * By initialization above (endPtr - optPtr) = TCL_UTF_MAX + * So (endPtr - src) >= TCL_UTF_MAX, and passing that to + * Tcl_UtfCharComplete we know will cause return of 1. + */ + while (src <= optPtr + /* && Tcl_UtfCharComplete(src, endPtr - src) */ ) { src += TclUtfToUniChar(src, &ch); i++; } - if (src < endPtr) { - i += endPtr - src; + /* Loop over the remaining string where call must happen */ + while (src < endPtr) { + if (Tcl_UtfCharComplete(src, endPtr - src)) { + src += TclUtfToUniChar(src, &ch); + } else { + /* + * src points to incomplete UTF-8 sequence + * Treat first byte as character and count it + */ + src++; + } + i++; } } return i; } @@ -773,11 +867,11 @@ /* *--------------------------------------------------------------------------- * * Tcl_UtfFindFirst -- * - * Returns a pointer to the first occurance of the given Unicode character + * Returns a pointer to the first occurrence of the given Unicode character * in the NULL-terminated UTF-8 string. The NULL terminator is considered * part of the UTF-8 string. Equivalent to Plan 9 utfrune(). * * Results: * As above. If the Unicode character does not exist in the given string, @@ -792,24 +886,14 @@ const char * Tcl_UtfFindFirst( const char *src, /* The UTF-8 string to be searched. */ int ch) /* The Unicode character to search for. */ { - size_t len; - int fullchar; - Tcl_UniChar find = 0; - while (1) { - len = TclUtfToUniChar(src, &find); - fullchar = find; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &find); - fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; - } -#endif - if (fullchar == ch) { + int find, len = TclUtfToUCS4(src, &find); + + if (find == ch) { return src; } if (*src == '\0') { return NULL; } @@ -820,11 +904,11 @@ /* *--------------------------------------------------------------------------- * * Tcl_UtfFindLast -- * - * Returns a pointer to the last occurance of the given Unicode character + * Returns a pointer to the last occurrence of the given Unicode character * in the NULL-terminated UTF-8 string. The NULL terminator is considered * part of the UTF-8 string. Equivalent to Plan 9 utfrrune(). * * Results: * As above. If the Unicode character does not exist in the given string, the @@ -839,26 +923,16 @@ const char * Tcl_UtfFindLast( const char *src, /* The UTF-8 string to be searched. */ int ch) /* The Unicode character to search for. */ { - size_t len; - int fullchar; - Tcl_UniChar find = 0; - const char *last; + const char *last = NULL; - last = NULL; while (1) { - len = TclUtfToUniChar(src, &find); - fullchar = find; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &find); - fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000; - } -#endif - if (fullchar == ch) { + int find, len = TclUtfToUCS4(src, &find); + + if (find == ch) { last = src; } if (*src == '\0') { break; } @@ -870,13 +944,15 @@ /* *--------------------------------------------------------------------------- * * Tcl_UtfNext -- * - * Given a pointer to some current location in a UTF-8 string, move - * forward one character. The caller must ensure that they are not asking - * for the next character after the last character in the string. + * Given a pointer to some location in a UTF-8 string, Tcl_UtfNext + * returns a pointer to the next UTF-8 character in the string. + * The caller must not ask for the next character after the last + * character in the string if the string is not terminated by a null + * character. * * Results: * The return value is the pointer to the next character in the UTF-8 * string. * @@ -888,19 +964,44 @@ const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { - Tcl_UniChar ch = 0; - size_t len = TclUtfToUniChar(src, &ch); - -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &ch); - } -#endif - return src + len; + int left; + const char *next; + + if (((*src) & 0xC0) == 0x80) { + if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) { + ++src; + } + return src; + } + + left = totalBytes[UCHAR(*src)]; + next = src + 1; + while (--left) { + if ((*next & 0xC0) != 0x80) { + /* + * src points to non-trail byte; We ran out of trail bytes + * before the needs of the lead byte were satisfied. + * Let the (malformed) lead byte alone be a character + */ + return src + 1; + } + next++; + } + /* + * Call Invalid() here only if required conditions are met: + * src[0] is known a lead byte. + * src[1] is known a trail byte. + * Especially important to prevent calls when src[0] == '\xF8' or '\xFC' + * See tests utf-6.37 through utf-6.43 through valgrind or similar tool. + */ + if ((next == src + 1) || Invalid(src)) { + return src + 1; + } + return next; } /* *--------------------------------------------------------------------------- * @@ -922,43 +1023,111 @@ *--------------------------------------------------------------------------- */ const char * Tcl_UtfPrev( - const char *src, /* The current location in the string. */ - const char *start) /* Pointer to the beginning of the string, to - * avoid going backwards too far. */ -{ - const char *look; - int i, byte; - - look = --src; - for (i = 0; i < 4; i++) { - if (look < start) { - if (src < start) { - src = start; - } - break; - } - byte = *((unsigned char *) look); + const char *src, /* A location in a UTF-8 string. */ + const char *start) /* Pointer to the beginning of the string */ +{ + int trailBytesSeen = 0; /* How many trail bytes have been verified? */ + const char *fallback = src - 1; + /* If we cannot find a lead byte that might + * start a prefix of a valid UTF byte sequence, + * we will fallback to a one-byte back step */ + const char *look = fallback; + /* Start search at the fallback position */ + + /* Quick boundary case exit. */ + if (fallback <= start) { + return start; + } + + do { + unsigned char byte = UCHAR(look[0]); + if (byte < 0x80) { - break; + /* + * Single byte character. Either this is a correct previous + * character, or it is followed by at least one trail byte + * which indicates a malformed sequence. In either case the + * correct result is to return the fallback. + */ + return fallback; } if (byte >= 0xC0) { - return look; + /* Non-trail byte; May be multibyte lead. */ + + if ((trailBytesSeen == 0) + /* + * We've seen no trailing context to use to check + * anything. From what we know, this non-trail byte + * is a prefix of a previous character, and accepting + * it (the fallback) is correct. + */ + + || (trailBytesSeen >= complete[byte])) { + /* + * That is, (1 + trailBytesSeen > needed). + * We've examined more bytes than needed to complete + * this lead byte. No matter about well-formedness or + * validity, the sequence starting with this lead byte + * will never include the fallback location, so we must + * return the fallback location. See test utf-7.17 + */ + return fallback; + } + + /* + * trailBytesSeen > 0, so we can examine look[1] safely. + * Use that capability to screen out invalid sequences. + */ + + if (Invalid(look)) { + /* Reject */ + return fallback; + } + return (const char *)look; + } + + /* We saw a trail byte. */ + trailBytesSeen++; + + if ((const char *)look == start) { + /* + * Do not read before the start of the string + * + * If we get here, we've examined bytes at every location + * >= start and < src and all of them are trail bytes, + * including (*start). We need to return our fallback + * and exit this loop before we run past the start of the string. + */ + return fallback; } + + /* Continue the search backwards... */ look--; - } - return src; + } while (trailBytesSeen < TCL_UTF_MAX); + + /* + * We've seen TCL_UTF_MAX trail bytes, so we know there will not be a + * properly formed byte sequence to find, and we can stop looking, + * accepting the fallback (for TCL_UTF_MAX > 3) or just go back as + * far as we can. + */ +#if TCL_UTF_MAX > 3 + return fallback; +#else + return src - TCL_UTF_MAX; +#endif } /* *--------------------------------------------------------------------------- * * Tcl_UniCharAtIndex -- * - * Returns the Tcl_UniChar represented at the specified character + * Returns the Unicode character represented at the specified character * (not byte) position in the UTF-8 string. * * Results: * As above. * @@ -968,45 +1137,40 @@ *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( - register const char *src, /* The UTF-8 string to dereference. */ - register size_t index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string to dereference. */ + int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; - int fullchar = 0; -#if TCL_UTF_MAX <= 4 - size_t len = 0; -#endif - - src += TclUtfToUniChar(src, &ch); - while (index--) { -#if TCL_UTF_MAX <= 4 - src += (len = TclUtfToUniChar(src, &ch)); -#else - src += TclUtfToUniChar(src, &ch); -#endif - } - fullchar = ch; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - /* If last Tcl_UniChar was a high surrogate, combine with low surrogate */ - (void)TclUtfToUniChar(src, &ch); - fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif - return fullchar; + int i = 0; + + if (index < 0) { + return -1; + } + while (index-- > 0) { + i = TclUtfToUniChar(src, &ch); + src += i; + } +#if TCL_UTF_MAX <= 3 + if ((ch >= 0xD800) && (i < 3)) { + /* Index points at character following high Surrogate */ + return -1; + } +#endif + TclUtfToUCS4(src, &i); + return i; } /* *--------------------------------------------------------------------------- * * Tcl_UtfAtIndex -- * * Returns a pointer to the specified character (not byte) position in - * the UTF-8 string. If TCL_UTF_MAX <= 4, characters > U+FFFF count as + * the UTF-8 string. If TCL_UTF_MAX <= 3, characters > U+FFFF count as * 2 positions, but then the pointer should never be placed between * the two positions. * * Results: * As above. @@ -1017,33 +1181,26 @@ *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( - register const char *src, /* The UTF-8 string. */ - register size_t index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; -#if TCL_UTF_MAX <= 4 - size_t len = 0; -#endif - - if (index != TCL_INDEX_NONE) { - while (index--) { -#if TCL_UTF_MAX <= 4 - src += (len = TclUtfToUniChar(src, &ch)); -#else - src += TclUtfToUniChar(src, &ch); -#endif - } -#if TCL_UTF_MAX <= 4 + int len = 0; + + while (index-- > 0) { + len = TclUtfToUniChar(src, &ch); + src += len; + } +#if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* Index points at character following high Surrogate */ src += TclUtfToUniChar(src, &ch); } #endif - } return src; } /* *--------------------------------------------------------------------------- @@ -1052,11 +1209,11 @@ * * Figure out how to handle a backslash sequence. * * Results: * Stores the bytes represented by the backslash sequence in dst and - * returns the number of bytes written to dst. At most TCL_UTF_MAX bytes + * returns the number of bytes written to dst. At most 4 bytes * are written to dst; dst must have been large enough to accept those * bytes. If readPtr isn't NULL then it is filled in with a count of the * number of bytes in the backslash sequence. * * Side effects: @@ -1069,21 +1226,22 @@ * buffer overruns should occur. * *--------------------------------------------------------------------------- */ -size_t +int Tcl_UtfBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ int *readPtr, /* Fill in with number of characters read from * src, unless NULL. */ char *dst) /* Filled with the bytes represented by the * backslash sequence. */ { #define LINE_LENGTH 128 - size_t numRead, result; + int numRead; + int result; result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); if (numRead == LINE_LENGTH) { /* * We ate a whole line. Pay the price of a strlen() @@ -1117,39 +1275,30 @@ int Tcl_UtfToUpper( char *str) /* String to convert in place. */ { - Tcl_UniChar ch = 0; - int upChar; + int ch, upChar; char *src, *dst; - size_t len; + int len; /* * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { - len = TclUtfToUniChar(src, &ch); - upChar = ch; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &ch); - /* Combine surrogates */ - upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif - upChar = Tcl_UniCharToUpper(upChar); + len = TclUtfToUCS4(src, &ch); + upChar = Tcl_UniCharToUpper(ch); /* * To keep badly formed Utf strings from getting inflated by the * conversion (thereby causing a segfault), only copy the upper case * char to dst if its size is <= the original char. */ - if ((len < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) { + if ((len < TclUtfCount(upChar)) || ((upChar & ~0x7FF) == 0xD800)) { memmove(dst, src, len); dst += len; } else { dst += Tcl_UniCharToUtf(upChar, dst); } @@ -1179,39 +1328,30 @@ int Tcl_UtfToLower( char *str) /* String to convert in place. */ { - Tcl_UniChar ch = 0; - int lowChar; + int ch, lowChar; char *src, *dst; - size_t len; + int len; /* * Iterate over the string until we hit the terminating null. */ src = dst = str; while (*src) { - len = TclUtfToUniChar(src, &ch); - lowChar = ch; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &ch); - /* Combine surrogates */ - lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif - lowChar = Tcl_UniCharToLower(lowChar); + len = TclUtfToUCS4(src, &ch); + lowChar = Tcl_UniCharToLower(ch); /* * To keep badly formed Utf strings from getting inflated by the * conversion (thereby causing a segfault), only copy the lower case * char to dst if its size is <= the original char. */ - if ((len < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) { + if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) { memmove(dst, src, len); dst += len; } else { dst += Tcl_UniCharToUtf(lowChar, dst); } @@ -1242,58 +1382,42 @@ int Tcl_UtfToTitle( char *str) /* String to convert in place. */ { - Tcl_UniChar ch = 0; - int titleChar, lowChar; + int ch, titleChar, lowChar; char *src, *dst; - size_t len; + int len; /* * Capitalize the first character and then lowercase the rest of the * characters until we get to a null. */ src = dst = str; if (*src) { - len = TclUtfToUniChar(src, &ch); - titleChar = ch; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &ch); - /* Combine surrogates */ - titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif - titleChar = Tcl_UniCharToTitle(titleChar); - - if ((len < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) { + len = TclUtfToUCS4(src, &ch); + titleChar = Tcl_UniCharToTitle(ch); + + if ((len < TclUtfCount(titleChar)) || ((titleChar & ~0x7FF) == 0xD800)) { memmove(dst, src, len); dst += len; } else { dst += Tcl_UniCharToUtf(titleChar, dst); } src += len; } while (*src) { - len = TclUtfToUniChar(src, &ch); + len = TclUtfToUCS4(src, &ch); lowChar = ch; -#if TCL_UTF_MAX <= 4 - if ((ch >= 0xD800) && (len < 3)) { - len += TclUtfToUniChar(src + len, &ch); - /* Combine surrogates */ - lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; - } -#endif /* Special exception for Georgian Asomtavruli chars, no titlecase. */ if ((unsigned)(lowChar - 0x1C90) >= 0x30) { lowChar = Tcl_UniCharToLower(lowChar); } - if ((len < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) { + if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) { memmove(dst, src, len); dst += len; } else { dst += Tcl_UniCharToUtf(lowChar, dst); } @@ -1322,19 +1446,19 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numBytes) /* Number of *bytes* to compare. */ + unsigned long numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes * fine in the strcmp manner. */ - register int result = 0; + int result = 0; for ( ; numBytes != 0; numBytes--, cs++, ct++) { if (*cs != *ct) { result = UCHAR(*cs) - UCHAR(*ct); break; @@ -1369,11 +1493,11 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; /* * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the @@ -1389,11 +1513,11 @@ */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } @@ -1427,11 +1551,11 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { /* @@ -1440,11 +1564,11 @@ * at least n chars long (no need for \0 check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } @@ -1489,11 +1613,11 @@ while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } @@ -1535,11 +1659,11 @@ while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { -#if TCL_UTF_MAX <= 4 +#if TCL_UTF_MAX <= 3 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } @@ -1583,10 +1707,11 @@ if (GetCaseType(info) & 0x04) { ch -= GetDelta(info); } } + /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } /* *---------------------------------------------------------------------- @@ -1614,10 +1739,11 @@ if ((mode & 0x02) && (mode != 0x7)) { ch += GetDelta(info); } } + /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } /* *---------------------------------------------------------------------- @@ -1653,10 +1779,11 @@ } } else if (mode == 0x4) { ch -= GetDelta(info); } } + /* Clear away extension bits, if any */ return ch & 0x1FFFFF; } /* *---------------------------------------------------------------------- @@ -1673,15 +1800,15 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int Tcl_UniCharLen( const Tcl_UniChar *uniStr) /* Unicode string to find length of. */ { - size_t len = 0; + int len = 0; while (*uniStr != '\0') { len++; uniStr++; } @@ -1707,11 +1834,11 @@ int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + unsigned long numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* * We are definitely on a big-endian machine; memcmp() is safe */ @@ -1752,11 +1879,11 @@ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + unsigned long numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); Tcl_UniChar lct = Tcl_UniCharToLower(*uct); @@ -1840,12 +1967,13 @@ int Tcl_UniCharIsControl( int ch) /* Unicode character to test. */ { if (UNICODE_OUT_OF_RANGE(ch)) { + /* Clear away extension bits, if any */ ch &= 0x1FFFFF; - if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007f))) { + if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007F))) { return 1; } if ((ch >= 0xF0000) && ((ch & 0xFFFF) <= 0xFFFD)) { return 1; } @@ -1899,12 +2027,11 @@ int Tcl_UniCharIsGraph( int ch) /* Unicode character to test. */ { if (UNICODE_OUT_OF_RANGE(ch)) { - ch &= 0x1FFFFF; - return (ch >= 0xE0100) && (ch <= 0xE01EF); + return ((unsigned)((ch & 0x1FFFFF) - 0xE0100) <= 0xEF); } return ((GRAPH_BITS >> GetCategory(ch)) & 1); } /* @@ -1952,12 +2079,11 @@ int Tcl_UniCharIsPrint( int ch) /* Unicode character to test. */ { if (UNICODE_OUT_OF_RANGE(ch)) { - ch &= 0x1FFFFF; - return (ch >= 0xE0100) && (ch <= 0xE01EF); + return ((unsigned)((ch & 0x1FFFFF) - 0xE0100) <= 0xEF); } return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1); } /* @@ -2013,11 +2139,11 @@ * If the character is within the first 127 characters, just use the * standard C function, otherwise consult the Unicode table. */ if (ch < 0x80) { - return TclIsSpaceProc((char) ch); + return TclIsSpaceProcM((char) ch); } else if (UNICODE_OUT_OF_RANGE(ch)) { return 0; } else if (ch == 0x0085 || ch == 0x180E || ch == 0x200B || ch == 0x202F || ch == 0x2060 || ch == 0xFEFF) { return 1; @@ -2158,11 +2284,11 @@ */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*uniStr && (p != *uniStr) - && (p != (Tcl_UniChar)Tcl_UniCharToLower(*uniStr))) { + && (p != Tcl_UniCharToLower(*uniStr))) { uniStr++; } } else { while (*uniStr && (p != *uniStr)) { uniStr++; @@ -2198,25 +2324,25 @@ if (p == '[') { Tcl_UniChar startChar, endChar; uniPattern++; - ch1 = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniStr) : *uniStr); + ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); uniStr++; while (1) { if ((*uniPattern == ']') || (*uniPattern == 0)) { return 0; } - startChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniPattern) + startChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); uniPattern++; if (*uniPattern == '-') { uniPattern++; if (*uniPattern == 0) { return 0; } - endChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniPattern) + endChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); uniPattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* @@ -2290,14 +2416,14 @@ */ int TclUniCharMatch( const Tcl_UniChar *string, /* Unicode String. */ - size_t strLen, /* Length of String */ + int strLen, /* Length of String */ const Tcl_UniChar *pattern, /* Pattern, which may contain special * characters. */ - size_t ptnLen, /* Length of Pattern */ + int ptnLen, /* Length of Pattern */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { const Tcl_UniChar *stringEnd, *patternEnd; Tcl_UniChar p; @@ -2350,11 +2476,11 @@ */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while ((string < stringEnd) && (p != *string) - && (p != (Tcl_UniChar)Tcl_UniCharToLower(*string))) { + && (p != Tcl_UniCharToLower(*string))) { string++; } } else { while ((string < stringEnd) && (p != *string)) { string++; @@ -2391,24 +2517,24 @@ if (p == '[') { Tcl_UniChar ch1, startChar, endChar; pattern++; - ch1 = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*string) : *string); + ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string); string++; while (1) { if ((*pattern == ']') || (pattern == patternEnd)) { return 0; } - startChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*pattern) : *pattern); + startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); pattern++; if (*pattern == '-') { pattern++; if (pattern == patternEnd) { return 0; } - endChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*pattern) + endChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); pattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* @@ -2457,12 +2583,64 @@ string++; pattern++; } } +/* + *--------------------------------------------------------------------------- + * + * TclUtfToUCS4 -- + * + * Extract the 4-byte codepoint from the leading bytes of the + * Modified UTF-8 string "src". This is a utility routine to + * contain the surrogate gymnastics in one place. + * + * The caller must ensure that the source buffer is long enough that this + * routine does not run off the end and dereference non-existent memory + * looking for trail bytes. If the source buffer is known to be '\0' + * terminated, this cannot happen. Otherwise, the caller should call + * Tcl_UtfCharComplete() before calling this routine to ensure that + * enough bytes remain in the string. + * + * Results: + * *usc4Ptr is filled with the UCS4 code point, and the return value is + * the number of bytes from the UTF-8 string that were consumed. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +#if TCL_UTF_MAX <= 3 +int +TclUtfToUCS4( + const char *src, /* The UTF-8 string. */ + int *ucs4Ptr) /* Filled with the UCS4 codepoint represented + * by the UTF-8 string. */ +{ + /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */ + return Tcl_UtfToUniChar(src, ucs4Ptr); +} + +int +TclUniCharToUCS4( + const Tcl_UniChar *src, /* The Tcl_UniChar string. */ + int *ucs4Ptr) /* Filled with the UCS4 codepoint represented + * by the Tcl_UniChar string. */ +{ + if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) { + *ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[01] & 0x3FF)) + 0x10000; + return 2; + } + *ucs4Ptr = src[0]; + return 1; +} +#endif + /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -13,11 +13,11 @@ */ #include "tclInt.h" #include "tclParse.h" #include "tclStringTrim.h" -#include "tommath.h" +#include "tclTomMath.h" #include /* * The absolute pathname of the executable in which this Tcl library is * running. @@ -92,26 +92,33 @@ #define CONVERT_BRACE 2 #define CONVERT_ESCAPE 4 #define CONVERT_MASK (CONVERT_BRACE | CONVERT_ESCAPE) #define CONVERT_ANY 16 +/* + * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to + * access the precision to be used for double formatting. + */ + +static Tcl_ThreadDataKey precisionKey; + /* * Prototypes for functions defined later in this file. */ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(ClientData clientData); static void FreeThreadHash(ClientData clientData); -static int GetEndOffsetFromObj(Tcl_Obj *objPtr, +static int GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, Tcl_WideInt *indexPtr); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, Tcl_WideInt *widePtr); static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, - const char **nextPtr, size_t *sizePtr, + const char **nextPtr, int *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a * performance optimization in Tcl_GetIntForIndex. The internal rep is @@ -385,61 +392,61 @@ */ int TclMaxListLength( const char *bytes, - size_t numBytes, + int numBytes, const char **endPtr) { - size_t count = 0; + int count = 0; - if ((numBytes == 0) || ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0'))) { + if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { /* Empty string case - quick exit */ goto done; } /* * No list element before leading white space. */ - count += 1 - TclIsSpaceProc(*bytes); + count += 1 - TclIsSpaceProcM(*bytes); /* * Count white space runs as potential element separators. */ while (numBytes) { - if ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0')) { + if ((numBytes == -1) && (*bytes == '\0')) { break; } - if (TclIsSpaceProc(*bytes)) { + if (TclIsSpaceProcM(*bytes)) { /* * Space run started; bump count. */ count++; do { bytes++; - numBytes -= (numBytes != TCL_AUTO_LENGTH); - } while (numBytes && TclIsSpaceProc(*bytes)); - if ((numBytes == 0) || ((numBytes == TCL_AUTO_LENGTH) && (*bytes == '\0'))) { + numBytes -= (numBytes != -1); + } while (numBytes && TclIsSpaceProcM(*bytes)); + if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { break; } /* * (*bytes) is non-space; return to counting state. */ } bytes++; - numBytes -= (numBytes != TCL_AUTO_LENGTH); + numBytes -= (numBytes != -1); } /* * No list element following trailing white space. */ - count -= TclIsSpaceProc(bytes[-1]); + count -= TclIsSpaceProcM(bytes[-1]); done: if (endPtr) { *endPtr = bytes; } @@ -497,11 +504,11 @@ const char **elementPtr, /* Where to put address of first significant * character in first element of list. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ - size_t *sizePtr, /* If non-zero, fill in with size of + int *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal list element and therefore @@ -526,11 +533,11 @@ * character in the first element (i.e., key * or value) of dict. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * element (next arg or end of list). */ - size_t *sizePtr, /* If non-zero, fill in with size of + int *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal key or value and therefore @@ -558,11 +565,11 @@ const char **elementPtr, /* Where to put address of first significant * character in first element. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list/dict). */ - size_t *sizePtr, /* If non-zero, fill in with size of + int *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr * bytes starting at **elementPtr is/is not * the literal list/dict element and therefore @@ -572,12 +579,12 @@ const char *p = string; const char *elemStart; /* Points to first byte of first element. */ const char *limit; /* Points just after list/dict's last byte. */ int openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; - int size = 0; /* lint. */ - size_t numChars; + int size = 0; + int numChars; int literal = 1; const char *p2; /* * Skim off leading white space and check for an opening brace or quote. @@ -584,11 +591,11 @@ * We treat embedded NULLs in the list/dict as bytes belonging to a list * element (or dictionary key or value). */ limit = (string + stringLength); - while ((p < limit) && (TclIsSpaceProc(*p))) { + while ((p < limit) && (TclIsSpaceProcM(*p))) { p++; } if (p == limit) { /* no element found */ elemStart = limit; goto done; @@ -629,21 +636,21 @@ if (openBraces > 1) { openBraces--; } else if (openBraces == 1) { size = (p - elemStart); p++; - if ((p >= limit) || TclIsSpaceProc(*p)) { + if ((p >= limit) || TclIsSpaceProcM(*p)) { goto done; } /* * Garbage after the closing brace; return an error. */ if (interp != NULL) { p2 = p; - while ((p2 < limit) && (!TclIsSpaceProc(*p2)) + while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s element in braces followed by \"%.*s\" " @@ -673,46 +680,29 @@ } TclParseBackslash(p, limit - p, &numChars, NULL); p += (numChars - 1); break; - /* - * Space: ignore if element is in braces or quotes; otherwise - * terminate element. - */ - - case ' ': - case '\f': - case '\n': - case '\r': - case '\t': - case '\v': - if ((openBraces == 0) && !inQuotes) { - size = (p - elemStart); - goto done; - } - break; - /* * Double-quote: if element is in quotes then terminate it. */ case '"': if (inQuotes) { size = (p - elemStart); p++; - if ((p >= limit) || TclIsSpaceProc(*p)) { + if ((p >= limit) || TclIsSpaceProcM(*p)) { goto done; } /* * Garbage after the closing quote; return an error. */ if (interp != NULL) { p2 = p; - while ((p2 < limit) && (!TclIsSpaceProc(*p2)) + while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s element in quotes followed by \"%.*s\" " @@ -721,10 +711,24 @@ NULL); } return TCL_ERROR; } break; + + default: + if (TclIsSpaceProcM(*p)) { + /* + * Space: ignore if element is in braces or quotes; + * otherwise terminate element. + */ + if ((openBraces == 0) && !inQuotes) { + size = (p - elemStart); + goto done; + } + } + break; + } p++; } /* @@ -751,11 +755,11 @@ } size = (p - elemStart); } done: - while ((p < limit) && (TclIsSpaceProc(*p))) { + while ((p < limit) && (TclIsSpaceProcM(*p))) { p++; } *elementPtr = elemStart; *nextPtr = p; if (sizePtr != 0) { @@ -784,24 +788,24 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int TclCopyAndCollapse( - size_t count, /* Number of byte to copy from src. */ + int count, /* Number of byte to copy from src. */ const char *src, /* Copy from here... */ char *dst) /* ... to here. */ { - size_t newCount = 0; + int newCount = 0; while (count > 0) { char c = *src; if (c == '\\') { - size_t numRead; - size_t backslashCount = TclParseBackslash(src, count, &numRead, dst); + int numRead; + int backslashCount = TclParseBackslash(src, count, &numRead, dst); dst += backslashCount; newCount += backslashCount; src += numRead; count -= numRead; @@ -855,12 +859,11 @@ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to list elements. */ { const char **argv, *end, *element; char *p; - int length, size, i, result; - size_t elSize; + int length, size, i, result, elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) * list element plus one more for terminating NULL, plus as many bytes as * in the original string value, plus one more for a terminating '\0'. @@ -868,11 +871,11 @@ * string gets re-purposed to hold '\0' characters in the argv array. */ size = TclMaxListLength(list, -1, &end) + 1; length = end - list; - argv = Tcl_Alloc((size * sizeof(char *)) + length + 1); + argv = (const char **)ckalloc((size * sizeof(char *)) + length + 1); for (i = 0, p = ((char *) argv) + size*sizeof(char *); *list != 0; i++) { const char *prevList = list; int literal; @@ -879,18 +882,18 @@ result = TclFindElement(interp, list, length, &element, &list, &elSize, &literal); length -= (list - prevList); if (result != TCL_OK) { - Tcl_Free((void *)argv); + ckfree(argv); return result; } if (*element == 0) { break; } if (i >= size) { - Tcl_Free((void *)argv); + ckfree(argv); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "internal error in Tcl_SplitList", -1)); Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList", NULL); @@ -933,15 +936,15 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } /* @@ -965,14 +968,14 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ - size_t length, /* Number of bytes in src, or -1. */ + int length, /* Number of bytes in src, or -1. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { char flags = CONVERT_ANY; int numBytes = TclScanElement(src, length, &flags); @@ -1009,14 +1012,14 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int TclScanElement( const char *src, /* String to convert to Tcl list element. */ - size_t length, /* Number of bytes in src, or -1. */ + int length, /* Number of bytes in src, or -1. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; int nestingLevel = 0; /* Brace nesting count */ @@ -1025,19 +1028,19 @@ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some * reason bare or brace-quoted form fails. */ int extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - size_t bytesNeeded; /* Buffer length computed to complete the + int bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ int preferBrace = 0; /* CONVERT_MASK mode. */ int braceCount = 0; /* Count of all braces '{' '}' seen. */ #endif /* COMPAT */ - if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == TCL_AUTO_LENGTH))) { + if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) { /* * Empty string element must be brace quoted. */ *flagPtr = CONVERT_BRACE; @@ -1108,25 +1111,19 @@ /* FLOW THROUGH */ #endif /* COMPAT */ case '[': /* TYPE_SUBS */ case '$': /* TYPE_SUBS */ case ';': /* TYPE_COMMAND_END */ - case ' ': /* TYPE_SPACE */ - case '\f': /* TYPE_SPACE */ - case '\n': /* TYPE_COMMAND_END */ - case '\r': /* TYPE_SPACE */ - case '\t': /* TYPE_SPACE */ - case '\v': /* TYPE_SPACE */ forbidNone = 1; extra++; /* Escape sequences all one byte longer. */ #if COMPAT preferBrace = 1; #endif /* COMPAT */ break; case '\\': /* TYPE_SUBS */ extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == TCL_AUTO_LENGTH) && (p[1] == '\0'))) { + if ((length == 1) || ((length == -1) && (p[1] == '\0'))) { /* * Final backslash. Cannot format with brace quoting. */ requireEscape = 1; @@ -1153,18 +1150,27 @@ #if COMPAT preferBrace = 1; #endif /* COMPAT */ break; case '\0': /* TYPE_SUBS */ - if (length == TCL_AUTO_LENGTH) { + if (length == -1) { goto endOfString; } /* TODO: Panic on improper encoding? */ break; + default: + if (TclIsSpaceProcM(*p)) { + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ +#if COMPAT + preferBrace = 1; +#endif + } + break; } } - length -= (length+1 > 1); + length -= (length > 0); p++; } endOfString: if (nestingLevel != 0) { @@ -1195,11 +1201,11 @@ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { bytesNeeded++; } *flagPtr = CONVERT_ESCAPE; - return bytesNeeded; + goto overflowCheck; } if (*flagPtr & CONVERT_ANY) { /* * The caller has not let us know what flags it will pass to * TclConvertElement() so compute the max size we might need for any @@ -1243,11 +1249,11 @@ if (*flagPtr & TCL_DONT_USE_BRACES) { bytesNeeded += braceCount; } *flagPtr = CONVERT_MASK; - return bytesNeeded; + goto overflowCheck; } #endif /* COMPAT */ if (*flagPtr & TCL_DONT_USE_BRACES) { /* * If the caller reports it will direct TclConvertElement() to @@ -1269,11 +1275,11 @@ */ bytesNeeded += 2; } *flagPtr = CONVERT_BRACE; - return bytesNeeded; + goto overflowCheck; } /* * So far, no need to quote or escape anything. */ @@ -1284,10 +1290,15 @@ */ bytesNeeded += 2; } *flagPtr = CONVERT_NONE; + + overflowCheck: + if (bytesNeeded < 0) { + Tcl_Panic("TclScanElement: string length overflow"); + } return bytesNeeded; } /* *---------------------------------------------------------------------- @@ -1308,11 +1319,11 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { @@ -1338,18 +1349,18 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int Tcl_ConvertCountedElement( - register const char *src, /* Source information for list element. */ - size_t length, /* Number of bytes in src, or -1. */ + const char *src, /* Source information for list element. */ + int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { - size_t numBytes = TclConvertElement(src, length, dst, flags); + int numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; } /* @@ -1371,14 +1382,14 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int TclConvertElement( - register const char *src, /* Source information for list element. */ - size_t length, /* Number of bytes in src, or -1. */ + const char *src, /* Source information for list element. */ + int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int conversion = flags & CONVERT_MASK; char *p = dst; @@ -1393,11 +1404,11 @@ /* * No matter what the caller demands, empty string must be braced! */ - if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_AUTO_LENGTH)) { + if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) { p[0] = '{'; p[1] = '}'; return 2; } @@ -1409,11 +1420,11 @@ if (conversion == CONVERT_ESCAPE) { p[0] = '\\'; p[1] = '#'; p += 2; src++; - length -= (length+1 > 1); + length -= (length > 0); } else { conversion = CONVERT_BRACE; } } @@ -1420,11 +1431,11 @@ /* * No escape or quoting needed. Copy the literal string value. */ if (conversion == CONVERT_NONE) { - if (length == TCL_AUTO_LENGTH) { + if (length == -1) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; } return p - dst; @@ -1439,11 +1450,11 @@ */ if (conversion == CONVERT_BRACE) { *p = '{'; p++; - if (length == TCL_AUTO_LENGTH) { + if (length == -1) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; } } else { @@ -1450,20 +1461,20 @@ memcpy(p, src, length); p += length; } *p = '}'; p++; - return (size_t)(p - dst); + return p - dst; } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ /* * Formatted string is original string converted to escape sequences. */ - for ( ; length; src++, length -= (length+1 > 1)) { + for ( ; length; src++, length -= (length > 0)) { switch (*src) { case ']': case '[': case '$': case ';': @@ -1512,12 +1523,12 @@ p++; *p = 'v'; p++; continue; case '\0': - if (length == TCL_AUTO_LENGTH) { - return (size_t)(p - dst); + if (length == -1) { + return p - dst; } /* * If we reach this point, there's an embedded NULL in the string * range being processed, which should not happen when the @@ -1529,11 +1540,11 @@ break; } *p = *src; p++; } - return (size_t)(p - dst); + return p - dst; } /* *---------------------------------------------------------------------- * @@ -1559,21 +1570,20 @@ int argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int i; - size_t bytesNeeded = 0; + int i, bytesNeeded = 0; char *result, *dst; /* * Handle empty list case first, so logic of the general case can be * simpler. */ if (argc == 0) { - result = Tcl_Alloc(1); + result = (char *)ckalloc(1); result[0] = '\0'; return result; } /* @@ -1581,23 +1591,29 @@ */ if (argc <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = Tcl_Alloc(argc); + flagPtr = (char *)ckalloc(argc); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]); + if (bytesNeeded < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + } + if (bytesNeeded > INT_MAX - argc + 1) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += argc; /* * Pass two: copy into the result area. */ - result = Tcl_Alloc(bytesNeeded); + result = (char *)ckalloc(bytesNeeded); dst = result; for (i = 0; i < argc; i++) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]); *dst = ' '; @@ -1604,51 +1620,51 @@ dst++; } dst[-1] = 0; if (flagPtr != localFlags) { - Tcl_Free(flagPtr); + ckfree(flagPtr); } return result; } -/* - *---------------------------------------------------------------------- - * - * UtfWellFormedEnd -- - * Checks the end of utf string is malformed, if yes - wraps bytes - * to the given buffer (as well-formed NTS string). The buffer - * argument should be initialized by the caller and ready to use. - * - * Results: - * The bytes with well-formed end of the string. - * - * Side effects: - * Buffer (DString) may be allocated, so must be released. - * - *---------------------------------------------------------------------- - */ - -static inline const char* -UtfWellFormedEnd( - Tcl_DString *buffer, /* Buffer used to hold well-formed string. */ - const char *bytes, /* Pointer to the beginning of the string. */ - int length) /* Length of the string. */ -{ - const char *l = bytes + length; - const char *p = Tcl_UtfPrev(l, bytes); - - if (Tcl_UtfCharComplete(p, l - p)) { - return bytes; - } - /* - * Malformed utf-8 end, be sure we've NTS to safe compare of end-character, - * avoid segfault by access violation out of range. - */ - Tcl_DStringAppend(buffer, bytes, length); - return Tcl_DStringValue(buffer); -} +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +/* + *---------------------------------------------------------------------- + * + * Tcl_Backslash -- + * + * Figure out how to handle a backslash sequence. + * + * Results: + * The return value is the character that should be substituted in place + * of the backslash sequence that starts at src. If readPtr isn't NULL + * then it is filled in with a count of the number of characters in the + * backslash sequence. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char +Tcl_Backslash( + const char *src, /* Points to the backslash character of a + * backslash sequence. */ + int *readPtr) /* Fill in with number of characters read from + * src, unless NULL. */ +{ + char buf[4] = ""; + Tcl_UniChar ch = 0; + + Tcl_UtfBackslash(src, readPtr, buf); + TclUtfToUniChar(buf, &ch); + return (char) ch; +} +#endif /* !TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * TclTrimRight -- * Takes two counted strings in the Tcl encoding. Conceptually @@ -1662,38 +1678,49 @@ * None. * *---------------------------------------------------------------------- */ -static inline size_t -TrimRight( - const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - size_t numTrim) /* ...and its length in bytes */ -{ - const char *p = bytes + numBytes; - size_t pInc; - Tcl_UniChar ch1 = 0, ch2 = 0; +int +TclTrimRight( + const char *bytes, /* String to be trimmed... */ + int numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + int numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ +{ + const char *pp, *p = bytes + numBytes; + int ch1, ch2; + + /* Empty strings -> nothing to do */ + if ((numBytes == 0) || (numTrim == 0)) { + return 0; + } /* * Outer loop: iterate over string to be trimmed. */ do { const char *q = trim; - size_t bytesLeft = numTrim; + int pInc = 0, bytesLeft = numTrim; - p = Tcl_UtfPrev(p, bytes); - pInc = TclUtfToUniChar(p, &ch1); + pp = TclUtfPrev(p, bytes); + do { + pp += pInc; + pInc = TclUtfToUCS4(pp, &ch1); + } while (pp + pInc < p); /* * Inner loop: scan trim string for match to current character. */ do { - size_t qInc = TclUtfToUniChar(q, &ch2); + int qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; } @@ -1704,48 +1731,17 @@ if (bytesLeft == 0) { /* * No match; trim task done; *p is last non-trimmed char. */ - p += pInc; break; } + p = pp; } while (p > bytes); return numBytes - (p - bytes); } - -size_t -TclTrimRight( - const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - size_t numTrim) /* ...and its length in bytes */ -{ - size_t res; - Tcl_DString bytesBuf, trimBuf; - - /* Empty strings -> nothing to do */ - if ((numBytes == 0) || (numTrim == 0)) { - return 0; - } - - Tcl_DStringInit(&bytesBuf); - Tcl_DStringInit(&trimBuf); - bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes); - trim = UtfWellFormedEnd(&trimBuf, trim, numTrim); - - res = TrimRight(bytes, numBytes, trim, numTrim); - if (res > numBytes) { - res = numBytes; - } - - Tcl_DStringFree(&bytesBuf); - Tcl_DStringFree(&trimBuf); - - return res; -} /* *---------------------------------------------------------------------- * * TclTrimLeft -- @@ -1761,35 +1757,44 @@ * None. * *---------------------------------------------------------------------- */ -static inline size_t -TrimLeft( - const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - size_t numTrim) /* ...and its length in bytes */ +int +TclTrimLeft( + const char *bytes, /* String to be trimmed... */ + int numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + int numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; - Tcl_UniChar ch1 = 0, ch2 = 0; + int ch1, ch2; + + /* Empty strings -> nothing to do */ + if ((numBytes == 0) || (numTrim == 0)) { + return 0; + } /* * Outer loop: iterate over string to be trimmed. */ do { - size_t pInc = TclUtfToUniChar(p, &ch1); + int pInc = TclUtfToUCS4(p, &ch1); const char *q = trim; - size_t bytesLeft = numTrim; + int bytesLeft = numTrim; /* * Inner loop: scan trim string for match to current character. */ do { - size_t qInc = TclUtfToUniChar(q, &ch2); + int qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; } @@ -1809,41 +1814,10 @@ numBytes -= pInc; } while (numBytes > 0); return p - bytes; } - -size_t -TclTrimLeft( - const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - size_t numTrim) /* ...and its length in bytes */ -{ - size_t res; - Tcl_DString bytesBuf, trimBuf; - - /* Empty strings -> nothing to do */ - if ((numBytes == 0) || (numTrim == 0)) { - return 0; - } - - Tcl_DStringInit(&bytesBuf); - Tcl_DStringInit(&trimBuf); - bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes); - trim = UtfWellFormedEnd(&trimBuf, trim, numTrim); - - res = TrimLeft(bytes, numBytes, trim, numTrim); - if (res > numBytes) { - res = numBytes; - } - - Tcl_DStringFree(&bytesBuf); - Tcl_DStringFree(&trimBuf); - - return res; -} /* *---------------------------------------------------------------------- * * TclTrim -- @@ -1857,49 +1831,47 @@ * None. * *---------------------------------------------------------------------- */ -size_t +int TclTrim( const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ + int numBytes, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - size_t numTrim, /* ...and its length in bytes */ - size_t *trimRight) /* Offset from the end of the string. */ + int numTrim, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (trim[numTrim] == '\0'). */ + int *trimRightPtr) /* Offset from the end of the string. */ { - size_t trimLeft; - Tcl_DString bytesBuf, trimBuf; + int trimLeft = 0, trimRight = 0; - *trimRight = 0; /* Empty strings -> nothing to do */ - if ((numBytes == 0) || (numTrim == 0)) { - return 0; - } - - Tcl_DStringInit(&bytesBuf); - Tcl_DStringInit(&trimBuf); - bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes); - trim = UtfWellFormedEnd(&trimBuf, trim, numTrim); - - trimLeft = TrimLeft(bytes, numBytes, trim, numTrim); - if (trimLeft > numBytes) { - trimLeft = numBytes; - } - numBytes -= trimLeft; - /* have to trim yet (first char was already verified within TrimLeft) */ - if (numBytes > 1) { - bytes += trimLeft; - *trimRight = TrimRight(bytes, numBytes, trim, numTrim); - if (*trimRight > numBytes) { - *trimRight = numBytes; - } - } - - Tcl_DStringFree(&bytesBuf); - Tcl_DStringFree(&trimBuf); - + if ((numBytes > 0) && (numTrim > 0)) { + + /* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */ + trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim); + numBytes -= trimLeft; + + /* If we did not trim the whole string, it starts with a character + * that we will not trim. Skip over it. */ + if (numBytes > 0) { + int ch; + const char *first = bytes + trimLeft; + bytes += TclUtfToUCS4(first, &ch); + numBytes -= (bytes - first); + + if (numBytes > 0) { + /* When bytes is NUL-terminated, returns + * 0 <= trimRight <= numBytes */ + trimRight = TclTrimRight(bytes, numBytes, trim, numTrim); + } + } + } + *trimRightPtr = trimRight; return trimLeft; } /* *---------------------------------------------------------------------- @@ -1919,27 +1891,26 @@ * *---------------------------------------------------------------------- */ /* The whitespace characters trimmed during [concat] operations */ -#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1) +#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1) char * Tcl_Concat( int argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { - int i; - size_t needSpace = 0, bytesNeeded = 0; + int i, needSpace = 0, bytesNeeded = 0; char *result, *p; /* * Dispose of the empty result corner case first to simplify later code. */ if (argc == 0) { - result = (char *) Tcl_Alloc(1); + result = (char *) ckalloc(1); result[0] = '\0'; return result; } /* @@ -1946,20 +1917,31 @@ * First allocate the result buffer at the size required. */ for (i = 0; i < argc; i++) { bytesNeeded += strlen(argv[i]); + if (bytesNeeded < 0) { + Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); + } + } + if (bytesNeeded + argc - 1 < 0) { + /* + * Panic test could be tighter, but not going to bother for this + * legacy routine. + */ + + Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } /* * All element bytes + (argc - 1) spaces + 1 terminating NULL. */ - result = Tcl_Alloc(bytesNeeded + argc); + result = (char *)ckalloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { - size_t triml, trimr, elemLength; + int triml, trimr, elemLength; const char *element; element = argv[i]; elemLength = strlen(argv[i]); @@ -2016,12 +1998,11 @@ Tcl_Obj * Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { - int i, needSpace = 0; - size_t bytesNeeded = 0, elemLength; + int i, elemLength, needSpace = 0, bytesNeeded = 0; const char *element; Tcl_Obj *objPtr, *resPtr; /* * Check first to see if all the items are of list type or empty. If so, @@ -2028,17 +2009,17 @@ * we will concat them together as lists, and return a list object. This * is only valid when the lists are in canonical form. */ for (i = 0; i < objc; i++) { - size_t length; + int length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } - (void)TclGetStringFromObj(objPtr, &length); + TclGetStringFromObj(objPtr, &length); if (length > 0) { break; } } if (i == objc) { @@ -2073,10 +2054,13 @@ */ for (i = 0; i < objc; i++) { element = TclGetStringFromObj(objv[i], &elemLength); bytesNeeded += elemLength; + if (bytesNeeded < 0) { + break; + } } /* * Does not matter if this fails, will simply try later to build up the * string with each Append reallocating as needed with the usual string @@ -2086,11 +2070,11 @@ TclNewObj(resPtr); (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1); Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - size_t triml, trimr; + int triml, trimr; element = TclGetStringFromObj(objv[i], &elemLength); /* Trim away the leading/trailing whitespace. */ triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, @@ -2120,10 +2104,39 @@ needSpace = 1; } return resPtr; } +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +/* + *---------------------------------------------------------------------- + * + * Tcl_StringMatch -- + * + * See if a particular string matches a particular pattern. + * + * Results: + * The return value is 1 if string matches pattern, and 0 otherwise. The + * matching operation permits the following special characters in the + * pattern: *?\[] (see the manual entry for details on what these mean). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_StringMatch +int +Tcl_StringMatch( + const char *str, /* String. */ + const char *pattern) /* Pattern, which may contain special + * characters. */ +{ + return Tcl_StringCaseMatch(str, pattern, 0); +} +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_StringCaseMatch -- * @@ -2147,12 +2160,11 @@ const char *pattern, /* Pattern, which may contain special * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { int p, charLen; - const char *pstart = pattern; - Tcl_UniChar ch1 = 0, ch2 = 0; + int ch1 = 0, ch2 = 0; while (1) { p = *pattern; /* @@ -2189,14 +2201,14 @@ /* * This is a special case optimization for single-byte utf. */ if (UCHAR(*pattern) < 0x80) { - ch2 = (Tcl_UniChar) + ch2 = (int) (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); } else { - Tcl_UtfToUniChar(pattern, &ch2); + TclUtfToUCS4(pattern, &ch2); if (nocase) { ch2 = Tcl_UniCharToLower(ch2); } } @@ -2208,12 +2220,12 @@ */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { while (*str) { - charLen = TclUtfToUniChar(str, &ch1); - if (ch2==ch1 || ch2==(Tcl_UniChar)Tcl_UniCharToLower(ch1)) { + charLen = TclUtfToUCS4(str, &ch1); + if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) { break; } str += charLen; } } else { @@ -2222,11 +2234,11 @@ * shorter, as the number of bytes you want to compare * each time is non-constant. */ while (*str) { - charLen = TclUtfToUniChar(str, &ch1); + charLen = TclUtfToUCS4(str, &ch1); if (ch2 == ch1) { break; } str += charLen; } @@ -2236,11 +2248,11 @@ return 1; } if (*str == '\0') { return 0; } - str += TclUtfToUniChar(str, &ch1); + str += TclUtfToUCS4(str, &ch1); } } /* * Check for a "?" as the next pattern character. It matches any @@ -2247,11 +2259,11 @@ * single character. */ if (p == '?') { pattern++; - str += TclUtfToUniChar(str, &ch1); + str += TclUtfToUCS4(str, &ch1); continue; } /* * Check for a "[" as the next pattern character. It is followed by a @@ -2258,33 +2270,33 @@ * list of characters that are acceptable, or by a range (two * characters separated by "-"). */ if (p == '[') { - Tcl_UniChar startChar = 0, endChar = 0; + int startChar = 0, endChar = 0; pattern++; if (UCHAR(*str) < 0x80) { - ch1 = (Tcl_UniChar) + ch1 = (int) (nocase ? tolower(UCHAR(*str)) : UCHAR(*str)); str++; } else { - str += Tcl_UtfToUniChar(str, &ch1); + str += TclUtfToUCS4(str, &ch1); if (nocase) { ch1 = Tcl_UniCharToLower(ch1); } } while (1) { if ((*pattern == ']') || (*pattern == '\0')) { return 0; } if (UCHAR(*pattern) < 0x80) { - startChar = (Tcl_UniChar) (nocase + startChar = (int) (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); pattern++; } else { - pattern += Tcl_UtfToUniChar(pattern, &startChar); + pattern += TclUtfToUCS4(pattern, &startChar); if (nocase) { startChar = Tcl_UniCharToLower(startChar); } } if (*pattern == '-') { @@ -2291,15 +2303,15 @@ pattern++; if (*pattern == '\0') { return 0; } if (UCHAR(*pattern) < 0x80) { - endChar = (Tcl_UniChar) (nocase + endChar = (int) (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern)); pattern++; } else { - pattern += Tcl_UtfToUniChar(pattern, &endChar); + pattern += TclUtfToUCS4(pattern, &endChar); if (nocase) { endChar = Tcl_UniCharToLower(endChar); } } if (((startChar <= ch1) && (ch1 <= endChar)) @@ -2312,14 +2324,17 @@ } } else if (startChar == ch1) { break; } } + /* If we reach here, we matched. Need to move past closing ] */ while (*pattern != ']') { if (*pattern == '\0') { - pattern = Tcl_UtfPrev(pattern, pstart); - break; + /* We ran out of pattern after matching something in + * (unclosed!) brackets. So long as we ran out of string + * at the same time, we have a match. Otherwise, not. */ + return (*str == '\0'); } pattern++; } pattern++; continue; @@ -2340,12 +2355,12 @@ /* * There's no special character. Just make sure that the next bytes of * each string match. */ - str += TclUtfToUniChar(str, &ch1); - pattern += TclUtfToUniChar(pattern, &ch2); + str += TclUtfToUCS4(str, &ch1); + pattern += TclUtfToUCS4(pattern, &ch2); if (nocase) { if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { return 0; } } else if (ch1 != ch2) { @@ -2375,16 +2390,16 @@ */ int TclByteArrayMatch( const unsigned char *string,/* String. */ - size_t strLen, /* Length of String */ + int strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - size_t ptnLen, /* Length of Pattern */ - int flags) + int ptnLen, /* Length of Pattern */ + TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; unsigned char p; stringEnd = string + strLen; @@ -2556,12 +2571,11 @@ Tcl_Obj *strObj, /* string object. */ Tcl_Obj *ptnObj, /* pattern object. */ int flags) /* Only TCL_MATCH_NOCASE should be passed, or * 0. */ { - int match; - size_t length = 0, plen = 0; + int match, length, plen; /* * Promote based on the type of incoming object. * XXX: Currently doesn't take advantage of exact-ness that * XXX: TclReToGlob tells us about @@ -2569,19 +2583,19 @@ */ if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; - udata = TclGetUnicodeFromObj(strObj, &length); - uptn = TclGetUnicodeFromObj(ptnObj, &plen); + udata = Tcl_GetUnicodeFromObj(strObj, &length); + uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) && !flags) { unsigned char *data, *ptn; - data = TclGetByteArrayFromObj(strObj, &length); - ptn = TclGetByteArrayFromObj(ptnObj, &plen); + data = Tcl_GetByteArrayFromObj(strObj, &length); + ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen); match = TclByteArrayMatch(data, length, ptn, plen, 0); } else { match = Tcl_StringCaseMatch(TclGetString(strObj), TclGetString(ptnObj), flags); } @@ -2635,19 +2649,19 @@ */ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - const char *bytes, /* String to append. If length is - * TCL_AUTO_LENGTH then this must be null-terminated. */ - size_t length) /* Number of bytes from "bytes" to append. If - * TCL_AUTO_LENGTH, then append all of bytes, up to null + const char *bytes, /* String to append. If length is -1 then this + * must be null-terminated. */ + int length) /* Number of bytes from "bytes" to append. If + * < 0, then append all of bytes, up to null * at end. */ { - size_t newSize; + int newSize; - if (length == TCL_AUTO_LENGTH) { + if (length < 0) { length = strlen(bytes); } newSize = length + dsPtr->length; /* @@ -2657,27 +2671,27 @@ */ if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { - char *newString = Tcl_Alloc(dsPtr->spaceAvl); + char *newString = (char *)ckalloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - size_t index = TCL_INDEX_NONE; + int offset = -1; /* See [16896d49fd] */ if (bytes >= dsPtr->string && bytes <= dsPtr->string + dsPtr->length) { - index = bytes - dsPtr->string; + offset = bytes - dsPtr->string; } - dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); - if (index != TCL_INDEX_NONE) { - bytes = dsPtr->string + index; + if (offset >= 0) { + bytes = dsPtr->string + offset; } } } /* @@ -2704,12 +2718,12 @@ char * TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - size_t length; - const char *bytes = TclGetStringFromObj(objPtr, &length); + int length; + char *bytes = TclGetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } char * @@ -2745,13 +2759,41 @@ const char *element) /* String to append. Must be * null-terminated. */ { char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); - char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; - size_t newSize = dsPtr->length + needSpace - + TclScanElement(element, -1, &flags); + char flags = 0; + int quoteHash = 1, newSize; + + if (needSpace) { + /* + * If we need a space to separate the new element from something + * already ending the string, we're not appending the first element + * of any list, so we need not quote any leading hash character. + */ + quoteHash = 0; + } else { + /* + * We don't need a space, maybe because there's some already there. + * Checking whether we might be appending a first element is a bit + * more involved. + * + * Backtrack over all whitespace. + */ + while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) { + } + + /* Call again without whitespace to confound things. */ + quoteHash = !TclNeedSpace(dsPtr->string, dst+1); + } + if (!quoteHash) { + flags |= TCL_DONT_QUOTE_HASH; + } + newSize = dsPtr->length + needSpace + TclScanElement(element, -1, &flags); + if (!quoteHash) { + flags |= TCL_DONT_QUOTE_HASH; + } /* * Allocate a larger buffer for the string if the current one isn't large * enough. Allocate extra space in the new buffer so that there will be * room to grow before we have to allocate again. SPECIAL NOTE: must use @@ -2760,11 +2802,11 @@ */ if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { - char *newString = Tcl_Alloc(dsPtr->spaceAvl); + char *newString = (char *)ckalloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { int offset = -1; @@ -2773,18 +2815,18 @@ if (element >= dsPtr->string && element <= dsPtr->string + dsPtr->length) { offset = element - dsPtr->string; } - dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { element = dsPtr->string + offset; } } - dst = dsPtr->string + dsPtr->length; } + dst = dsPtr->string + dsPtr->length; /* * Convert the new string to a list element and copy it into the buffer at * the end, with a space, if needed. */ @@ -2791,19 +2833,12 @@ if (needSpace) { *dst = ' '; dst++; dsPtr->length++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; - } + } + dsPtr->length += TclConvertElement(element, -1, dst, flags); dsPtr->string[dsPtr->length] = '\0'; return dsPtr->string; } @@ -2818,22 +2853,26 @@ * Results: * None. * * Side effects: * The length of dsPtr is changed to length and a null byte is stored at - * that position in the string. + * that position in the string. If length is larger than the space + * allocated for dsPtr, then a panic occurs. * *---------------------------------------------------------------------- */ void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - size_t length) /* New length for dynamic string. */ + int length) /* New length for dynamic string. */ { - size_t newsize; + int newsize; + if (length < 0) { + length = 0; + } if (length >= dsPtr->spaceAvl) { /* * There are two interesting cases here. In the first case, the user * may be trying to allocate a large buffer of a specific size. It * would be wasteful to overallocate that buffer, so we just allocate @@ -2850,16 +2889,16 @@ dsPtr->spaceAvl = newsize; } else { dsPtr->spaceAvl = length + 1; } if (dsPtr->string == dsPtr->staticSpace) { - char *newString = Tcl_Alloc(dsPtr->spaceAvl); + char *newString = (char *)ckalloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); } } dsPtr->length = length; dsPtr->string[length] = 0; } @@ -2885,11 +2924,11 @@ void Tcl_DStringFree( Tcl_DString *dsPtr) /* Structure describing dynamic string. */ { if (dsPtr->string != dsPtr->staticSpace) { - Tcl_Free(dsPtr->string); + ckfree(dsPtr->string); } dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; dsPtr->staticSpace[0] = '\0'; @@ -2947,16 +2986,90 @@ Tcl_DStringGetResult( Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 Tcl_Obj *obj = Tcl_GetObjResult(interp); - char *bytes = TclGetString(obj); + const char *bytes = TclGetString(obj); Tcl_DStringFree(dsPtr); Tcl_DStringAppend(dsPtr, bytes, obj->length); Tcl_ResetResult(interp); +#else + Interp *iPtr = (Interp *) interp; + + if (dsPtr->string != dsPtr->staticSpace) { + ckfree(dsPtr->string); + } + + /* + * Do more efficient transfer when we know the result is a Tcl_Obj. When + * there's no string result, we only have to deal with two cases: + * + * 1. When the string rep is the empty string, when we don't copy but + * instead use the staticSpace in the DString to hold an empty string. + + * 2. When the string rep is not there or there's a real string rep, when + * we use Tcl_GetString to fetch (or generate) the string rep - which + * we know to have been allocated with ckalloc() - and use it to + * populate the DString space. Then, we free the internal rep. and set + * the object's string representation back to the canonical empty + * string. + */ + + if (!iPtr->result[0] && iPtr->objResultPtr + && !Tcl_IsShared(iPtr->objResultPtr)) { + if (iPtr->objResultPtr->bytes == &tclEmptyString) { + dsPtr->string = dsPtr->staticSpace; + dsPtr->string[0] = 0; + dsPtr->length = 0; + dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; + } else { + dsPtr->string = TclGetString(iPtr->objResultPtr); + dsPtr->length = iPtr->objResultPtr->length; + dsPtr->spaceAvl = dsPtr->length + 1; + TclFreeIntRep(iPtr->objResultPtr); + iPtr->objResultPtr->bytes = &tclEmptyString; + iPtr->objResultPtr->length = 0; + } + return; + } + + /* + * If the string result is empty, move the object result to the string + * result, then reset the object result. + */ + + (void) Tcl_GetStringResult(interp); + + dsPtr->length = strlen(iPtr->result); + if (iPtr->freeProc != NULL) { + if (iPtr->freeProc == TCL_DYNAMIC) { + dsPtr->string = iPtr->result; + dsPtr->spaceAvl = dsPtr->length+1; + } else { + dsPtr->string = (char *)ckalloc(dsPtr->length+1); + memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); + iPtr->freeProc(iPtr->result); + } + dsPtr->spaceAvl = dsPtr->length+1; + iPtr->freeProc = NULL; + } else { + if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { + dsPtr->string = dsPtr->staticSpace; + dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; + } else { + dsPtr->string = (char *)ckalloc(dsPtr->length+1); + dsPtr->spaceAvl = dsPtr->length + 1; + } + memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); + } + + iPtr->result = iPtr->resultSpace; + iPtr->resultSpace[0] = 0; +#endif /* !TCL_NO_DEPRECATED */ } /* *---------------------------------------------------------------------- * @@ -3078,32 +3191,34 @@ * * Given a floating-point value, this function converts it to an ASCII * string using. * * Results: - * The ASCII equivalent of "value" is written at "dst". It is guaranteed - * to contain a decimal point or exponent, so that it looks like a - * floating-point value and not an integer. + * The ASCII equivalent of "value" is written at "dst". It is written + * using the current precision, and it is guaranteed to contain a decimal + * point or exponent, so that it looks like a floating-point value and + * not an integer. * * Side effects: * None. * *---------------------------------------------------------------------- */ void Tcl_PrintDouble( - Tcl_Interp *interp, /* Not used */ + TCL_UNUSED(Tcl_Interp *), double value, /* Value to print as string. */ char *dst) /* Where to store converted value; must have * at least TCL_DOUBLE_SPACE characters. */ { char *p, c; int exponent; int signum; char *digits; char *end; + int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. */ @@ -3131,12 +3246,57 @@ /* * Ordinary (normal and denormal) values. */ - digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, - &exponent, &signum, &end); + if (*precisionPtr == 0) { + digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, + &exponent, &signum, &end); + } else { + /* + * There are at least two possible interpretations for tcl_precision. + * + * The first is, "choose the decimal representation having + * $tcl_precision digits of significance that is nearest to the given + * number, breaking ties by rounding to even, and then trimming + * trailing zeros." This gives the greatest possible precision in the + * decimal string, but offers the anomaly that [expr 0.1] will be + * "0.10000000000000001". + * + * The second is "choose the decimal representation having at most + * $tcl_precision digits of significance that is nearest to the given + * number. If no such representation converts exactly to the given + * number, choose the one that is closest, breaking ties by rounding + * to even. If more than one such representation converts exactly to + * the given number, choose the shortest, breaking ties in favour of + * the nearest, breaking remaining ties in favour of the one ending in + * an even digit." + * + * Tcl 8.4 implements the first of these, which gives rise to + * anomalies in formatting: + * + * % expr 0.1 + * 0.10000000000000001 + * % expr 0.01 + * 0.01 + * % expr 1e-7 + * 9.9999999999999995e-08 + * + * For human readability, it appears better to choose the second rule, + * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer + * the first (the recommended zero value for tcl_precision avoids the + * problem entirely). + * + * Uncomment TCL_DD_SHORTEST in the next call to prefer the method + * that allows floating point values to be shortened if it can be done + * without loss of precision. + */ + + digits = TclDoubleDigits(value, *precisionPtr, + TCL_DD_E_FORMAT /* | TCL_DD_SHORTEST */, + &exponent, &signum, &end); + } if (signum) { *dst++ = '-'; } p = digits; if (exponent < -4 || exponent > 16) { @@ -3152,11 +3312,20 @@ *dst++ = c; c = *++p; } } - sprintf(dst, "e%+d", exponent); + /* + * Tcl 8.4 appears to format with at least a two-digit exponent; + * preserve that behaviour when tcl_precision != 0 + */ + + if (*precisionPtr == 0) { + sprintf(dst, "e%+d", exponent); + } else { + sprintf(dst, "e%+03d", exponent); + } } else { /* * F format for others. */ @@ -3184,12 +3353,91 @@ c = *++p; } } *dst++ = '\0'; } - Tcl_Free(digits); + ckfree(digits); +} + +/* + *---------------------------------------------------------------------- + * + * TclPrecTraceProc -- + * + * This function is invoked whenever the variable "tcl_precision" is + * written. + * + * Results: + * Returns NULL if all went well, or an error message if the new value + * for the variable doesn't make sense. + * + * Side effects: + * If the new value doesn't make sense then this function undoes the + * effect of the variable modification. Otherwise it modifies the format + * string that's used by Tcl_PrintDouble. + * + *---------------------------------------------------------------------- + */ + +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +char * +TclPrecTraceProc( + ClientData clientData, + Tcl_Interp *interp, /* Interpreter containing variable. */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ + int flags) /* Information about what happened. */ +{ + Tcl_Obj *value; + Tcl_WideInt prec; + int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); + + /* + * If the variable is unset, then recreate the trace. + */ + + if (flags & TCL_TRACE_UNSETS) { + if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) { + Tcl_TraceVar2(interp, name1, name2, + TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES + |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); + } + return NULL; + } + + /* + * When the variable is read, reset its value from our shared value. This + * is needed in case the variable was modified in some other interpreter + * so that this interpreter's value is out of date. + */ + + + if (flags & TCL_TRACE_READS) { + Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewWideIntObj(*precisionPtr), + flags & TCL_GLOBAL_ONLY); + return NULL; + } + + /* + * The variable is being written. Check the new value and disallow it if + * it isn't reasonable or if this is a safe interpreter (we don't want + * safe interpreters messing up the precision of other interpreters). + */ + + if (Tcl_IsSafe(interp)) { + return (char *) "can't modify precision from a safe interpreter"; + } + value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); + if (value == NULL + || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK + || prec < 0 || prec > TCL_MAX_PREC) { + return (char *) "improper value for precision"; + } + *precisionPtr = (int)prec; + return NULL; } +#endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- * * TclNeedSpace -- @@ -3213,67 +3461,73 @@ * added, if appropriate). */ { /* * A space is needed unless either: * (a) we're at the start of the string, or - */ + * + * (NOTE: This check is now absorbed into the loop below.) + * if (end == start) { return 0; } + * + */ + /* * (b) we're at the start of a nested list-element, quoted with an open * curly brace; we can be nested arbitrarily deep, so long as the * first curly brace starts an element, so backtrack over open curly * braces that are trailing characters of the string; and - */ + * + * (NOTE: Every character our parser is looking for is a proper + * single-byte encoding of an ASCII value. It does not accept + * overlong encodings. Given that, there's no benefit using + * Tcl_UtfPrev. If it would find what we seek, so would byte-by-byte + * backward scan. Save routine call overhead and risk of wrong + * results should the behavior of Tcl_UtfPrev change in unexpected ways. + * Reconsider this if we ever start treating non-ASCII Unicode + * characters as meaningful list syntax, expanded Unicode spaces as + * element separators, for example.) + * end = Tcl_UtfPrev(end, start); while (*end == '{') { - if (end == start) { - return 0; - } - end = Tcl_UtfPrev(end, start); + if (end == start) { + return 0; + } + end = Tcl_UtfPrev(end, start); + } + + * + */ + + while ((--end >= start) && (*end == '{')) { + } + if (end < start) { + return 0; } /* * (c) the trailing character of the string is already a list-element - * separator (according to TclFindElement); that is, one of these - * characters: - * \u0009 \t TAB - * \u000A \n NEWLINE - * \u000B \v VERTICAL TAB - * \u000C \f FORM FEED - * \u000D \r CARRIAGE RETURN - * \u0020 SPACE - * with the condition that the penultimate character is not a - * backslash. - */ - - if (*end > 0x20) { - /* - * Performance tweak. All ASCII spaces are <= 0x20. So get a quick - * answer for most characters before comparing against all spaces in - * the switch below. - * - * NOTE: Remove this if other Unicode spaces ever get accepted as - * list-element separators. - */ - - return 1; - } - switch (*end) { - case ' ': - case '\t': - case '\n': - case '\r': - case '\v': - case '\f': - if ((end == start) || (end[-1] != '\\')) { - return 0; - } + * separator, Use the same testing routine as TclFindElement to + * enforce consistency. + */ + + if (TclIsSpaceProcM(*end)) { + int result = 0; + + /* + * Trailing whitespace might be part of a backslash escape + * sequence. Handle that possibility. + */ + + while ((--end >= start) && (*end == '\\')) { + result = !result; + } + return result; } return 1; } /* @@ -3299,58 +3553,35 @@ * the "buffer" argument. * *---------------------------------------------------------------------- */ -size_t +int TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ Tcl_WideInt n) /* The integer to format. */ { - Tcl_WideInt intVal; - size_t i, numFormatted, j; - const char *digits = "0123456789"; - - /* - * Check first whether "n" is zero. - */ - - if (n == 0) { - buffer[0] = '0'; - buffer[1] = 0; - return 1; - } - - /* - * Check whether "n" is the maximum negative value. This is -2^(m-1) for - * an m-bit word, and has no positive equivalent; negating it produces the - * same value. - */ - - intVal = -n; /* [Bug 3390638] Workaround for*/ - if (n == -n || intVal == n) { /* broken compiler optimizers. */ - return sprintf(buffer, "%" TCL_LL_MODIFIER "d", n); - } + Tcl_WideUInt intVal; + int i = 0; + int numFormatted, j; + static const char digits[] = "0123456789"; /* * Generate the characters of the result backwards in the buffer. */ - intVal = (n < 0? -n : n); - i = 0; - buffer[0] = '\0'; + intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n); do { - i++; - buffer[i] = digits[intVal % 10]; - intVal = intVal/10; + buffer[i++] = digits[intVal % 10]; + intVal = intVal / 10; } while (intVal > 0); if (n < 0) { - i++; - buffer[i] = '-'; + buffer[i++] = '-'; } - numFormatted = i; + buffer[i] = '\0'; + numFormatted = i--; /* * Now reverse the characters. */ @@ -3390,202 +3621,61 @@ */ static int GetWideForIndex( Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ + * NULL, then no error message is left after + * errors. */ Tcl_Obj *objPtr, /* Points to the value to be parsed */ size_t endValue, /* The value to be stored at *widePtr if - * objPtr holds "end". + * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ Tcl_WideInt *widePtr) /* Location filled in with a wide integer * representing an index. */ { + int numType; ClientData cd; - const char *opPtr; - int numType, length, t1 = 0, t2 = 0; int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType); if (code == TCL_OK) { if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; return TCL_OK; } - if (numType != TCL_NUMBER_BIG) { - /* Must be a double -> not a valid index */ - goto parseError; - } - - /* objPtr holds an integer outside the signed wide range */ - /* Truncate to the signed wide range. */ - *widePtr = (((mp_int *)cd)->sign != MP_ZPOS) ? WIDE_MIN : WIDE_MAX; - return TCL_OK; - } - - /* objPtr does not hold a number, check the end+/- format... */ - if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) { - return TCL_OK; - } - - /* If we reach here, the string rep of objPtr exists. */ - - /* - * The valid index syntax does not include any value that is - * a list of more than one element. This is necessary so that - * lists of index values can be reliably distinguished from any - * single index value. - */ - - /* - * Quick scan to see if multi-value list is even possible. - * This relies on TclGetString() returning a NUL-terminated string. - */ - if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1) - - /* If it's possible, do the full list parse. */ - && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length)) - && (length > 1)) { - goto parseError; - } - - /* Passed the list screen, so parse for index arithmetic expression */ - if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr, - TCL_PARSE_INTEGER_ONLY)) { - Tcl_WideInt w1=0, w2=0; - - /* value starts with valid integer... */ - - if ((*opPtr == '-') || (*opPtr == '+')) { - /* ... value continues with [-+] ... */ - - /* Save first integer as wide if possible */ - TclGetNumberFromObj(NULL, objPtr, &cd, &t1); - if (t1 == TCL_NUMBER_INT) { - w1 = (*(Tcl_WideInt *)cd); - } - - if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1, - -1, NULL, TCL_PARSE_INTEGER_ONLY)) { - /* ... value concludes with second valid integer */ - - /* Save second integer as wide if possible */ - TclGetNumberFromObj(NULL, objPtr, &cd, &t2); - if (t2 == TCL_NUMBER_INT) { - w2 = (*(Tcl_WideInt *)cd); - } - } - } - /* Clear invalid intreps left by TclParseNumber */ - TclFreeIntRep(objPtr); - - if (t1 && t2) { - /* We have both integer values */ - if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) { - /* Both are wide, do wide-integer math */ - if (*opPtr == '-') { - if ((w2 == WIDE_MIN) && (interp != NULL)) { - goto extreme; - } - w2 = -w2; - } - - if ((w1 ^ w2) < 0) { - /* Different signs, sum cannot overflow */ - *widePtr = w1 + w2; - } else if (w1 >= 0) { - if (w1 < WIDE_MAX - w2) { - *widePtr = w1 + w2; - } else { - *widePtr = WIDE_MAX; - } - } else { - if (w1 > WIDE_MIN - w2) { - *widePtr = w1 + w2; - } else { - *widePtr = WIDE_MIN; - } - } - } else if (interp == NULL) { - /* - * We use an interp to do bignum index calculations. - * If we don't get one, call all indices with bignums errors, - * and rely on callers to handle it. - */ - return TCL_ERROR; - } else { - /* - * At least one is big, do bignum math. Little reason to - * value performance here. Re-use code. Parse has verified - * objPtr is an expression. Compute it. - */ - - Tcl_Obj *sum; - - extreme: - Tcl_ExprObj(interp, objPtr, &sum); - TclGetNumberFromObj(NULL, sum, &cd, &numType); - - if (numType == TCL_NUMBER_INT) { - /* sum holds an integer in the signed wide range */ - *widePtr = *(Tcl_WideInt *)cd; - } else { - /* sum holds an integer outside the signed wide range */ - /* Truncate to the signed wide range. */ - if (((mp_int *)cd)->sign != MP_ZPOS) { - *widePtr = WIDE_MIN; - } else { - *widePtr = WIDE_MAX; - } - } - Tcl_DecrRefCount(sum); - } - return TCL_OK; - } - } - - /* Report a parse error. */ - parseError: - if (interp != NULL) { - char * bytes = TclGetString(objPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be integer?[+-]integer? or" - " end?[+-]integer?", bytes)); - if (!strncmp(bytes, "end-", 4)) { - bytes += 4; - } - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); - } - return TCL_ERROR; + if (numType == TCL_NUMBER_BIG) { + /* objPtr holds an integer outside the signed wide range */ + /* Truncate to the signed wide range. */ + *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX); + return TCL_OK; + } + } + + /* objPtr does not hold a number, check the end+/- format... */ + return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr); } /* *---------------------------------------------------------------------- * * Tcl_GetIntForIndex -- * - * Provides an integer corresponding to the list index held in a Tcl - * object. The string value 'objPtr' is expected have the format - * integer([+-]integer)? or end([+-]integer)?. - * - * Value - * TCL_OK - * - * The index is stored at the address given by by 'indexPtr'. If - * 'objPtr' has the value "end", the value stored is 'endValue'. - * - * TCL_ERROR - * - * The value of 'objPtr' does not have one of the expected formats. If - * 'interp' is non-NULL, an error message is left in the interpreter's - * result object. - * - * Effect - * - * The object referenced by 'objPtr' is converted, as needed, to an - * integer, wide integer, or end-based-index object. + * This function returns an integer corresponding to the list index held + * in a Tcl object. The Tcl object's value is expected to be in the + * format integer([+-]integer)? or the format end([+-]integer)?. + * + * Results: + * The return value is normally TCL_OK, which means that the index was + * successfully stored into the location referenced by "indexPtr". If the + * Tcl object referenced by "objPtr" has the value "end", the value + * stored is "endValue". If "objPtr"s values is not of one of the + * expected formats, TCL_ERROR is returned and, if "interp" is non-NULL, + * an error message is left in the interpreter's result object. + * + * Side effects: + * The object referenced by "objPtr" might be converted to an integer, + * wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ int @@ -3593,38 +3683,51 @@ Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ - size_t endValue, /* The value to be stored at "indexPtr" if + int endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ - size_t *indexPtr) /* Location filled in with an integer - * representing an index. */ + int *indexPtr) /* Location filled in with an integer + * representing an index. May be NULL.*/ { Tcl_WideInt wide; - /* Use platform-related size_t to wide-int to consider negative value - * TCL_INDEX_NONE if wide-int and size_t have different dimensions. */ - if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) { + if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) { return TCL_ERROR; } - if (wide < 0) { - *indexPtr = TCL_INDEX_NONE; - } else if ((Tcl_WideUInt)wide > TCL_INDEX_END) { - *indexPtr = TCL_INDEX_END; - } else { - *indexPtr = (size_t) wide; + if (indexPtr != NULL) { + if ((wide < 0) && (endValue > TCL_INDEX_END)) { + *indexPtr = -1; + } else if (wide > INT_MAX) { + *indexPtr = INT_MAX; + } else if (wide < INT_MIN) { + *indexPtr = INT_MIN; + } else { + *indexPtr = (int) wide; + } } return TCL_OK; } /* *---------------------------------------------------------------------- * * GetEndOffsetFromObj -- * - * Look for a string of the form "end[+-]offset" and convert it to an - * internal representation holding the offset. + * Look for a string of the form "end[+-]offset" or "offset[+-]offset" and + * convert it to an internal representation. + * + * The internal representation (wideValue) uses the following encoding: + * + * WIDE_MIN: Index value TCL_INDEX_NONE (or -1) + * WIDE_MIN+1: Index value n, for any n < -1 (usually same effect as -1) + * -$n: Index "end-[expr {$n-1}]" + * -2: Index "end-1" + * -1: Index "end" + * 0: Index "0" + * WIDE_MAX-1: Index "end+n", for any n > 1 + * WIDE_MAX: Index "end+1" * * Results: * Tcl return code. * * Side effects: @@ -3633,61 +3736,185 @@ *---------------------------------------------------------------------- */ static int GetEndOffsetFromObj( + Tcl_Interp *interp, Tcl_Obj *objPtr, /* Pointer to the object to parse */ size_t endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ { Tcl_ObjIntRep *irPtr; - Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */ + Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ + ClientData cd; while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; - size_t length; + int length; const char *bytes = TclGetStringFromObj(objPtr, &length); - if ((length < 3) || (length == 4)) { - /* Too short to be "end" or to be "end-$integer" */ - return TCL_ERROR; - } - if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) { - /* Value doesn't start with "end" */ - return TCL_ERROR; - } - - if (length > 4) { - ClientData cd; + if (*bytes != 'e') { + int numType; + const char *opPtr; + int length, t1 = 0, t2 = 0; + + /* Value doesn't start with "e" */ + + /* If we reach here, the string rep of objPtr exists. */ + + /* + * The valid index syntax does not include any value that is + * a list of more than one element. This is necessary so that + * lists of index values can be reliably distinguished from any + * single index value. + */ + + /* + * Quick scan to see if multi-value list is even possible. + * This relies on TclGetString() returning a NUL-terminated string. + */ + if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1) + + /* If it's possible, do the full list parse. */ + && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length)) + && (length > 1)) { + goto parseError; + } + + /* Passed the list screen, so parse for index arithmetic expression */ + if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr, + TCL_PARSE_INTEGER_ONLY)) { + Tcl_WideInt w1=0, w2=0; + + /* value starts with valid integer... */ + + if ((*opPtr == '-') || (*opPtr == '+')) { + /* ... value continues with [-+] ... */ + + /* Save first integer as wide if possible */ + TclGetNumberFromObj(NULL, objPtr, &cd, &t1); + if (t1 == TCL_NUMBER_INT) { + w1 = (*(Tcl_WideInt *)cd); + } + + if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1, + -1, NULL, TCL_PARSE_INTEGER_ONLY)) { + /* ... value concludes with second valid integer */ + + /* Save second integer as wide if possible */ + TclGetNumberFromObj(NULL, objPtr, &cd, &t2); + if (t2 == TCL_NUMBER_INT) { + w2 = (*(Tcl_WideInt *)cd); + } + } + } + /* Clear invalid intreps left by TclParseNumber */ + TclFreeIntRep(objPtr); + + if (t1 && t2) { + /* We have both integer values */ + if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) { + /* Both are wide, do wide-integer math */ + if (*opPtr == '-') { + if ((w2 == WIDE_MIN) && (interp != NULL)) { + goto extreme; + } + w2 = -w2; + } + + if ((w1 ^ w2) < 0) { + /* Different signs, sum cannot overflow */ + offset = w1 + w2; + } else if (w1 >= 0) { + if (w1 < WIDE_MAX - w2) { + offset = w1 + w2; + } else { + offset = WIDE_MAX; + } + } else { + if (w1 > WIDE_MIN - w2) { + offset = w1 + w2; + } else { + offset = WIDE_MIN; + } + } + } else if (interp == NULL) { + /* + * We use an interp to do bignum index calculations. + * If we don't get one, call all indices with bignums errors, + * and rely on callers to handle it. + */ + goto parseError; + } else { + /* + * At least one is big, do bignum math. Little reason to + * value performance here. Re-use code. Parse has verified + * objPtr is an expression. Compute it. + */ + + Tcl_Obj *sum; + + extreme: + Tcl_ExprObj(interp, objPtr, &sum); + TclGetNumberFromObj(NULL, sum, &cd, &numType); + + if (numType == TCL_NUMBER_INT) { + /* sum holds an integer in the signed wide range */ + offset = *(Tcl_WideInt *)cd; + } else { + /* sum holds an integer outside the signed wide range */ + /* Truncate to the signed wide range. */ + if (mp_isneg((mp_int *)cd)) { + offset = WIDE_MIN; + } else { + offset = WIDE_MAX; + } + } + Tcl_DecrRefCount(sum); + } + if (offset < 0) { + offset = (offset == -1) ? WIDE_MIN : WIDE_MIN+1; + } + goto parseOK; + } + } + goto parseError; + } + + if ((length < 3) || (length == 4) || (strncmp(bytes, "end", 3) != 0)) { + /* Doesn't start with "end" */ + goto parseError; + } + if (length > 4) { int t; /* Parse for the "end-..." or "end+..." formats */ if ((bytes[3] != '-') && (bytes[3] != '+')) { /* No operator where we need one */ - return TCL_ERROR; + goto parseError; } if (TclIsSpaceProc(bytes[4])) { /* Space after + or - not permitted. */ - return TCL_ERROR; + goto parseError; } /* Parse the integer offset */ if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) { /* Not a recognized integer format */ - return TCL_ERROR; + goto parseError; } /* Got an integer offset; pull it from where parser left it. */ TclGetNumberFromObj(NULL, objPtr, &cd, &t); if (t == TCL_NUMBER_BIG) { /* Truncate to the signed wide range. */ - if (((mp_int *)cd)->sign != MP_ZPOS) { + if (mp_isneg((mp_int *)cd)) { offset = (bytes[3] == '-') ? WIDE_MAX : WIDE_MIN; } else { offset = (bytes[3] == '-') ? WIDE_MIN : WIDE_MAX; } } else { @@ -3694,31 +3921,59 @@ /* assert (t == TCL_NUMBER_INT); */ offset = (*(Tcl_WideInt *)cd); if (bytes[3] == '-') { offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset; } + if (offset == 1) { + offset = WIDE_MAX; /* "end+1" */ + } else if (offset > 1) { + offset = WIDE_MAX - 1; /* "end+n", out of range */ + } else if (offset != WIDE_MIN) { + offset--; + } } } + parseOK: /* Success. Store the new internal rep. */ ir.wideValue = offset; Tcl_StoreIntRep(objPtr, &endOffsetType, &ir); } offset = irPtr->wideValue; - if (endValue == TCL_INDEX_NONE) { - *widePtr = offset - 1; + if (offset == WIDE_MAX) { + *widePtr = endValue + 1; + } else if (offset == WIDE_MIN) { + *widePtr = -1; + } else if (endValue == (size_t)-1) { + *widePtr = offset; } else if (offset < 0) { - /* Different signs, sum cannot overflow */ - *widePtr = endValue + offset; - } else if (endValue < (Tcl_WideUInt)WIDE_MAX - offset) { - *widePtr = endValue + offset; + /* Different signs, sum cannot overflow */ + *widePtr = endValue + offset + 1; + } else if (offset < WIDE_MAX) { + *widePtr = offset; } else { - *widePtr = WIDE_MAX; + *widePtr = WIDE_MAX; } return TCL_OK; + + /* Report a parse error. */ + parseError: + if (interp != NULL) { + char * bytes = TclGetString(objPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer?[+-]integer? or" + " end?[+-]integer?", bytes)); + if (!strncmp(bytes, "end-", 4)) { + bytes += 4; + } + TclCheckBadOctal(interp, bytes); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); + } + + return TCL_ERROR; } /* *---------------------------------------------------------------------- * @@ -3751,15 +4006,15 @@ * All end-relative expressions that indicate an index larger * than end (end+2, end--5) point beyond the end of the indexed * collection, and can be encoded as after. The end-relative * expressions that indicate an index less than or equal to end * are encoded relative to the value TCL_INDEX_END (-2). The - * index "end" is encoded as -2, down to the index "end-0x7ffffffe" + * index "end" is encoded as -2, down to the index "end-0x7FFFFFFE" * which is encoded as INT_MIN. Since the largest index into a - * string possible in Tcl 8 is 0x7ffffffe, the interpretation of - * "end-0x7ffffffe" for that largest string would be 0. Thus, - * if the tokens "end-0x7fffffff" or "end+-0x80000000" are parsed, + * string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of + * "end-0x7FFFFFFE" for that largest string would be 0. Thus, + * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, * they can be encoded with the before value. * * These details will require re-examination whenever string and * list length limits are increased, but that will likely also * mean a revised routine capable of returning Tcl_WideInt values. @@ -3776,60 +4031,40 @@ int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ - size_t before, /* Value to return for index before beginning */ - size_t after, /* Value to return for index after end */ + int before, /* Value to return for index before beginning */ + int after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { - ClientData cd; Tcl_WideInt wide; - int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType); - - if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) { - /* We parsed a value in the range WIDE_MIN...WIDE_MAX */ - wide = (*(Tcl_WideInt *)cd); - integerEncode: - if (wide < 0) { - /* All negative absolute indices are "before the beginning" */ - idx = before; - } else if (wide >= INT_MAX) { - /* This index value is always "after the end" */ - idx = after; - } else { - idx = (int) wide; - } - /* usual case, the absolute index value encodes itself */ - } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) { - /* - * We parsed an end+offset index value. - * wide holds the offset value in the range WIDE_MIN...WIDE_MAX. - */ - if (wide > 0) { - /* - * All end+positive or end-negative expressions - * always indicate "after the end". - */ - idx = (int) after; - } else if (wide < INT_MIN - (int) TCL_INDEX_END) { - /* These indices always indicate "before the beginning */ - idx = (int) before; - } else { - /* Encoded end-positive (or end+negative) are offset */ - idx = (int) wide + (int) TCL_INDEX_END; - } - - /* TODO: Consider flag to suppress repeated end-offset parse. */ - } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) { - /* - * Only reach this case when the index value is a - * constant index arithmetic expression, and wide - * holds the result. Treat it the same as if it were - * parsed as an absolute integer value. - */ - goto integerEncode; + int idx; + + if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) { + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &endOffsetType); + if (irPtr && irPtr->wideValue >= 0) { + /* "int[+-]int" syntax, works the same here as "int" */ + irPtr = NULL; + } + /* + * We parsed an end+offset index value. + * wide holds the offset value in the range WIDE_MIN...WIDE_MAX. + */ + if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) { + /* + * All end+postive or end-negative expressions + * always indicate "after the end". + */ + idx = after; + } else if (wide <= (irPtr ? INT_MAX : TCL_INDEX_NONE)) { + /* These indices always indicate "before the beginning */ + idx = before; + } else { + /* Encoded end-positive (or end+negative) are offset */ + idx = (int)wide; + } } else { return TCL_ERROR; } *indexPtr = idx; return TCL_OK; @@ -3848,23 +4083,91 @@ * The decoded index value. * *---------------------------------------------------------------------- */ -size_t +int TclIndexDecode( int encoded, /* Value to decode */ - size_t endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { - if (encoded > (int)TCL_INDEX_END) { + if (encoded > TCL_INDEX_END) { return encoded; } - if (endValue >= TCL_INDEX_END - encoded) { - return endValue + encoded - TCL_INDEX_END; + endValue += encoded - TCL_INDEX_END; + if (endValue >= 0) { + return endValue; } return TCL_INDEX_NONE; } + +/* + *---------------------------------------------------------------------- + * + * TclCheckBadOctal -- + * + * This function checks for a bad octal value and appends a meaningful + * error to the interp's result. + * + * Results: + * 1 if the argument was a bad octal, else 0. + * + * Side effects: + * The interpreter's result is modified. + * + *---------------------------------------------------------------------- + */ + +int +TclCheckBadOctal( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If + * NULL, then no error message is left after + * errors. */ + const char *value) /* String to check. */ +{ + const char *p = value; + + /* + * A frequent mistake is invalid octal values due to an unwanted leading + * zero. Try to generate a meaningful error message. + */ + + while (TclIsSpaceProcM(*p)) { + p++; + } + if (*p == '+' || *p == '-') { + p++; + } + if (*p == '0') { + if ((p[1] == 'o') || p[1] == 'O') { + p += 2; + } + while (isdigit(UCHAR(*p))) { /* INTL: digit. */ + p++; + } + while (TclIsSpaceProcM(*p)) { + p++; + } + if (*p == '\0') { + /* + * Reached end of string. + */ + + if (interp != NULL) { + /* + * Don't reset the result here because we want this result to + * be added to an existing error message as extra info. + */ + + Tcl_AppendToObj(Tcl_GetObjResult(interp), + " (looks like invalid octal number)", -1); + } + return 1; + } + } + return 0; +} /* *---------------------------------------------------------------------- * * ClearHash -- @@ -3881,11 +4184,11 @@ Tcl_HashSearch search; Tcl_HashEntry *hPtr; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_Obj *objPtr = Tcl_GetHashValue(hPtr); + Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(objPtr); Tcl_DeleteHashEntry(hPtr); } } @@ -3911,14 +4214,14 @@ static Tcl_HashTable * GetThreadHash( Tcl_ThreadDataKey *keyPtr) { Tcl_HashTable **tablePtrPtr = - Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); + (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { - *tablePtrPtr = Tcl_Alloc(sizeof(Tcl_HashTable)); + *tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); } return *tablePtrPtr; } @@ -3939,15 +4242,15 @@ static void FreeThreadHash( ClientData clientData) { - Tcl_HashTable *tablePtr = clientData; + Tcl_HashTable *tablePtr = (Tcl_HashTable *)clientData; ClearHash(tablePtr); Tcl_DeleteHashTable(tablePtr); - Tcl_Free(tablePtr); + ckfree(tablePtr); } /* *---------------------------------------------------------------------- * @@ -3961,15 +4264,15 @@ static void FreeProcessGlobalValue( ClientData clientData) { - ProcessGlobalValue *pgvPtr = clientData; + ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *)clientData; pgvPtr->epoch++; pgvPtr->numBytes = 0; - Tcl_Free(pgvPtr->value); + ckfree(pgvPtr->value); pgvPtr->value = NULL; if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); pgvPtr->encoding = NULL; } @@ -4004,17 +4307,17 @@ * Fill the global string value. */ pgvPtr->epoch++; if (NULL != pgvPtr->value) { - Tcl_Free(pgvPtr->value); + ckfree(pgvPtr->value); } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } bytes = TclGetString(newValue); pgvPtr->numBytes = newValue->length; - pgvPtr->value = Tcl_Alloc(pgvPtr->numBytes + 1); + pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1); memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } pgvPtr->encoding = encoding; @@ -4026,11 +4329,11 @@ */ Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); - hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy); + hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_SetHashValue(hPtr, newValue); Tcl_MutexUnlock(&pgvPtr->mutex); } /* @@ -4052,11 +4355,11 @@ ProcessGlobalValue *pgvPtr) { Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - size_t epoch = pgvPtr->epoch; + unsigned int epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); if (pgvPtr->encoding != current) { @@ -4073,12 +4376,12 @@ Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value, pgvPtr->numBytes, &native); Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), Tcl_DStringLength(&native), &newValue); Tcl_DStringFree(&native); - Tcl_Free(pgvPtr->value); - pgvPtr->value = Tcl_Alloc(Tcl_DStringLength(&newValue) + 1); + ckfree(pgvPtr->value); + pgvPtr->value = (char *)ckalloc(Tcl_DStringLength(&newValue) + 1); memcpy(pgvPtr->value, Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); Tcl_FreeEncoding(pgvPtr->encoding); pgvPtr->encoding = current; @@ -4086,11 +4389,11 @@ } else { Tcl_FreeEncoding(current); } } cacheMap = GetThreadHash(&pgvPtr->key); - hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch)); + hPtr = Tcl_FindHashEntry(cacheMap, INT2PTR(epoch)); if (NULL == hPtr) { int dummy; /* * No cache for the current epoch - must be a new one. @@ -4119,16 +4422,16 @@ * Store a copy of the shared value in our epoch-indexed cache. */ value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, - (void *)(pgvPtr->epoch), &dummy); + INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); Tcl_SetHashValue(hPtr, value); Tcl_IncrRefCount(value); } - return Tcl_GetHashValue(hPtr); + return (Tcl_Obj *)Tcl_GetHashValue(hPtr); } /* *---------------------------------------------------------------------- * @@ -4214,10 +4517,35 @@ } /* *---------------------------------------------------------------------- * + * TclpGetTime -- + * + * Deprecated synonym for Tcl_GetTime. This function is provided for the + * benefit of extensions written before Tcl_GetTime was exported from the + * library. + * + * Results: + * None. + * + * Side effects: + * Stores current time in the buffer designated by "timePtr" + * + *---------------------------------------------------------------------- + */ + +void +TclpGetTime( + Tcl_Time *timePtr) +{ + Tcl_GetTime(timePtr); +} + +/* + *---------------------------------------------------------------------- + * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the * internal tclPlatform variable. * @@ -4258,11 +4586,11 @@ int TclReToGlob( Tcl_Interp *interp, const char *reStr, - size_t reStrLen, + int reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) { int anchorLeft, anchorRight, lastIsStar, numStars; Index: generic/tclVar.c ================================================================== --- generic/tclVar.c +++ generic/tclVar.c @@ -186,12 +186,11 @@ Tcl_Obj *arrayNameObj, Var *varPtr, ArraySearch *searchPtr); static void ArrayDoneSearch(Interp *iPtr, Var *varPtr, ArraySearch *searchPtr); static Tcl_NRPostProc ArrayForLoopCallback; -static int ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); +static Tcl_ObjCmdProc ArrayForNRCmd; static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags, int index); static int LocateArray(Tcl_Interp *interp, Tcl_Obj *name, Var **varPtrPtr, int *isArrayPtr); @@ -266,11 +265,11 @@ #define LocalGetIntRep(objPtr, index, name) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &localVarNameType); \ - (name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ + (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \ } while (0) static const Tcl_ObjType parsedVarNameType = { "parsedVarName", @@ -292,12 +291,12 @@ #define ParsedGetIntRep(objPtr, parsed, array, elem) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &parsedVarNameType); \ (parsed) = (irPtr != NULL); \ - (array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ - (elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ + (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) Var * TclVarHashCreateVar( TclVarHashTable *tablePtr, @@ -341,11 +340,11 @@ static int NotArrayError( Tcl_Interp *interp, Tcl_Obj *name) { - const char *nameStr = TclGetString(name); + const char *nameStr = Tcl_GetString(name); Tcl_SetObjResult(interp, Tcl_ObjPrintf("\"%s\" isn't an array", nameStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL); return TCL_ERROR; @@ -383,21 +382,21 @@ if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == (unsigned) !TclIsVarDeadHash(varPtr))) { if (VarHashRefCount(varPtr) == 0) { - Tcl_Free(varPtr); + ckfree(varPtr); } else { VarHashDeleteEntry(varPtr); } } if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) && TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) && (VarHashRefCount(arrayPtr) == (unsigned) !TclIsVarDeadHash(arrayPtr))) { if (VarHashRefCount(arrayPtr) == 0) { - Tcl_Free(arrayPtr); + ckfree(arrayPtr); } else { VarHashDeleteEntry(arrayPtr); } } } @@ -530,11 +529,11 @@ */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - register Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an + Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ const char *part2, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, @@ -603,11 +602,11 @@ * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; - register Var *varPtr; /* Points to the variable's in-frame Var + Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; int localIndex; @@ -663,11 +662,11 @@ if (!parsed) { /* * part1Ptr is possibly an unparsed array element. */ - size_t len; + int len; const char *part1 = TclGetStringFromObj(part1Ptr, &len); if ((len > 1) && (part1[len - 1] == ')')) { const char *part2 = strchr(part1, '('); @@ -845,12 +844,11 @@ Tcl_Var var; /* Used to search for global names. */ Var *varPtr; /* Points to the Var structure returned for * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int isNew, i, result; - size_t varLen; + int isNew, i, result, varLen; const char *varName = TclGetStringFromObj(varNamePtr, &varLen); varPtr = NULL; varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ *indexPtr = -3; @@ -919,12 +917,16 @@ if (lookGlobal) { *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { - flags = (flags | TCL_NAMESPACE_ONLY); - *indexPtr = -2; + if (flags & TCL_AVOID_RESOLVERS) { + flags = (flags | TCL_NAMESPACE_ONLY); + } + if (flags & TCL_NAMESPACE_ONLY) { + *indexPtr = -2; + } } /* * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or * otherwise generate our own error! @@ -976,14 +978,14 @@ int localCt = varFramePtr->numCompiledLocals; if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; - size_t localLen; + int localLen; for (i=0 ; ivarTablePtr; if (create) { if (tablePtr == NULL) { - tablePtr = Tcl_Alloc(sizeof(TclVarHashTable)); + tablePtr = (TclVarHashTable *)ckalloc(sizeof(TclVarHashTable)); TclInitVarHashTable(tablePtr, NULL); varFramePtr->varTablePtr = tablePtr; } varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew); } else { @@ -1143,10 +1145,55 @@ } /* *---------------------------------------------------------------------- * + * Tcl_GetVar -- + * + * Return the value of a Tcl variable as a string. + * + * Results: + * The return value points to the current value of varName as a string. + * If the variable is not defined or can't be read because of a clash in + * array usage then a NULL pointer is returned and an error message is + * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. + * Note: the return value is only valid up until the next change to the + * variable; if you depend on the value lasting longer than that, then + * make yourself a private copy. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_GetVar +const char * +Tcl_GetVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to + * be looked up. */ + const char *varName, /* Name of a variable in interp. */ + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, + * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG + * bits. */ +{ + Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); + Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); + + TclDecrRefCount(varNamePtr); + + if (resultPtr == NULL) { + return NULL; + } + return TclGetString(resultPtr); +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * Tcl_GetVar2 -- * * Return the value of a Tcl variable as a string, given a two-part name * consisting of array name and element within array. * @@ -1275,14 +1322,14 @@ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an + Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - register Tcl_Obj *part2Ptr, /* If non-null, points to an object holding + Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG bits. */ { @@ -1373,11 +1420,11 @@ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - register Var *varPtr, /* The variable to be read.*/ + Var *varPtr, /* The variable to be read.*/ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element @@ -1475,15 +1522,14 @@ * A variable's value may be changed. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_SetObjCmd( - ClientData dummy, /* Not used. */ - register Tcl_Interp *interp,/* Current interpreter. */ + TCL_UNUSED(ClientData), + Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValueObj; @@ -1506,10 +1552,57 @@ Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?"); return TCL_ERROR; } } +/* + *---------------------------------------------------------------------- + * + * Tcl_SetVar -- + * + * Change the value of a variable. + * + * Results: + * Returns a pointer to the malloc'ed string which is the character + * representation of the variable's new value. The caller must not modify + * this string. If the write operation was disallowed then NULL is + * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory + * message will be left in the interp's result. Note that the returned + * string may not be the same as newValue; this is because variable + * traces may modify the variable's value. + * + * Side effects: + * If varName is defined as a local or global variable in interp, its + * value is changed to newValue. If varName isn't currently defined, then + * a new global variable by that name is created. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_SetVar +const char * +Tcl_SetVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to + * be looked up. */ + const char *varName, /* Name of a variable in interp. */ + const char *newValue, /* New value for varName. */ + int flags) /* Various flags that tell how to set value: + * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, + * TCL_LEAVE_ERR_MSG. */ +{ + Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, varName, NULL, + Tcl_NewStringObj(newValue, -1), flags); + + if (varValuePtr == NULL) { + return NULL; + } + return TclGetString(varValuePtr); +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_SetVar2 -- * @@ -1656,14 +1749,14 @@ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ - register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an + Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - register Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding + Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, @@ -1896,11 +1989,11 @@ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - register Var *varPtr, /* Reference to the variable to set. */ + Var *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. NULL if the 'index' @@ -2216,11 +2309,11 @@ * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { - register Tcl_Obj *varValuePtr; + Tcl_Obj *varValuePtr; if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, @@ -2258,10 +2351,61 @@ return NULL; } } } +/* + *---------------------------------------------------------------------- + * + * Tcl_UnsetVar -- + * + * Delete a variable, so that it may not be accessed anymore. + * + * Results: + * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if + * the variable can't be unset. In the event of an error, if the + * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the + * interp's result. + * + * Side effects: + * If varName is defined as a local or global variable in interp, it is + * deleted. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_UnsetVar +int +Tcl_UnsetVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to + * be looked up. */ + const char *varName, /* Name of a variable in interp. May be either + * a scalar name or an array name or an + * element in an array. */ + int flags) /* OR-ed combination of any of + * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or + * TCL_LEAVE_ERR_MSG. */ +{ + int result; + Tcl_Obj *varNamePtr; + + varNamePtr = Tcl_NewStringObj(varName, -1); + Tcl_IncrRefCount(varNamePtr); + + /* + * Filter to pass through only the flags this interface supports. + */ + + flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); + result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags); + + Tcl_DecrRefCount(varNamePtr); + return result; +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_UnsetVar2 -- * @@ -2426,11 +2570,11 @@ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - register Var *varPtr, /* The variable to be unset. */ + Var *varPtr, /* The variable to be unset. */ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element @@ -2559,11 +2703,11 @@ */ int isNew; tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); - tracePtr = Tcl_GetHashValue(tPtr); + tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); varPtr->flags &= ~VAR_ALL_TRACES; Tcl_DeleteHashEntry(tPtr); if (dummyVar.flags & VAR_TRACED_UNSET) { tPtr = Tcl_CreateHashEntry(&iPtr->varTraces, &dummyVar, &isNew); @@ -2586,11 +2730,11 @@ tracePtr = NULL; if (TclIsVarTraced(&dummyVar)) { tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar); if (tPtr) { - tracePtr = Tcl_GetHashValue(tPtr); + tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); Tcl_DeleteHashEntry(tPtr); } } } @@ -2672,20 +2816,19 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_UnsetObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register int i, flags = TCL_LEAVE_ERR_MSG; - register const char *name; + int i, flags = TCL_LEAVE_ERR_MSG; + const char *name; if (objc == 1) { /* * Do nothing if no arguments supplied, so as to match command * documentation. @@ -2740,20 +2883,19 @@ * A variable's value may be changed. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_AppendObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; - register Tcl_Obj *varValuePtr = NULL; + Tcl_Obj *varValuePtr = NULL; /* Initialized to avoid compiler warning. */ int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); @@ -2806,14 +2948,13 @@ * A variable's value may be changed. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_LappendObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; @@ -3015,21 +3156,21 @@ return donerc; } static int ArrayForObjCmd( - ClientData dummy, /* Not used. */ + ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, ArrayForNRCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, ArrayForNRCmd, clientData, objc, objv); } static int ArrayForNRCmd( - ClientData dummy, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tcl_Obj *varListObj, *arrayNameObj, *scriptObj; @@ -3073,11 +3214,11 @@ /* * Make a new array search, put it on the stack. */ - searchPtr = Tcl_Alloc(sizeof(ArraySearch)); + searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch)); ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr); /* * Make sure that these objects (which we need throughout the body of the * loop) don't vanish. @@ -3101,14 +3242,14 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - ArraySearch *searchPtr = data[0]; - Tcl_Obj *varListObj = data[1]; - Tcl_Obj *arrayNameObj = data[2]; - Tcl_Obj *scriptObj = data[3]; + ArraySearch *searchPtr = (ArraySearch *)data[0]; + Tcl_Obj *varListObj = (Tcl_Obj *)data[1]; + Tcl_Obj *arrayNameObj = (Tcl_Obj *)data[2]; + Tcl_Obj *scriptObj = (Tcl_Obj *)data[3]; Tcl_Obj **varv; Tcl_Obj *keyObj, *valueObj; Var *varPtr; Var *arrayPtr; int done, varc; @@ -3194,11 +3335,11 @@ * VAR_SEARCH_ACTIVE flag will no longer be set. */ ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - Tcl_Free(searchPtr); + ckfree(searchPtr); } TclDecrRefCount(varListObj); TclDecrRefCount(scriptObj); return result; @@ -3224,11 +3365,11 @@ searchPtr->id = 1; varPtr->flags |= VAR_SEARCH_ACTIVE; searchPtr->nextPtr = NULL; } else { searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; - searchPtr->nextPtr = Tcl_GetHashValue(hPtr); + searchPtr->nextPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); } searchPtr->varPtr = varPtr; searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, &searchPtr->search); Tcl_SetHashValue(hPtr, searchPtr); @@ -3252,15 +3393,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ - static int ArrayStartSearchCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; @@ -3282,11 +3421,11 @@ /* * Make a new array search with a free name. */ - searchPtr = Tcl_Alloc(sizeof(ArraySearch)); + searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch)); ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr); Tcl_SetObjResult(interp, searchPtr->name); return TCL_OK; } @@ -3323,11 +3462,11 @@ } else { varPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(hPtr); } } else { - for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) { + for (prevPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); ; prevPtr=prevPtr->nextPtr) { if (prevPtr->nextPtr == searchPtr) { prevPtr->nextPtr = searchPtr->nextPtr; break; } } @@ -3349,14 +3488,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayAnyMoreCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; @@ -3428,14 +3566,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayNextElementCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; @@ -3509,14 +3646,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayDoneSearchCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; @@ -3549,11 +3685,11 @@ return TCL_ERROR; } ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - Tcl_Free(searchPtr); + ckfree(searchPtr); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -3570,14 +3706,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayExistsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *)interp; @@ -3611,14 +3746,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayGetCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr, *varPtr2; @@ -3771,14 +3905,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayNamesCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static const char *const options[] = { @@ -3939,14 +4072,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArraySetCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *arrayNameObj; @@ -4115,14 +4247,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArraySizeCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; @@ -4175,14 +4306,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayStatsCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr; @@ -4209,11 +4339,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "error reading array statistics", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); - Tcl_Free(stats); + ckfree(stats); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -4230,14 +4360,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayUnsetCmd( - ClientData clientData, + TCL_UNUSED(ClientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Var *varPtr, *varPtr2, *protectedVarPtr; @@ -4367,11 +4496,10 @@ * Creates a command in the global namespace. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ Tcl_Command TclInitArrayCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap arrayImplMap[] = { @@ -4669,10 +4797,67 @@ } /* *---------------------------------------------------------------------- * + * Tcl_UpVar -- + * + * This function links one variable to another, just like the "upvar" + * command. + * + * Results: + * A standard Tcl completion code. If an error occurs then an error + * message is left in the interp's result. + * + * Side effects: + * The variable in frameName whose name is given by varName becomes + * accessible under the name localNameStr, so that references to + * localNameStr are redirected to the other variable like a symbolic + * link. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef Tcl_UpVar +int +Tcl_UpVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to + * be looked up. */ + const char *frameName, /* Name of the frame containing the source + * variable, such as "1" or "#0". */ + const char *varName, /* Name of a variable in interp to link to. + * May be either a scalar name or an element + * in an array. */ + const char *localNameStr, /* Name of link variable. */ + int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + * indicates scope of localNameStr. */ +{ + int result; + CallFrame *framePtr; + Tcl_Obj *varNamePtr, *localNamePtr; + + if (TclGetFrame(interp, frameName, &framePtr) == -1) { + return TCL_ERROR; + } + + varNamePtr = Tcl_NewStringObj(varName, -1); + Tcl_IncrRefCount(varNamePtr); + localNamePtr = Tcl_NewStringObj(localNameStr, -1); + Tcl_IncrRefCount(localNamePtr); + + result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0, + localNamePtr, flags, -1); + Tcl_DecrRefCount(varNamePtr); + Tcl_DecrRefCount(localNamePtr); + return result; +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * Tcl_UpVar2 -- * * This function links one variable to another, just like the "upvar" * command. * @@ -4748,11 +4933,11 @@ * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; - register Var *varPtr = (Var *) variable; + Var *varPtr = (Var *) variable; Tcl_Obj *namePtr; Namespace *nsPtr; if (!varPtr || TclIsVarArrayElement(varPtr)) { return; @@ -4802,19 +4987,19 @@ *---------------------------------------------------------------------- */ int Tcl_GlobalObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - register Tcl_Obj *objPtr, *tailPtr; + Tcl_Obj *objPtr, *tailPtr; const char *varName; - register const char *tail; + const char *tail; int result, i; /* * If we are not executing inside a Tcl procedure, just return. */ @@ -4906,11 +5091,11 @@ *---------------------------------------------------------------------- */ int Tcl_VariableObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -5037,14 +5222,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_UpvarObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { CallFrame *framePtr; @@ -5154,18 +5338,18 @@ if (varPtr->flags & VAR_SEARCH_ACTIVE) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr); /* First look for same (Tcl_Obj *) */ - for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL; + for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL; searchPtr = searchPtr->nextPtr) { if (searchPtr->name == handleObj) { return searchPtr; } } /* Fallback: do string compares. */ - for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL; + for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL; searchPtr = searchPtr->nextPtr) { if (strcmp(TclGetString(searchPtr->name), handle) == 0) { return searchPtr; } } @@ -5205,23 +5389,23 @@ */ static void DeleteSearches( Interp *iPtr, - register Var *arrayVarPtr) /* Variable whose searches are to be + Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; Tcl_HashEntry *sPtr; if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) { sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr); - for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL; + for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL; searchPtr = nextPtr) { nextPtr = searchPtr->nextPtr; Tcl_DecrRefCount(searchPtr->name); - Tcl_Free(searchPtr); + ckfree(searchPtr); } arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(sPtr); } } @@ -5283,11 +5467,11 @@ * First we destroy all traces. ... */ if (TclIsVarTraced(varPtr)) { Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); - VarTrace *tracePtr = Tcl_GetHashValue(tPtr); + VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); ActiveVarTrace *activePtr; while (tracePtr) { VarTrace *prevPtr = tracePtr; @@ -5347,11 +5531,11 @@ TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; - register Var *varPtr; + Var *varPtr; int flags; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback functions. @@ -5399,11 +5583,11 @@ TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { - register Var *varPtr; + Var *varPtr; int numLocals, i; Tcl_Obj **namePtrPtr; numLocals = framePtr->numCompiledLocals; varPtr = framePtr->compiledLocals; @@ -5448,11 +5632,11 @@ * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */ int index) { Tcl_HashSearch search; Tcl_HashEntry *tPtr; - register Var *elPtr; + Var *elPtr; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; VarTrace *tracePtr; for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search); @@ -5480,11 +5664,11 @@ elPtr->flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr, elNamePtr, flags,/* leaveErrMsg */ 0, index); } tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr); - tracePtr = Tcl_GetHashValue(tPtr); + tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); while (tracePtr) { VarTrace *prevPtr = tracePtr; tracePtr = tracePtr->nextPtr; prevPtr->nextPtr = NULL; @@ -5637,11 +5821,11 @@ static void FreeParsedVarName( Tcl_Obj *objPtr) { - register Tcl_Obj *arrayPtr, *elem; + Tcl_Obj *arrayPtr, *elem; int parsed; ParsedGetIntRep(objPtr, parsed, arrayPtr, elem); parsed++; /* Silence compiler. */ @@ -5654,11 +5838,11 @@ static void DupParsedVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - register Tcl_Obj *arrayPtr, *elem; + Tcl_Obj *arrayPtr, *elem; int parsed; ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem); parsed++; /* Silence compiler. */ @@ -5743,11 +5927,11 @@ Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; - register int search; + int search; int result; Tcl_Var var; Tcl_Obj *simpleNamePtr; const char *name = TclGetString(namePtr); @@ -5793,14 +5977,10 @@ /* * Find the namespace(s) that contain the variable. */ - if (!(flags & TCL_GLOBAL_ONLY)) { - flags |= TCL_NAMESPACE_ONLY; - } - TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the variable in the variable table of its namespace. Be sure @@ -5855,11 +6035,11 @@ *---------------------------------------------------------------------- */ int TclInfoVarsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -6046,11 +6226,11 @@ *---------------------------------------------------------------------- */ int TclInfoGlobalsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *varName, *pattern; @@ -6139,11 +6319,11 @@ *---------------------------------------------------------------------- */ int TclInfoLocalsCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -6290,11 +6470,11 @@ return; } if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) { Method *mPtr = (Method *) - Tcl_ObjectContextMethod(iPtr->varFramePtr->clientData); + Tcl_ObjectContextMethod((Tcl_ObjectContext)iPtr->varFramePtr->clientData); PrivateVariableMapping *privatePtr; if (mPtr->declaringObjectPtr) { Object *oPtr = mPtr->declaringObjectPtr; @@ -6354,18 +6534,18 @@ tablePtr->nsPtr = nsPtr; } static Tcl_HashEntry * AllocVarEntry( - Tcl_HashTable *tablePtr, /* Hash table. */ + TCL_UNUSED(Tcl_HashTable *), void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; Tcl_HashEntry *hPtr; Var *varPtr; - varPtr = Tcl_Alloc(sizeof(VarInHash)); + varPtr = (Var *)ckalloc(sizeof(VarInHash)); varPtr->flags = VAR_IN_HASHTABLE; varPtr->value.objPtr = NULL; VarHashRefCount(varPtr) = 1; hPtr = &(((VarInHash *) varPtr)->entry); @@ -6383,11 +6563,11 @@ Var *varPtr = VarHashGetValue(hPtr); Tcl_Obj *objPtr = hPtr->key.objPtr; if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == 1)) { - Tcl_Free(varPtr); + ckfree(varPtr); } else { VarHashInvalidateEntry(varPtr); TclSetVarUndefined(varPtr); VarHashRefCount(varPtr)--; } @@ -6394,17 +6574,17 @@ Tcl_DecrRefCount(objPtr); } static int CompareVarKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; - register const char *p1, *p2; - register size_t l1, l2; + const char *p1, *p2; + int l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller * @@ -6442,14 +6622,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int ArrayDefaultCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { @@ -6591,11 +6770,11 @@ void TclInitArrayVar( Var *arrayPtr) { - ArrayVarHashTable *tablePtr = Tcl_Alloc(sizeof(ArrayVarHashTable)); + ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)ckalloc(sizeof(ArrayVarHashTable)); /* * Mark the variable as an array. */ @@ -6635,11 +6814,11 @@ /* * Regular TclVarHashTable cleanup. */ VarHashDeleteTable(arrayPtr->value.tablePtr); - Tcl_Free(tablePtr); + ckfree(tablePtr); } /* * Get array default value if any. */ Index: generic/tclZipfs.c ================================================================== --- generic/tclZipfs.c +++ generic/tclZipfs.c @@ -275,17 +275,19 @@ int idCount; /* Counter for channel names */ Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ } ZipFS = { 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, 0, + {0,{0,0,0,0},0,0,0,0,0,0,0,0,0}, + {0,{0,0,0,0},0,0,0,0,0,0,0,0,0} }; /* * For password rotation. */ -static const char pwrot[16] = +static const char pwrot[17] = "\x00\x80\x40\xC0\x20\xA0\x60\xE0" "\x10\x90\x50\xD0\x30\xB0\x70\xF0"; /* * Table to compute CRC32. @@ -381,29 +383,30 @@ Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); static void ZipfsExitHandler(ClientData clientData); static void ZipfsSetup(void); static int ZipChannelClose(void *instanceData, - Tcl_Interp *interp); -static int ZipChannelGetFile(void *instanceData, - int direction, void **handlePtr); + Tcl_Interp *interp, int flags); +static Tcl_DriverGetHandleProc ZipChannelGetFile; static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); +#ifndef TCL_NO_DEPRECATED static int ZipChannelSeek(void *instanceData, long offset, int mode, int *errloc); +#endif +static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset, + int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); /* * Define the ZIP filesystem dispatch table. */ -MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; - -const Tcl_Filesystem zipfsFilesystem = { +static const Tcl_Filesystem zipfsFilesystem = { "zipfs", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_2, ZipFSPathInFilesystemProc, NULL, /* dupInternalRepProc */ @@ -428,11 +431,11 @@ NULL, /* deleteFileProc */ NULL, /* copyFileProc */ NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ - (Tcl_FSLoadFileProc *) ZipFSLoadFile, + (Tcl_FSLoadFileProc *)(void *)ZipFSLoadFile, NULL, /* getCwdProc */ NULL, /* chdirProc */ }; /* @@ -440,26 +443,36 @@ */ static Tcl_ChannelType ZipChannelType = { "zip", /* Type name. */ TCL_CHANNEL_VERSION_5, - ZipChannelClose, /* Close channel, clean instance data */ + TCL_CLOSE2PROC, /* Close channel, clean instance data */ ZipChannelRead, /* Handle read request */ ZipChannelWrite, /* Handle write request */ +#ifndef TCL_NO_DEPRECATED ZipChannelSeek, /* Move location of access point, NULL'able */ +#else + NULL, /* Move location of access point, NULL'able */ +#endif NULL, /* Set options, NULL'able */ NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ ZipChannelGetFile, /* Get OS handle from the channel */ - NULL, /* 2nd version of close channel, NULL'able */ + ZipChannelClose, /* 2nd version of close channel, NULL'able */ NULL, /* Set blocking mode for raw channel, NULL'able */ NULL, /* Function to flush channel, NULL'able */ NULL, /* Function to handle event, NULL'able */ - NULL, /* Wide seek function, NULL'able */ + ZipChannelWideSeek, /* Wide seek function, NULL'able */ NULL, /* Thread action function, NULL'able */ NULL, /* Truncate function, NULL'able */ }; + +/* + * Miscellaneous constants. + */ + +#define ERROR_LENGTH ((size_t) -1) /* *------------------------------------------------------------------------- * * ReadLock, WriteLock, Unlock -- @@ -837,11 +850,11 @@ Tcl_HashEntry *hPtr; ZipEntry *z = NULL; hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename); if (hPtr) { - z = Tcl_GetHashValue(hPtr); + z = (ZipEntry *)Tcl_GetHashValue(hPtr); } return z; } /* @@ -902,16 +915,16 @@ ZipFSCloseArchive( Tcl_Interp *interp, /* Current interpreter. */ ZipFile *zf) { if (zf->nameLength) { - Tcl_Free(zf->name); + ckfree(zf->name); } if (zf->isMemBuffer) { /* Pointer to memory */ if (zf->ptrToFree) { - Tcl_Free(zf->ptrToFree); + ckfree(zf->ptrToFree); zf->ptrToFree = NULL; } zf->data = NULL; return; } @@ -925,16 +938,16 @@ CloseHandle(zf->mountHandle); } #else /* !_WIN32 */ if ((zf->data != MAP_FAILED) && !zf->ptrToFree) { munmap(zf->data, zf->length); - zf->data = MAP_FAILED; + zf->data = (unsigned char *)MAP_FAILED; } #endif /* _WIN32 */ if (zf->ptrToFree) { - Tcl_Free(zf->ptrToFree); + ckfree(zf->ptrToFree); zf->ptrToFree = NULL; } if (zf->chan) { Tcl_Close(interp, zf->chan); zf->chan = NULL; @@ -1095,11 +1108,11 @@ zf->isMemBuffer = 0; #ifdef _WIN32 zf->data = NULL; zf->mountHandle = INVALID_HANDLE_VALUE; #else /* !_WIN32 */ - zf->data = MAP_FAILED; + zf->data = (unsigned char *)MAP_FAILED; #endif /* _WIN32 */ zf->length = 0; zf->numFiles = 0; zf->baseOffset = zf->passOffset = 0; zf->ptrToFree = NULL; @@ -1108,11 +1121,11 @@ if (!zf->chan) { return TCL_ERROR; } if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if (zf->length == TCL_IO_FAILURE) { + if (zf->length == ERROR_LENGTH) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } if ((zf->length - ZIP_CENTRAL_END_LEN) > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { @@ -1124,11 +1137,11 @@ } if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - zf->ptrToFree = zf->data = Tcl_AttemptAlloc(zf->length); + zf->ptrToFree = zf->data = (unsigned char *)attemptckalloc(zf->length); if (!zf->ptrToFree) { ZIPFS_ERROR(interp, "out of memory"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } @@ -1153,25 +1166,25 @@ # endif /* _WIN64 */ if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); goto error; } - zf->mountHandle = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, + zf->mountHandle = CreateFileMappingW((HANDLE) handle, 0, PAGE_READONLY, 0, zf->length, 0); if (zf->mountHandle == INVALID_HANDLE_VALUE) { ZIPFS_POSIX_ERROR(interp, "file mapping failed"); goto error; } - zf->data = MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0, + zf->data = (unsigned char *)MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0, zf->length); if (!zf->data) { ZIPFS_POSIX_ERROR(interp, "file mapping failed"); goto error; } #else /* !_WIN32 */ zf->length = lseek(PTR2INT(handle), 0, SEEK_END); - if (zf->length == TCL_IO_FAILURE || zf->length < ZIP_CENTRAL_END_LEN) { + if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); goto error; } lseek(PTR2INT(handle), 0, SEEK_SET); zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, @@ -1255,20 +1268,20 @@ mountPoint = CanonicalPath("", mountPoint, &dsm, 1); } hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew); if (!isNew) { if (interp) { - zf = Tcl_GetHashValue(hPtr); + zf = (ZipFile *)Tcl_GetHashValue(hPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s is already mounted on %s", zf->name, mountPoint)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL); } Unlock(); ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } - zf = Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } @@ -1277,15 +1290,15 @@ return TCL_ERROR; } Unlock(); *zf = *zf0; - zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); - Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)zf); + zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + Tcl_CreateExitHandler(ZipfsExitHandler, zf); zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); - zf->name = Tcl_Alloc(zf->nameLength + 1); + zf->name = (char *)ckalloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); zf->entries = NULL; zf->topEnts = NULL; zf->numOpen = 0; Tcl_SetHashValue(hPtr, zf); @@ -1300,11 +1313,11 @@ zf->passBuf[k] = '\0'; } if (mountPoint[0] != '\0') { hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew); if (isNew) { - z = Tcl_Alloc(sizeof(ZipEntry)); + z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); Tcl_SetHashValue(hPtr, z); z->tnext = NULL; z->depth = CountSlashes(mountPoint); z->zipFilePtr = zf; @@ -1314,11 +1327,11 @@ z->crc32 = 0; z->timestamp = 0; z->numBytes = z->numCompressedBytes = 0; z->compressMethod = ZIP_COMPMETH_STORED; z->data = NULL; - z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr); z->next = zf->entries; zf->entries = z; } } q = zf->data + zf->directoryOffset; @@ -1395,11 +1408,11 @@ goto nextent; #endif /* ANDROID */ } Tcl_DStringSetLength(&fpBuf, 0); fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1); - z = Tcl_Alloc(sizeof(ZipEntry)); + z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); z->name = NULL; z->tnext = NULL; z->depth = CountSlashes(fullpath); z->zipFilePtr = zf; z->isDirectory = isdir; @@ -1424,14 +1437,14 @@ z->numCompressedBytes = nbcompr; z->data = NULL; hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); if (!isNew) { /* should not happen but skip it anyway */ - Tcl_Free(z); + ckfree(z); } else { Tcl_SetHashValue(hPtr, z); - z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr); z->next = zf->entries; zf->entries = z; if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) { z->tnext = zf->topEnts; zf->topEnts = z; @@ -1449,11 +1462,11 @@ Tcl_DStringSetLength(&ds, end - dir); hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); if (!isNew) { break; } - zd = Tcl_Alloc(sizeof(ZipEntry)); + zd = (ZipEntry *)ckalloc(sizeof(ZipEntry)); zd->name = NULL; zd->tnext = NULL; zd->depth = CountSlashes(dir); zd->zipFilePtr = zf; zd->isDirectory = 1; @@ -1463,11 +1476,11 @@ zd->timestamp = z->timestamp; zd->numBytes = zd->numCompressedBytes = 0; zd->compressMethod = ZIP_COMPMETH_STORED; zd->data = NULL; Tcl_SetHashValue(hPtr, zd); - zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + zd->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr); zd->next = zf->entries; zf->entries = zd; if ((mountPoint[0] == '\0') && (zd->depth == 1)) { zd->tnext = zf->topEnts; zf->topEnts = zd; @@ -1549,11 +1562,11 @@ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { if (!interp) { return TCL_OK; } - zf = Tcl_GetHashValue(hPtr); + zf = (ZipFile *)Tcl_GetHashValue(hPtr); Tcl_AppendElement(interp, zf->mountPoint); Tcl_AppendElement(interp, zf->name); } return (interp ? TCL_OK : TCL_BREAK); } @@ -1586,11 +1599,11 @@ ZipFile *zf; if (interp) { hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint); if (hPtr) { - zf = Tcl_GetHashValue(hPtr); + zf = (ZipFile *)Tcl_GetHashValue(hPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1)); return TCL_OK; } } return (interp ? TCL_OK : TCL_BREAK); @@ -1663,28 +1676,28 @@ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL); } return TCL_ERROR; } } - zf = Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } return TCL_ERROR; } if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) { - Tcl_Free(zf); + ckfree(zf); return TCL_ERROR; } if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname) != TCL_OK) { - Tcl_Free(zf); + ckfree(zf); return TCL_ERROR; } - Tcl_Free(zf); + ckfree(zf); return TCL_OK; } /* *------------------------------------------------------------------------- @@ -1744,11 +1757,11 @@ /* * Have both a mount point and data to mount there. */ - zf = Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } @@ -1755,11 +1768,11 @@ return TCL_ERROR; } zf->isMemBuffer = 1; zf->length = datalen; if (copy) { - zf->data = Tcl_AttemptAlloc(datalen); + zf->data = (unsigned char *)attemptckalloc(datalen); if (!zf->data) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } @@ -1775,11 +1788,11 @@ if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) { return TCL_ERROR; } result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL, "Memory Buffer"); - Tcl_Free(zf); + ckfree(zf); return result; } /* *------------------------------------------------------------------------- @@ -1825,11 +1838,11 @@ /* don't report no-such-mount as an error */ if (!hPtr) { goto done; } - zf = Tcl_GetHashValue(hPtr); + zf = (ZipFile *)Tcl_GetHashValue(hPtr); if (zf->numOpen > 0) { ZIPFS_ERROR(interp, "filesystem is busy"); ret = TCL_ERROR; goto done; } @@ -1839,17 +1852,17 @@ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } if (z->data) { - Tcl_Free(z->data); + ckfree(z->data); } - Tcl_Free(z); + ckfree(z); } ZipFSCloseArchive(interp, zf); - Tcl_DeleteExitHandler(ZipfsExitHandler, (ClientData)zf); - Tcl_Free(zf); + Tcl_DeleteExitHandler(ZipfsExitHandler, zf); + ckfree(zf); unmounted = 1; done: Unlock(); if (unmounted) { Tcl_FSMountsChanged(NULL); @@ -1873,24 +1886,25 @@ *------------------------------------------------------------------------- */ static int ZipFSMountObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?zipfile? ?password?"); return TCL_ERROR; } - return TclZipfs_Mount(interp, (objc > 1) ? TclGetString(objv[1]) : NULL, - (objc > 2) ? TclGetString(objv[2]) : NULL, - (objc > 3) ? TclGetString(objv[3]) : NULL); + return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, + (objc > 2) ? Tcl_GetString(objv[2]) : NULL, + (objc > 3) ? Tcl_GetString(objv[3]) : NULL); } /* *------------------------------------------------------------------------- * @@ -1907,18 +1921,18 @@ *------------------------------------------------------------------------- */ static int ZipFSMountBufferObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *mountPoint; /* Mount point path. */ unsigned char *data; - size_t length = 0; + int length; if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); return TCL_ERROR; } @@ -1929,19 +1943,22 @@ ret = ListMountPoints(interp); Unlock(); return ret; } - mountPoint = TclGetString(objv[1]); + mountPoint = Tcl_GetString(objv[1]); if (objc < 3) { ReadLock(); DescribeMounted(interp, mountPoint); Unlock(); return TCL_OK; } - data = TclGetByteArrayFromObj(objv[2], &length); + data = TclGetBytesFromObj(interp, objv[2], &length); + if (data == NULL) { + return TCL_ERROR; + } return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1); } /* *------------------------------------------------------------------------- @@ -1959,14 +1976,14 @@ *------------------------------------------------------------------------- */ static int ZipFSRootObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *)) /*objv*/ { Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1)); return TCL_OK; } @@ -1986,20 +2003,21 @@ *------------------------------------------------------------------------- */ static int ZipFSUnmountObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); return TCL_ERROR; } - return TclZipfs_Unmount(interp, TclGetString(objv[1])); + return TclZipfs_Unmount(interp, Tcl_GetString(objv[1])); } /* *------------------------------------------------------------------------- * @@ -2017,11 +2035,11 @@ *------------------------------------------------------------------------- */ static int ZipFSMkKeyObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int len, i = 0; @@ -2029,11 +2047,11 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "password"); return TCL_ERROR; } - pw = TclGetString(objv[1]); + pw = Tcl_GetString(objv[1]); len = strlen(pw); if (len == 0) { return TCL_OK; } if ((len > 255) || strchr(pw, 0xff)) { @@ -2146,11 +2164,11 @@ Tcl_ResetResult(interp); crc = 0; nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == TCL_IO_FAILURE) { + if (len == ERROR_LENGTH) { if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s", @@ -2172,11 +2190,11 @@ } pos[0] = Tcl_Tell(out); memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if (Tcl_Write(out, buf, len) != len) { + if ((size_t) Tcl_Write(out, buf, len) != len) { wrerr: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on %s: %s", path, Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; @@ -2191,11 +2209,11 @@ align = 4 + ((len + pos[0]) & 3); ZipWriteShort(abuf, 0xffff); ZipWriteShort(abuf + 2, align - 4); ZipWriteInt(abuf + 4, 0x03020100); - if (Tcl_Write(out, (const char *) abuf, align) != align) { + if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { goto wrerr; } } if (passwd) { int i, ch, tmp; @@ -2224,20 +2242,19 @@ Tcl_AppendObjToErrorInfo(interp, eiPtr); Tcl_Close(interp, in); return TCL_ERROR; } ch = (int) (r * 256); - kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); + kvbuf[i + 12] = UCHAR(zencode(keys, crc32tab, ch, tmp)); } Tcl_ResetResult(interp); init_keys(passwd, keys, crc32tab); for (i = 0; i < 12 - 2; i++) { - kvbuf[i] = (unsigned char) - zencode(keys, crc32tab, kvbuf[i + 12], tmp); + kvbuf[i] = UCHAR(zencode(keys, crc32tab, kvbuf[i + 12], tmp)); } - kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); - kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); + kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 16, tmp)); + kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 24, tmp)); len = Tcl_Write(out, (char *) kvbuf, 12); memset(kvbuf, 0, 24); if (len != 12) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on %s: %s", path, Tcl_PosixError(interp))); @@ -2262,11 +2279,11 @@ Tcl_Close(interp, in); return TCL_ERROR; } do { len = Tcl_Read(in, buf, bufsize); - if (len == TCL_IO_FAILURE) { + if (len == ERROR_LENGTH) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read error on %s: %s", path, Tcl_PosixError(interp))); deflateEnd(&stream); Tcl_Close(interp, in); return TCL_ERROR; @@ -2293,11 +2310,11 @@ for (i = 0; i < olen; i++) { obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } } - if (olen && (Tcl_Write(out, obuf, olen) != olen)) { + if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); deflateEnd(&stream); Tcl_Close(interp, in); return TCL_ERROR; @@ -2323,11 +2340,11 @@ return TCL_ERROR; } nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == TCL_IO_FAILURE) { + if (len == ERROR_LENGTH) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read error on \"%s\": %s", path, Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; @@ -2340,11 +2357,11 @@ for (i = 0; i < len; i++) { buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } - if (Tcl_Write(out, buf, len) != len) { + if ((size_t) Tcl_Write(out, buf, len) != len) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; } @@ -2363,11 +2380,11 @@ "non-unique path name \"%s\"", path)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL); return TCL_ERROR; } - z = Tcl_Alloc(sizeof(ZipEntry)); + z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); Tcl_SetHashValue(hPtr, z); z->name = NULL; z->tnext = NULL; z->depth = 0; z->zipFilePtr = NULL; @@ -2378,11 +2395,11 @@ z->timestamp = mtime; z->numBytes = nbyte; z->numCompressedBytes = nbytecompr; z->compressMethod = compMeth; z->data = NULL; - z->name = Tcl_GetHashKey(fileHash, hPtr); + z->name = (char *)Tcl_GetHashKey(fileHash, hPtr); z->next = NULL; /* * Write final local header information. */ @@ -2397,26 +2414,26 @@ ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes); ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen); ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { Tcl_DeleteHashEntry(hPtr); - Tcl_Free(z); + ckfree(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { Tcl_DeleteHashEntry(hPtr); - Tcl_Free(z); + ckfree(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_Flush(out); if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { Tcl_DeleteHashEntry(hPtr); - Tcl_Free(z); + ckfree(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; @@ -2464,11 +2481,11 @@ * Caller has verified that the number of arguments is correct. */ passBuf[0] = 0; if (objc > (isList ? 3 : 4)) { - pw = TclGetString(objv[isList ? 3 : 4]); + pw = Tcl_GetString(objv[isList ? 3 : 4]); pwlen = strlen(pw); if ((pwlen > 255) || strchr(pw, 0xff)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL); @@ -2508,11 +2525,11 @@ Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL); return TCL_ERROR; } - out = Tcl_OpenFileChannel(interp, TclGetString(objv[1]), "wb", 0755); + out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "wb", 0755); if (out == NULL) { Tcl_DecrRefCount(list); return TCL_ERROR; } if (pwlen <= 0) { @@ -2523,14 +2540,14 @@ ZipFile *zf, zf0; int isMounted = 0; const char *imgName; if (isList) { - imgName = (objc > 4) ? TclGetString(objv[4]) : + imgName = (objc > 4) ? Tcl_GetString(objv[4]) : Tcl_GetNameOfExecutable(); } else { - imgName = (objc > 5) ? TclGetString(objv[5]) : + imgName = (objc > 5) ? Tcl_GetString(objv[5]) : Tcl_GetNameOfExecutable(); } if (pwlen) { i = 0; for (len = pwlen; len-- > 0;) { @@ -2553,11 +2570,11 @@ */ WriteLock(); for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - zf = Tcl_GetHashValue(hPtr); + zf = (ZipFile *)Tcl_GetHashValue(hPtr); if (strcmp(zf->name, imgName) == 0) { isMounted = 1; zf->numOpen++; break; } @@ -2565,11 +2582,11 @@ Unlock(); if (!isMounted) { zf = &zf0; } if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) { - if (Tcl_Write(out, (char *) zf->data, + if ((size_t) Tcl_Write(out, (char *) zf->data, zf->passOffset) != zf->passOffset) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); @@ -2608,11 +2625,11 @@ Tcl_DecrRefCount(list); Tcl_Close(interp, out); return TCL_ERROR; } i = Tcl_Seek(in, 0, SEEK_END); - if (i == TCL_IO_FAILURE) { + if (i == ERROR_LENGTH) { cperr: memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s: %s", errMsg, Tcl_PosixError(interp))); @@ -2656,19 +2673,19 @@ Tcl_Flush(out); } Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); pos[0] = Tcl_Tell(out); if (!isList && (objc > 3)) { - strip = TclGetString(objv[3]); + strip = Tcl_GetString(objv[3]); slen = strlen(strip); } for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) { const char *path, *name; - path = TclGetString(lobjv[i]); + path = Tcl_GetString(lobjv[i]); if (isList) { - name = TclGetString(lobjv[i + 1]); + name = Tcl_GetString(lobjv[i + 1]); } else { name = path; if (slen > 0) { len = strlen(name); if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { @@ -2691,13 +2708,13 @@ pos[1] = Tcl_Tell(out); count = 0; for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) { const char *path, *name; - path = TclGetString(lobjv[i]); + path = Tcl_GetString(lobjv[i]); if (isList) { - name = TclGetString(lobjv[i + 1]); + name = Tcl_GetString(lobjv[i + 1]); } else { name = path; if (slen > 0) { len = strlen(name); if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { @@ -2714,11 +2731,11 @@ } hPtr = Tcl_FindHashEntry(&fileHash, name); if (!hPtr) { continue; } - z = Tcl_GetHashValue(hPtr); + z = (ZipEntry *)Tcl_GetHashValue(hPtr); len = strlen(z->name); ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted); @@ -2735,11 +2752,11 @@ ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0); ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0); ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) - || (Tcl_Write(out, z->name, len) != len)) { + || ((size_t) Tcl_Write(out, z->name, len) != len)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); goto done; } count++; @@ -2769,12 +2786,12 @@ Tcl_Close(interp, out); } Tcl_DecrRefCount(list); for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - z = Tcl_GetHashValue(hPtr); - Tcl_Free(z); + z = (ZipEntry *)Tcl_GetHashValue(hPtr); + ckfree(z); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&fileHash); return ret; } @@ -2796,11 +2813,11 @@ *------------------------------------------------------------------------- */ static int ZipFSMkZipObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc < 3 || objc > 5) { @@ -2816,11 +2833,11 @@ return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv); } static int ZipFSLMkZipObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc < 3 || objc > 4) { @@ -2853,11 +2870,11 @@ *------------------------------------------------------------------------- */ static int ZipFSMkImgObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc < 3 || objc > 6) { @@ -2874,11 +2891,11 @@ return ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv); } static int ZipFSLMkImgObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc < 3 || objc > 5) { @@ -2911,11 +2928,11 @@ *------------------------------------------------------------------------- */ static int ZipFSCanonicalObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { char *mntpoint = NULL; @@ -2927,24 +2944,24 @@ Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?"); return TCL_ERROR; } Tcl_DStringInit(&dPath); if (objc == 2) { - filename = TclGetString(objv[1]); + filename = Tcl_GetString(objv[1]); result = CanonicalPath("", filename, &dPath, 1); } else if (objc == 3) { - mntpoint = TclGetString(objv[1]); - filename = TclGetString(objv[2]); + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); result = CanonicalPath(mntpoint, filename, &dPath, 1); } else { int zipfs = 0; if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) { return TCL_ERROR; } - mntpoint = TclGetString(objv[1]); - filename = TclGetString(objv[2]); + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); result = CanonicalPath(mntpoint, filename, &dPath, zipfs); } Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); return TCL_OK; } @@ -2967,11 +2984,11 @@ *------------------------------------------------------------------------- */ static int ZipFSExistsObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { char *filename; @@ -2985,11 +3002,11 @@ /* * Prepend ZIPFS_VOLUME to filename, eliding the final / */ - filename = TclGetString(objv[1]); + filename = Tcl_GetString(objv[1]); Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1); Tcl_DStringAppend(&ds, filename, -1); filename = Tcl_DStringValue(&ds); @@ -3020,11 +3037,11 @@ *------------------------------------------------------------------------- */ static int ZipFSInfoObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { char *filename; @@ -3032,11 +3049,11 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "filename"); return TCL_ERROR; } - filename = TclGetString(objv[1]); + filename = Tcl_GetString(objv[1]); ReadLock(); z = ZipFSLookup(filename); if (z) { Tcl_Obj *result = Tcl_GetObjResult(interp); @@ -3070,11 +3087,11 @@ *------------------------------------------------------------------------- */ static int ZipFSListObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { char *pattern = NULL; @@ -3086,17 +3103,17 @@ if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); return TCL_ERROR; } if (objc == 3) { - size_t n; - char *what = TclGetStringFromObj(objv[1], &n); + int n; + char *what = Tcl_GetStringFromObj(objv[1], &n); if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { - pattern = TclGetString(objv[2]); + pattern = Tcl_GetString(objv[2]); } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { - regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2])); + regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); if (!regexp) { return TCL_ERROR; } } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3103,37 +3120,37 @@ "unknown option \"%s\"", what)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL); return TCL_ERROR; } } else if (objc == 2) { - pattern = TclGetString(objv[1]); + pattern = Tcl_GetString(objv[1]); } ReadLock(); if (pattern) { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = Tcl_GetHashValue(hPtr); + ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr); if (Tcl_StringMatch(z->name, pattern)) { Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } } else if (regexp) { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = Tcl_GetHashValue(hPtr); + ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr); if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } } else { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = Tcl_GetHashValue(hPtr); + ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr); Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } @@ -3170,11 +3187,11 @@ Tcl_Obj *vfsInitScript; int found; #ifdef _WIN32 HMODULE hModule; WCHAR wName[MAX_PATH + LIBRARY_SIZE]; - char dllName[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + char dllName[(MAX_PATH + LIBRARY_SIZE) * 3]; #endif /* _WIN32 */ /* * Use the cached value if that has been set; we don't want to repeat the * searching and mounting. @@ -3267,14 +3284,14 @@ *------------------------------------------------------------------------- */ static int ZipFSTclLibraryObjCmd( - void *clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *)) /*objv*/ { if (!Tcl_IsSafe(interp)) { Tcl_Obj *pResult = TclZipfs_TclLibrary(); if (!pResult) { @@ -3302,29 +3319,34 @@ */ static int ZipChannelClose( void *instanceData, - Tcl_Interp *interp) /* Current interpreter. */ + TCL_UNUSED(Tcl_Interp *), + int flags) { - ZipChannel *info = instanceData; + ZipChannel *info = (ZipChannel *)instanceData; + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } if (info->iscompr && info->ubuf) { - Tcl_Free(info->ubuf); + ckfree(info->ubuf); info->ubuf = NULL; } if (info->isEncrypted) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); } if (info->isWriting) { ZipEntry *z = info->zipEntryPtr; - unsigned char *newdata = Tcl_AttemptRealloc(info->ubuf, info->numRead); + unsigned char *newdata = (unsigned char *)attemptckrealloc(info->ubuf, info->numRead); if (newdata) { if (z->data) { - Tcl_Free(z->data); + ckfree(z->data); } z->data = newdata; z->numBytes = z->numCompressedBytes = info->numBytes; z->compressMethod = ZIP_COMPMETH_STORED; z->timestamp = time(NULL); @@ -3331,17 +3353,17 @@ z->isDirectory = 0; z->isEncrypted = 0; z->offset = 0; z->crc32 = 0; } else { - Tcl_Free(info->ubuf); + ckfree(info->ubuf); } } WriteLock(); info->zipFilePtr->numOpen--; Unlock(); - Tcl_Free(info); + ckfree(info); return TCL_OK; } /* *------------------------------------------------------------------------- @@ -3464,11 +3486,11 @@ } /* *------------------------------------------------------------------------- * - * ZipChannelSeek -- + * ZipChannelSeek/ZipChannelWideSeek -- * * This function is called to position file pointer of channel. * * Results: * New file position or -1 on error with error number set. @@ -3477,19 +3499,19 @@ * File pointer is repositioned according to offset and mode. * *------------------------------------------------------------------------- */ -static int -ZipChannelSeek( +static Tcl_WideInt +ZipChannelWideSeek( void *instanceData, - long offset, + Tcl_WideInt offset, int mode, int *errloc) { ZipChannel *info = (ZipChannel *) instanceData; - unsigned long end; + size_t end; if (!info->isWriting && (info->isDirectory < 0)) { /* * Special case: when executable combined with ZIP archive file, seek * within front of ZIP, i.e. the executable itself. @@ -3517,24 +3539,36 @@ if (offset < 0) { *errloc = EINVAL; return -1; } if (info->isWriting) { - if ((unsigned long) offset > info->maxWrite) { + if ((size_t) offset > info->maxWrite) { *errloc = EINVAL; return -1; } - if ((unsigned long) offset > info->numBytes) { + if ((size_t) offset > info->numBytes) { info->numBytes = offset; } - } else if ((unsigned long) offset > end) { + } else if ((size_t) offset > end) { *errloc = EINVAL; return -1; } - info->numRead = (unsigned long) offset; + info->numRead = (size_t) offset; return info->numRead; } + +#ifndef TCL_NO_DEPRECATED +static int +ZipChannelSeek( + void *instanceData, + long offset, + int mode, + int *errloc) +{ + return ZipChannelWideSeek(instanceData, offset, mode, errloc); +} +#endif /* *------------------------------------------------------------------------- * * ZipChannelWatchChannel -- @@ -3551,12 +3585,12 @@ *------------------------------------------------------------------------- */ static void ZipChannelWatchChannel( - void *instanceData, - int mask) + TCL_UNUSED(ClientData), + TCL_UNUSED(int) /*mask*/) { return; } /* @@ -3576,13 +3610,13 @@ *------------------------------------------------------------------------- */ static int ZipChannelGetFile( - void *instanceData, - int direction, - void **handlePtr) + TCL_UNUSED(ClientData), + TCL_UNUSED(int) /*direction*/, + TCL_UNUSED(ClientData *) /*handlePtr*/) { return TCL_ERROR; } /* @@ -3605,11 +3639,11 @@ static Tcl_Channel ZipChannelOpen( Tcl_Interp *interp, /* Current interpreter. */ char *filename, int mode, - int permissions) + TCL_UNUSED(int) /*permissions*/) { ZipEntry *z; ZipChannel *info; int i, ch, trunc, wr, flags = 0; char cname[128]; @@ -3667,11 +3701,11 @@ goto error; } } else { flags = TCL_WRITABLE; } - info = Tcl_AttemptAlloc(sizeof(ZipChannel)); + info = (ZipChannel *)attemptckalloc(sizeof(ZipChannel)); if (!info) { ZIPFS_ERROR(interp, "out of memory"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } @@ -3685,17 +3719,17 @@ info->isWriting = 1; info->isDirectory = 0; info->maxWrite = ZipFS.wrmax; info->iscompr = 0; info->isEncrypted = 0; - info->ubuf = Tcl_AttemptAlloc(info->maxWrite); + info->ubuf = (unsigned char *)attemptckalloc(info->maxWrite); if (!info->ubuf) { merror0: if (info->ubuf) { - Tcl_Free(info->ubuf); + ckfree(info->ubuf); } - Tcl_Free(info); + ckfree(info); ZIPFS_ERROR(interp, "out of memory"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } goto error; @@ -3702,11 +3736,11 @@ } memset(info->ubuf, 0, info->maxWrite); if (trunc) { info->numBytes = 0; } else if (z->data) { - size_t j = z->numBytes; + unsigned int j = z->numBytes; if (j > info->maxWrite) { j = info->maxWrite; } memcpy(info->ubuf, z->data, j); @@ -3740,14 +3774,14 @@ stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; stream.avail_in = z->numCompressedBytes; if (z->isEncrypted) { - size_t j; + unsigned int j; stream.avail_in -= 12; - cbuf = Tcl_AttemptAlloc(stream.avail_in); + cbuf = (unsigned char *)attemptckalloc(stream.avail_in); if (!cbuf) { goto merror0; } for (j = 0; j < stream.avail_in; j++) { ch = info->ubuf[j]; @@ -3766,23 +3800,23 @@ inflateEnd(&stream); if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - Tcl_Free(cbuf); + ckfree(cbuf); } goto wrapchan; } cerror0: if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - Tcl_Free(cbuf); + ckfree(cbuf); } if (info->ubuf) { - Tcl_Free(info->ubuf); + ckfree(info->ubuf); } - Tcl_Free(info); + ckfree(info); ZIPFS_ERROR(interp, "decompression error"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL); } goto error; @@ -3834,20 +3868,20 @@ } if (info->iscompr) { z_stream stream; int err; unsigned char *ubuf = NULL; - size_t j; + unsigned int j; memset(&stream, 0, sizeof(z_stream)); stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; stream.avail_in = z->numCompressedBytes; if (info->isEncrypted) { stream.avail_in -= 12; - ubuf = Tcl_AttemptAlloc(stream.avail_in); + ubuf = (unsigned char *)attemptckalloc(stream.avail_in); if (!ubuf) { info->ubuf = NULL; goto merror; } for (j = 0; j < stream.avail_in; j++) { @@ -3856,19 +3890,19 @@ } stream.next_in = ubuf; } else { stream.next_in = info->ubuf; } - stream.next_out = info->ubuf = Tcl_AttemptAlloc(info->numBytes); + stream.next_out = info->ubuf = (unsigned char *)attemptckalloc(info->numBytes); if (!info->ubuf) { merror: if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - Tcl_Free(ubuf); + ckfree(ubuf); } - Tcl_Free(info); + ckfree(info); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); } @@ -3883,42 +3917,42 @@ if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - Tcl_Free(ubuf); + ckfree(ubuf); } goto wrapchan; } cerror: if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - Tcl_Free(ubuf); + ckfree(ubuf); } if (info->ubuf) { - Tcl_Free(info->ubuf); + ckfree(info->ubuf); } - Tcl_Free(info); + ckfree(info); ZIPFS_ERROR(interp, "decompression error"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL); } goto error; } else if (info->isEncrypted) { unsigned char *ubuf = NULL; - size_t j, len; + unsigned int j, len; /* * Decode encrypted but uncompressed file, since we support * Tcl_Seek() on it, and it can be randomly accessed later. */ len = z->numCompressedBytes - 12; - ubuf = (unsigned char *) Tcl_AttemptAlloc(len); + ubuf = (unsigned char *) attemptckalloc(len); if (ubuf == NULL) { - Tcl_Free((char *) info); + ckfree((char *) info); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); } goto error; @@ -4038,15 +4072,17 @@ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *pathPtr, int mode, int permissions) { + int len; + pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return NULL; } - return ZipChannelOpen(interp, TclGetString(pathPtr), mode, + return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, permissions); } /* *------------------------------------------------------------------------- @@ -4068,16 +4104,17 @@ static int ZipFSStatProc( Tcl_Obj *pathPtr, Tcl_StatBuf *buf) { + int len; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } - return ZipEntryStat(TclGetString(pathPtr), buf); + return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); } /* *------------------------------------------------------------------------- * @@ -4098,15 +4135,17 @@ static int ZipFSAccessProc( Tcl_Obj *pathPtr, int mode) { + int len; + pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } - return ZipEntryAccess(TclGetString(pathPtr), mode); + return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); } /* *------------------------------------------------------------------------- * @@ -4126,11 +4165,11 @@ *------------------------------------------------------------------------- */ static Tcl_Obj * ZipFSFilesystemSeparatorProc( - Tcl_Obj *pathPtr) + TCL_UNUSED(Tcl_Obj *) /*pathPtr*/) { return Tcl_NewStringObj("/", -1); } /* @@ -4152,21 +4191,21 @@ *------------------------------------------------------------------------- */ static int ZipFSMatchInDirectoryProc( - Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, strip = 0; - size_t len, prefixLen; + int scnt, l, dirOnly = -1, prefixLen, strip = 0; + size_t len; char *pat, *prefix, *path; Tcl_DString dsPref; if (!normPathPtr) { return -1; @@ -4177,17 +4216,18 @@ /* * The prefix that gets prepended to results. */ - prefix = TclGetStringFromObj(pathPtr, &prefixLen); + prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); /* * The (normalized) path we're searching. */ - path = TclGetStringFromObj(normPathPtr, &len); + path = Tcl_GetString(normPathPtr); + len = normPathPtr->length; Tcl_DStringInit(&dsPref); Tcl_DStringAppend(&dsPref, prefix, prefixLen); if (strcmp(prefix, path) == 0) { @@ -4211,11 +4251,11 @@ if (!pattern || (pattern[0] == '\0')) { pattern = "*"; } for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - ZipFile *zf = Tcl_GetHashValue(hPtr); + ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr); if (zf->mountPointLen == 0) { ZipEntry *z; for (z = zf->topEnts; z; z = z->tnext) { @@ -4262,11 +4302,11 @@ } if (!pattern || (pattern[0] == '\0')) { hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); if (hPtr) { - ZipEntry *z = Tcl_GetHashValue(hPtr); + ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr); if ((dirOnly < 0) || (!dirOnly && !z->isDirectory) || (dirOnly && z->isDirectory)) { if (prefix) { Tcl_DStringAppend(&dsPref, z->name, -1); @@ -4282,11 +4322,11 @@ } goto end; } l = strlen(pattern); - pat = Tcl_Alloc(len + l + 2); + pat = (char *)ckalloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { --len; } if ((len > 1) || (pat[0] != '/')) { @@ -4295,11 +4335,11 @@ } memcpy(pat + len, pattern, l + 1); scnt = CountSlashes(pat); for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - ZipEntry *z = Tcl_GetHashValue(hPtr); + ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr); if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory) || (!dirOnly && z->isDirectory))) { continue; } @@ -4314,11 +4354,11 @@ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name + strip, -1)); } } } - Tcl_Free(pat); + ckfree(pat); end: Unlock(); Tcl_DStringFree(&dsPref); return TCL_OK; @@ -4342,11 +4382,11 @@ */ static int ZipFSPathInFilesystemProc( Tcl_Obj *pathPtr, - void **clientDataPtr) + TCL_UNUSED(ClientData *)) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; int ret = -1; size_t len; @@ -4355,14 +4395,16 @@ pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } - path = TclGetStringFromObj(pathPtr, &len); + path = Tcl_GetString(pathPtr); if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) { return -1; } + + len = pathPtr->length; ReadLock(); hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); if (hPtr) { ret = TCL_OK; @@ -4369,11 +4411,11 @@ goto endloop; } for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - ZipFile *zf = Tcl_GetHashValue(hPtr); + ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr); if (zf->mountPointLen == 0) { ZipEntry *z; for (z = zf->topEnts; z != NULL; z = z->tnext) { @@ -4436,12 +4478,12 @@ *------------------------------------------------------------------------- */ static const char *const * ZipFSFileAttrStringsProc( - Tcl_Obj *pathPtr, - Tcl_Obj **objPtrRef) + TCL_UNUSED(Tcl_Obj *) /*pathPtr*/, + TCL_UNUSED(Tcl_Obj **) /*objPtrRef*/) { static const char *const attrs[] = { "-uncompsize", "-compsize", "-offset", @@ -4448,10 +4490,11 @@ "-mount", "-archive", "-permissions", NULL, }; + return attrs; } /* *------------------------------------------------------------------------- @@ -4478,19 +4521,19 @@ Tcl_Interp *interp, /* Current interpreter. */ int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { - int ret = TCL_OK; + int len, ret = TCL_OK; char *path; ZipEntry *z; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } - path = TclGetString(pathPtr); + path = Tcl_GetStringFromObj(pathPtr, &len); ReadLock(); z = ZipFSLookup(path); if (!z) { Tcl_SetErrno(ENOENT); ZIPFS_POSIX_ERROR(interp, "file not found"); @@ -4545,13 +4588,13 @@ */ static int ZipFSFileAttrsSetProc( Tcl_Interp *interp, /* Current interpreter. */ - int index, - Tcl_Obj *pathPtr, - Tcl_Obj *objPtr) + TCL_UNUSED(int) /*index*/, + TCL_UNUSED(Tcl_Obj *) /*pathPtr*/, + TCL_UNUSED(Tcl_Obj *) /*objPtr*/) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL); } @@ -4570,11 +4613,11 @@ *------------------------------------------------------------------------- */ static Tcl_Obj * ZipFSFilesystemPathTypeProc( - Tcl_Obj *pathPtr) + TCL_UNUSED(Tcl_Obj *) /*pathPtr*/) { return Tcl_NewStringObj("zip", -1); } /* @@ -4680,11 +4723,11 @@ } if (objs[1]) { Tcl_DecrRefCount(objs[1]); } - loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + loadFileProc = (Tcl_FSLoadFileProc2 *)(void *)tclNativeFilesystem.loadFileProc; if (loadFileProc) { ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); } else { Tcl_SetErrno(ENOENT); ZIPFS_ERROR(interp, Tcl_PosixError(interp)); @@ -4713,11 +4756,11 @@ * related commands to the given interpreter. * *------------------------------------------------------------------------- */ -MODULE_SCOPE int +int TclZipfs_Init( Tcl_Interp *interp) /* Current interpreter. */ { #ifdef HAVE_ZLIB static const EnsembleImplMap initMap[] = { @@ -4783,11 +4826,11 @@ Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj); Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1), Tcl_NewStringObj("::tcl::zipfs::find", -1)); Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init", ZipFSTclLibraryObjCmd, NULL, NULL); - Tcl_PkgProvideEx(interp, "zipfs", "2.0", NULL); + Tcl_PkgProvide(interp, "zipfs", "2.0"); } return TCL_OK; #else /* !HAVE_ZLIB */ ZIPFS_ERROR(interp, "no zlib available"); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL); @@ -4853,21 +4896,28 @@ *------------------------------------------------------------------------- */ int TclZipfs_AppHook( +#ifdef SUPPORT_BUILTIN_ZIP_INSTALL int *argcPtr, /* Pointer to argc */ +#else + TCL_UNUSED(int *), /*argcPtr*/ +#endif #ifdef _WIN32 - WCHAR + TCL_UNUSED(WCHAR ***)) /* argvPtr */ #else /* !_WIN32 */ - char + char ***argvPtr) /* Pointer to argv */ #endif /* _WIN32 */ - ***argvPtr) /* Pointer to argv */ { char *archive; +#ifdef _WIN32 + Tcl_FindExecutable(NULL); +#else Tcl_FindExecutable((*argvPtr)[0]); +#endif archive = (char *) Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); /* * Look for init.tcl in one of the locations mounted later in this @@ -4913,11 +4963,12 @@ */ #ifdef _WIN32 Tcl_DString ds; - archive = Tcl_WinTCharToUtf((*argvPtr)[1], -1, &ds); + Tcl_DStringInit(&ds); + archive = Tcl_WCharToUtfDString((*argvPtr)[1], -1, &ds); #else /* !_WIN32 */ archive = (*argvPtr)[1]; #endif /* _WIN32 */ if (strcmp(archive, "install") == 0) { Tcl_Obj *vfsInitScript; Index: generic/tclZlib.c ================================================================== --- generic/tclZlib.c +++ generic/tclZlib.c @@ -62,11 +62,11 @@ z_stream stream; /* The interface to the zlib library. */ int streamEnd; /* If we've got to end-of-stream. */ Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ Tcl_Obj *currentInput; /* Pointer to what is currently being * inflated. */ - size_t outPos; + int outPos; int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ int level; /* Default 5, 0-9 */ int flush; /* Stores the flush param for deferred the @@ -158,11 +158,11 @@ * Prototypes for private procedures defined later in this file: */ static Tcl_CmdDeleteProc ZlibStreamCmdDelete; static Tcl_DriverBlockModeProc ZlibTransformBlockMode; -static Tcl_DriverCloseProc ZlibTransformClose; +static Tcl_DriverClose2Proc ZlibTransformClose; static Tcl_DriverGetHandleProc ZlibTransformGetHandle; static Tcl_DriverGetOptionProc ZlibTransformGetOption; static Tcl_DriverHandlerProc ZlibTransformEventHandler; static Tcl_DriverInputProc ZlibTransformInput; static Tcl_DriverOutputProc ZlibTransformOutput; @@ -176,18 +176,18 @@ static void ConvertError(Tcl_Interp *interp, int code, uLong adler); static Tcl_Obj * ConvertErrorToList(int code, uLong adler); static inline int Deflate(z_streamp strm, void *bufferPtr, - size_t bufferSize, int flush, size_t *writtenPtr); + int bufferSize, int flush, int *writtenPtr); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); 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 inline int ResultCopy(ZlibChannelData *cd, char *buf, - size_t toRead); + int toRead); static int ResultGenerate(ZlibChannelData *cd, int n, 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, @@ -202,20 +202,20 @@ * Type of zlib-based compressing and decompressing channels. */ static const Tcl_ChannelType zlibChannelType = { "zlib", - TCL_CHANNEL_VERSION_3, - ZlibTransformClose, + TCL_CHANNEL_VERSION_5, + TCL_CLOSE2PROC, ZlibTransformInput, ZlibTransformOutput, NULL, /* seekProc */ ZlibTransformSetOption, ZlibTransformGetOption, ZlibTransformWatch, ZlibTransformGetHandle, - NULL, /* close2Proc */ + ZlibTransformClose, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ ZlibTransformEventHandler, NULL, /* wideSeekProc */ NULL, @@ -420,11 +420,10 @@ int *extraSizePtr) /* Variable to add the length of header * strings (filename, comment) to. */ { Tcl_Obj *value; int len, result = TCL_ERROR; - size_t length; Tcl_WideInt wideValue = 0; const char *valueStr; Tcl_Encoding latin1enc; static const char *const types[] = { "binary", "text" @@ -440,12 +439,12 @@ } if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = TclGetStringFromObj(value, &length); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL, + valueStr = TclGetStringFromObj(value, &len); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); headerPtr->nativeCommentBuf[len] = '\0'; headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf; if (extraSizePtr != NULL) { @@ -461,12 +460,12 @@ } if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = TclGetStringFromObj(value, &length); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL, + valueStr = TclGetStringFromObj(value, &len); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); headerPtr->nativeFilenameBuf[len] = '\0'; headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; if (extraSizePtr != NULL) { *extraSizePtr += len; @@ -591,12 +590,12 @@ SetInflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - size_t length = 0; - unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length); + int length; + unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return inflateSetDictionary(strm, bytes, length); } return Z_OK; } @@ -605,12 +604,12 @@ SetDeflateDictionary( z_streamp strm, Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - size_t length = 0; - unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length); + int length; + unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return deflateSetDictionary(strm, bytes, length); } return Z_OK; } @@ -617,13 +616,13 @@ static inline int Deflate( z_streamp strm, void *bufferPtr, - size_t bufferSize, + int bufferSize, int flush, - size_t *writtenPtr) + int *writtenPtr) { int e; strm->next_out = (Bytef *) bufferPtr; strm->avail_out = bufferSize; @@ -636,11 +635,11 @@ static inline void AppendByteArray( Tcl_Obj *listObj, void *buffer, - size_t size) + int size) { if (size > 0) { Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size); Tcl_ListObjAppendElement(NULL, listObj, baObj); @@ -698,15 +697,15 @@ wbits = WBITS_RAW; break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; if (dictObj) { - gzHeaderPtr = Tcl_Alloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); if (GenerateHeader(interp, dictObj, gzHeaderPtr, NULL) != TCL_OK) { - Tcl_Free(gzHeaderPtr); + ckfree(gzHeaderPtr); return TCL_ERROR; } } break; case TCL_ZLIB_FORMAT_ZLIB: @@ -732,11 +731,11 @@ case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - gzHeaderPtr = Tcl_Alloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); gzHeaderPtr->header.name = (Bytef *) gzHeaderPtr->nativeFilenameBuf; gzHeaderPtr->header.name_max = MAXPATHLEN - 1; gzHeaderPtr->header.comment = (Bytef *) @@ -758,11 +757,11 @@ default: Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or" " TCL_ZLIB_STREAM_INFLATE"); } - zshPtr = Tcl_Alloc(sizeof(ZlibStreamHandle)); + zshPtr = (ZlibStreamHandle *)ckalloc(sizeof(ZlibStreamHandle)); zshPtr->interp = interp; zshPtr->mode = mode; zshPtr->format = format; zshPtr->level = level; zshPtr->wbits = wbits; @@ -858,13 +857,13 @@ error: if (zshPtr->compDictObj) { Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - Tcl_Free(zshPtr->gzHeaderPtr); + ckfree(zshPtr->gzHeaderPtr); } - Tcl_Free(zshPtr); + ckfree(zshPtr); return TCL_ERROR; } /* *---------------------------------------------------------------------- @@ -885,11 +884,11 @@ static void ZlibStreamCmdDelete( void *cd) { - ZlibStreamHandle *zshPtr = cd; + ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; zshPtr->cmd = NULL; ZlibStreamCleanup(zshPtr); } @@ -971,14 +970,14 @@ } if (zshPtr->compDictObj) { Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - Tcl_Free(zshPtr->gzHeaderPtr); + ckfree(zshPtr->gzHeaderPtr); } - Tcl_Free(zshPtr); + ckfree(zshPtr); } /* *---------------------------------------------------------------------- * @@ -1151,10 +1150,15 @@ Tcl_ZlibStream zshandle, Tcl_Obj *compressionDictionaryObj) { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; + if (compressionDictionaryObj && (NULL == TclGetBytesFromObj(NULL, + compressionDictionaryObj, NULL))) { + /* Missing or invalid compression dictionary */ + compressionDictionaryObj = NULL; + } if (compressionDictionaryObj != NULL) { if (Tcl_IsShared(compressionDictionaryObj)) { compressionDictionaryObj = Tcl_DuplicateObj(compressionDictionaryObj); } @@ -1189,24 +1193,29 @@ int flush) /* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH, * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; - int e; - size_t size = 0, outSize, toStore; + int e, size, outSize, toStore; + unsigned char *bytes; if (zshPtr->streamEnd) { if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "already past compressed stream end", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); } return TCL_ERROR; } + + bytes = TclGetBytesFromObj(zshPtr->interp, data, &size); + if (bytes == NULL) { + return TCL_ERROR; + } if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { - zshPtr->stream.next_in = TclGetByteArrayFromObj(data, &size); + zshPtr->stream.next_in = bytes; zshPtr->stream.avail_in = size; /* * Must not do a zero-length compress unless finalizing. [Bug 25842c161] */ @@ -1233,11 +1242,11 @@ outSize = deflateBound(&zshPtr->stream, size) + 100; if (outSize > BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; } - dataTmp = Tcl_Alloc(outSize); + dataTmp = (char *)ckalloc(outSize); while (1) { e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore); /* @@ -1267,20 +1276,20 @@ AppendByteArray(zshPtr->outData, dataTmp, outSize); if (outSize < BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; /* There may be *lots* of data left to output... */ - dataTmp = Tcl_Realloc(dataTmp, outSize); + dataTmp = (char *)ckrealloc(dataTmp, outSize); } } /* * And append the final data block to the outData list. */ AppendByteArray(zshPtr->outData, dataTmp, toStore); - Tcl_Free(dataTmp); + ckfree(dataTmp); } else { /* * This is easy. Just append to the inData list. */ @@ -1309,32 +1318,33 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - size_t count) /* Number of bytes to grab as a maximum, you + int count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - int e, i, listLen; - size_t itemLen = 0, dataPos = 0; + int e, i, listLen, itemLen, dataPos = 0; Tcl_Obj *itemObj; unsigned char *dataPtr, *itemPtr; - size_t existing = 0; + int existing; /* * Getting beyond the of stream, just return empty string. */ if (zshPtr->streamEnd) { return TCL_OK; } - (void) TclGetByteArrayFromObj(data, &existing); + if (NULL == TclGetBytesFromObj(zshPtr->interp, data, &existing)) { + return TCL_ERROR; + } if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) { - if (count == TCL_AUTO_LENGTH) { + if (count == -1) { /* * The only safe thing to do is restict to 65k. We might cause a * panic for out of memory if we just kept growing the buffer. */ @@ -1370,11 +1380,11 @@ Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } - itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); + itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; zshPtr->stream.avail_in = itemLen; @@ -1442,11 +1452,11 @@ Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj); if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } - itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); + itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; zshPtr->stream.avail_in = itemLen; @@ -1487,15 +1497,15 @@ } inflateEnd(&zshPtr->stream); } } else { Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); - if (count == TCL_AUTO_LENGTH) { + if (count == -1) { count = 0; for (i=0; ioutData, i, &itemObj); - (void) TclGetByteArrayFromObj(itemObj, &itemLen); + (void) Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { count += itemLen; } @@ -1516,12 +1526,12 @@ * Get the next chunk off our list of chunks and grab the data out * of it. */ Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); - itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); - if (itemLen-zshPtr->outPos + dataPos >= count) { + itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); + if (itemLen-zshPtr->outPos >= count-dataPos) { size_t len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); zshPtr->outPos += len; dataPos += len; @@ -1563,21 +1573,30 @@ int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj) { - int wbits = 0, e = 0, extraSize = 0; - size_t inLen = 0; + int wbits = 0, inLen = 0, e = 0, extraSize = 0; Byte *inData = NULL; z_stream stream; GzipHeader header; gz_header *headerPtr = NULL; Tcl_Obj *obj; if (!interp) { return TCL_ERROR; } + + /* + * Obtain the pointer to the byte array, we'll pass this pointer straight + * to the deflate command. + */ + + inData = TclGetBytesFromObj(interp, data, &inLen); + if (inData == NULL) { + return TCL_ERROR; + } /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. */ @@ -1619,18 +1638,12 @@ * Allocate some space to store the output. */ TclNewObj(obj); - /* - * Obtain the pointer to the byte array, we'll pass this pointer straight - * to the deflate command. - */ - - inData = TclGetByteArrayFromObj(data, &inLen); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = inLen; + stream.avail_in = (uInt) inLen; stream.next_in = inData; /* * No output buffer available yet, will alloc after deflateInit2. */ @@ -1711,24 +1724,28 @@ int Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - size_t bufferSize, + int bufferSize, Tcl_Obj *gzipHeaderDictObj) { - int wbits = 0, e = 0; - size_t inLen = 0, newBufferSize; + int wbits = 0, inLen = 0, e = 0, newBufferSize; Byte *inData = NULL, *outData = NULL, *newOutData = NULL; z_stream stream; gz_header header, *headerPtr = NULL; Tcl_Obj *obj; char *nameBuf = NULL, *commentBuf = NULL; if (!interp) { return TCL_ERROR; } + + inData = TclGetBytesFromObj(interp, data, &inLen); + if (inData == NULL) { + return TCL_ERROR; + } /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. */ @@ -1755,19 +1772,18 @@ } if (gzipHeaderDictObj) { headerPtr = &header; memset(headerPtr, 0, sizeof(gz_header)); - nameBuf = Tcl_Alloc(MAXPATHLEN); + nameBuf = (char *)ckalloc(MAXPATHLEN); header.name = (Bytef *) nameBuf; header.name_max = MAXPATHLEN - 1; - commentBuf = Tcl_Alloc(MAX_COMMENT_LEN); + commentBuf = (char *)ckalloc(MAX_COMMENT_LEN); header.comment = (Bytef *) commentBuf; header.comm_max = MAX_COMMENT_LEN - 1; } - inData = TclGetByteArrayFromObj(data, &inLen); if (bufferSize < 1) { /* * Start with a buffer (up to) 3 times the size of the input data. */ @@ -1781,11 +1797,11 @@ } TclNewObj(obj); outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = inLen+1; /* +1 because zlib can "over-request" + stream.avail_in = (uInt) inLen+1; /* +1 because zlib can "over-request" * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; stream.next_out = outData; @@ -1864,24 +1880,24 @@ Tcl_SetByteArrayLength(obj, stream.total_out); if (headerPtr != NULL) { ExtractHeader(&header, gzipHeaderDictObj); SetValue(gzipHeaderDictObj, "size", Tcl_NewWideIntObj(stream.total_out)); - Tcl_Free(nameBuf); - Tcl_Free(commentBuf); + ckfree(nameBuf); + ckfree(commentBuf); } Tcl_SetObjResult(interp, obj); return TCL_OK; error: TclDecrRefCount(obj); ConvertError(interp, e, stream.adler); if (nameBuf) { - Tcl_Free(nameBuf); + ckfree(nameBuf); } if (commentBuf) { - Tcl_Free(commentBuf); + ckfree(commentBuf); } return TCL_ERROR; } /* @@ -1896,21 +1912,21 @@ unsigned int Tcl_ZlibCRC32( unsigned int crc, const unsigned char *buf, - size_t len) + int len) { /* Nothing much to do, just wrap the crc32(). */ return crc32(crc, (Bytef *) buf, len); } unsigned int Tcl_ZlibAdler32( unsigned int adler, const unsigned char *buf, - size_t len) + int len) { return adler32(adler, (Bytef *) buf, len); } /* @@ -1923,18 +1939,17 @@ *---------------------------------------------------------------------- */ static int ZlibCmd( - void *notUsed, + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - int command, i, option, level = -1; - size_t dlen = 0, start, buffersize = 0; - Tcl_WideInt wideLen; + int command, dlen, i, option, level = -1; + unsigned start, buffersize = 0; Byte *data; Tcl_Obj *headerDictObj; const char *extraInfoStr = NULL; static const char *const commands[] = { "adler32", "compress", "crc32", "decompress", "deflate", "gunzip", @@ -1959,36 +1974,42 @@ case CMD_ADLER: /* adler32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; + } + data = TclGetBytesFromObj(interp, objv[2], &dlen); + if (data == NULL) { + return TCL_ERROR; } if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } if (objc < 4) { start = Tcl_ZlibAdler32(0, NULL, 0); } - data = TclGetByteArrayFromObj(objv[2], &dlen); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibAdler32(start, data, dlen))); return TCL_OK; case CMD_CRC: /* crc32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; + } + data = TclGetBytesFromObj(interp, objv[2], &dlen); + if (data == NULL) { + return TCL_ERROR; } if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } if (objc < 4) { start = Tcl_ZlibCRC32(0, NULL, 0); } - data = TclGetByteArrayFromObj(objv[2], &dlen); Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibCRC32(start, data, dlen))); return TCL_OK; case CMD_DEFLATE: /* deflate data ?level? * -> rawCompressedData */ @@ -2077,19 +2098,18 @@ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetWideIntFromObj(interp, objv[3], - &wideLen) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], + (int *) &buffersize) != TCL_OK) { return TCL_ERROR; } - if (wideLen < MIN_NONSTREAM_BUFFER_SIZE - || wideLen > MAX_BUFFER_SIZE) { + if (buffersize < MIN_NONSTREAM_BUFFER_SIZE + || buffersize > MAX_BUFFER_SIZE) { goto badBuffer; } - buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); case CMD_DECOMPRESS: /* decompress zlibcomprdata \ * ?bufferSize? @@ -2097,19 +2117,18 @@ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetWideIntFromObj(interp, objv[3], - &wideLen) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], + (int *) &buffersize) != TCL_OK) { return TCL_ERROR; } - if (wideLen < MIN_NONSTREAM_BUFFER_SIZE - || wideLen > MAX_BUFFER_SIZE) { + if (buffersize < MIN_NONSTREAM_BUFFER_SIZE + || buffersize > MAX_BUFFER_SIZE) { goto badBuffer; } - buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); case CMD_GUNZIP: { /* gunzip gzippeddata ?bufferSize? * -> decompressedData */ @@ -2129,19 +2148,18 @@ &option) != TCL_OK) { return TCL_ERROR; } switch (option) { case 0: - if (Tcl_GetWideIntFromObj(interp, objv[i+1], - &wideLen) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[i+1], + (int *) &buffersize) != TCL_OK) { return TCL_ERROR; } - if (wideLen < MIN_NONSTREAM_BUFFER_SIZE - || wideLen > MAX_BUFFER_SIZE) { + if (buffersize < MIN_NONSTREAM_BUFFER_SIZE + || buffersize > MAX_BUFFER_SIZE) { goto badBuffer; } - buffersize = wideLen; break; case 1: headerVarObj = objv[i+1]; headerDictObj = Tcl_NewObj(); break; @@ -2319,10 +2337,16 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; } + + if (compDictObj) { + if (NULL == TclGetBytesFromObj(interp, compDictObj, NULL)) { + return TCL_ERROR; + } + } /* * Construct the stream now we know its configuration. */ @@ -2496,10 +2520,14 @@ } compDictObj = objv[i]; break; } } + + if (compDictObj && (NULL == TclGetBytesFromObj(interp, compDictObj, NULL))) { + return TCL_ERROR; + } if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan, headerObj, compDictObj) == NULL) { return TCL_ERROR; } @@ -2528,11 +2556,11 @@ void *cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; int command, count, code; Tcl_Obj *obj; static const char *const cmds[] = { "add", "checksum", "close", "eof", "finalize", "flush", "fullflush", "get", "header", "put", "reset", @@ -2654,11 +2682,11 @@ void *cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; int index, code, buffersize = -1, flush = -1, i; Tcl_Obj *obj, *compDictObj = NULL; static const char *const add_options[] = { "-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL }; @@ -2740,13 +2768,16 @@ /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { - size_t len = 0; + int len; - (void) TclGetByteArrayFromObj(compDictObj, &len); + if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) { + return TCL_ERROR; + } + if (len == 0) { compDictObj = NULL; } Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); } @@ -2778,11 +2809,11 @@ void *cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; int index, flush = -1, i; Tcl_Obj *compDictObj = NULL; static const char *const put_options[] = { "-dictionary", "-finalize", "-flush", "-fullflush", NULL }; @@ -2844,13 +2875,15 @@ /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { - size_t len = 0; + int len; - (void) TclGetByteArrayFromObj(compDictObj, &len); + if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) { + return TCL_ERROR; + } if (len == 0) { compDictObj = NULL; } Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); } @@ -2867,11 +2900,11 @@ void *cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - ZlibStreamHandle *zshPtr = cd; + ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; Tcl_Obj *resultObj; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; @@ -2902,15 +2935,19 @@ */ static int ZlibTransformClose( void *instanceData, - Tcl_Interp *interp) + Tcl_Interp *interp, + int flags) { - ZlibChannelData *cd = instanceData; - int e, result = TCL_OK; - size_t written; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; + int e, written, result = TCL_OK; + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } /* * Delete the support timer. */ @@ -2970,18 +3007,18 @@ cd->compDictObj = NULL; } Tcl_DStringFree(&cd->decompressed); if (cd->inBuffer) { - Tcl_Free(cd->inBuffer); + ckfree(cd->inBuffer); cd->inBuffer = NULL; } if (cd->outBuffer) { - Tcl_Free(cd->outBuffer); + ckfree(cd->outBuffer); cd->outBuffer = NULL; } - Tcl_Free(cd); + ckfree(cd); return result; } /* *---------------------------------------------------------------------- @@ -2998,11 +3035,11 @@ void *instanceData, char *buf, int toRead, int *errorCodePtr) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverInputProc *inProc = Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); int readBytes, gotBytes, copied; if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { @@ -3043,17 +3080,17 @@ /* * Three cases here: * 1. Got some data from the underlying channel (readBytes > 0) so * it should be fed through the decompression engine. - * 2. Got an error (readBytes == -1) which we should report up except + * 2. Got an error (readBytes < 0) which we should report up except * for the case where we can convert it to a short read. * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If * it is EOF, try flushing the data out of the decompressor. */ - if (readBytes == -1) { + if (readBytes < 0) { /* See ReflectInput() in tclIORTrans.c */ if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { return gotBytes; } @@ -3112,15 +3149,14 @@ void *instanceData, const char *buf, int toWrite, int *errorCodePtr) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverOutputProc *outProc = Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); - int e; - size_t produced; + int e, produced; Tcl_Obj *errObj; if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite, errorCodePtr); @@ -3178,12 +3214,11 @@ ZlibTransformFlush( Tcl_Interp *interp, ZlibChannelData *cd, int flushType) { - int e; - size_t len; + int e, len; cd->outStream.avail_in = 0; do { /* * Get the bytes to go out of the compression engine. @@ -3235,11 +3270,11 @@ void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverSetOptionProc *setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent)); static const char *compressChanOptions = "dictionary flush"; static const char *gzipChanOptions = "flush"; static const char *decompressChanOptions = "dictionary limit"; @@ -3251,11 +3286,14 @@ Tcl_Obj *compDictObj; int code; TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); - Tcl_GetByteArrayFromObj(compDictObj, NULL); + if (NULL == TclGetBytesFromObj(interp, compDictObj, NULL)) { + Tcl_DecrRefCount(compDictObj); + return TCL_ERROR; + } if (cd->compDictObj) { TclDecrRefCount(cd->compDictObj); } cd->compDictObj = compDictObj; code = Z_OK; @@ -3348,11 +3386,11 @@ void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverGetOptionProc *getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent)); static const char *compressChanOptions = "checksum dictionary"; static const char *gzipChanOptions = "checksum"; static const char *decompressChanOptions = "checksum dictionary limit"; @@ -3392,20 +3430,20 @@ if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-dictionary"); if (cd->compDictObj) { Tcl_DStringAppendElement(dsPtr, - TclGetString(cd->compDictObj)); + Tcl_GetString(cd->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { if (cd->compDictObj) { - size_t length; - const char *str = TclGetStringFromObj(cd->compDictObj, &length); + int len; + const char *str = TclGetStringFromObj(cd->compDictObj, &len); - Tcl_DStringAppend(dsPtr, str, length); + Tcl_DStringAppend(dsPtr, str, len); } return TCL_OK; } } @@ -3419,11 +3457,11 @@ Tcl_Obj *tmpObj = Tcl_NewObj(); ExtractHeader(&cd->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); - Tcl_DStringAppendElement(dsPtr, TclGetString(tmpObj)); + Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { TclDStringAppendObj(dsPtr, tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; @@ -3466,11 +3504,11 @@ static void ZlibTransformWatch( void *instanceData, int mask) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverWatchProc *watchProc; /* * This code is based on the code in tclIORTrans.c */ @@ -3489,11 +3527,11 @@ static int ZlibTransformEventHandler( void *instanceData, int interestMask) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; ZlibTransformEventTimerKill(cd); return interestMask; } @@ -3509,11 +3547,11 @@ static void ZlibTransformTimerRun( void *clientData) { - ZlibChannelData *cd = clientData; + ZlibChannelData *cd = (ZlibChannelData *)clientData; cd->timer = NULL; Tcl_NotifyChannel(cd->chan, TCL_READABLE); } @@ -3532,11 +3570,11 @@ ZlibTransformGetHandle( void *instanceData, int direction, void **handlePtr) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); } /* @@ -3552,11 +3590,11 @@ static int ZlibTransformBlockMode( void *instanceData, int mode) { - ZlibChannelData *cd = instanceData; + ZlibChannelData *cd = (ZlibChannelData *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { cd->flags |= ASYNC; } else { cd->flags &= ~ASYNC; @@ -3602,11 +3640,11 @@ * to produce gzip-format data. */ Tcl_Obj *compDictObj) /* Byte-array object containing compression * dictionary (not dictObj!) to use if * necessary. */ { - ZlibChannelData *cd = Tcl_Alloc(sizeof(ZlibChannelData)); + ZlibChannelData *cd = (ZlibChannelData *)ckalloc(sizeof(ZlibChannelData)); Tcl_Channel chan; int wbits = 0; if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) { Tcl_Panic("unknown mode: %d", mode); @@ -3662,11 +3700,11 @@ if (mode == TCL_ZLIB_STREAM_INFLATE) { if (inflateInit2(&cd->inStream, wbits) != Z_OK) { goto error; } cd->inAllocated = DEFAULT_BUFFER_SIZE; - cd->inBuffer = Tcl_Alloc(cd->inAllocated); + cd->inBuffer = (char *)ckalloc(cd->inAllocated); if (cd->flags & IN_HEADER) { if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) { goto error; } } @@ -3679,11 +3717,11 @@ if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) { goto error; } cd->outAllocated = DEFAULT_BUFFER_SIZE; - cd->outBuffer = Tcl_Alloc(cd->outAllocated); + cd->outBuffer = (char *)ckalloc(cd->outAllocated); if (cd->flags & OUT_HEADER) { if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) { goto error; } } @@ -3706,21 +3744,21 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return chan; error: if (cd->inBuffer) { - Tcl_Free(cd->inBuffer); + ckfree(cd->inBuffer); inflateEnd(&cd->inStream); } if (cd->outBuffer) { - Tcl_Free(cd->outBuffer); + ckfree(cd->outBuffer); deflateEnd(&cd->outStream); } if (cd->compDictObj) { Tcl_DecrRefCount(cd->compDictObj); } - Tcl_Free(cd); + ckfree(cd); return NULL; } /* *---------------------------------------------------------------------- @@ -3742,13 +3780,13 @@ static inline int ResultCopy( ZlibChannelData *cd, /* The location of the buffer to read from. */ char *buf, /* The buffer to copy into */ - size_t toRead) /* Number of requested bytes */ + int toRead) /* Number of requested bytes */ { - size_t have = Tcl_DStringLength(&cd->decompressed); + int have = Tcl_DStringLength(&cd->decompressed); if (have == 0) { /* * Nothing to copy in the case of an empty buffer. */ @@ -3844,11 +3882,11 @@ * The cases where we're definitely done. */ if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) || (e == Z_STREAM_END) - || (e == Z_OK && cd->inStream.avail_out == 0)) { + || (e == Z_OK && written == 0)) { return TCL_OK; } /* * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html @@ -3930,11 +3968,11 @@ /* * Formally provide the package as a Tcl built-in. */ - return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL); + return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); } /* *---------------------------------------------------------------------- * Stubs used when a suitable zlib installation was not found during @@ -4005,11 +4043,11 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, Tcl_Obj *data, - size_t count) + int count) { return TCL_OK; } int @@ -4030,11 +4068,11 @@ int Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - size_t bufferSize, + int bufferSize, Tcl_Obj *gzipHeaderDictObj) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); @@ -4043,21 +4081,21 @@ } unsigned int Tcl_ZlibCRC32( unsigned int crc, - const unsigned char *buf, - size_t len) + const char *buf, + int len) { return 0; } unsigned int Tcl_ZlibAdler32( unsigned int adler, - const unsigned char *buf, - size_t len) + const char *buf, + int len) { return 0; } void DELETED generic/tommath.h Index: generic/tommath.h ================================================================== --- generic/tommath.h +++ /dev/null @@ -1,1 +0,0 @@ -#include "tclTomMathInt.h" Index: library/clock.tcl ================================================================== --- library/clock.tcl +++ library/clock.tcl @@ -3450,11 +3450,11 @@ binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes incr seek [expr { ($ilen + 1) * $nTime }] set times [linsert $times 0 $MINWIDE] set codes {} foreach c $tempCodes { - lappend codes [expr { $c & 0xff }] + lappend codes [expr { $c & 0xFF }] } set codes [linsert $codes 0 0] # Next come ${nType} time type descriptions, each of which has an offset # (seconds east of GMT), a DST indicator, and an index into the ADDED library/cookiejar/cookiejar.tcl Index: library/cookiejar/cookiejar.tcl ================================================================== --- /dev/null +++ library/cookiejar/cookiejar.tcl @@ -0,0 +1,746 @@ +# cookiejar.tcl -- +# +# Implementation of an HTTP cookie storage engine using SQLite. The +# implementation is done as a TclOO class, and includes a punycode +# encoder and decoder (though only the encoder is currently used). +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# Dependencies +package require Tcl 8.6 +package require http 2.8.4 +package require sqlite3 +package require tcl::idna 1.0 + +# +# Configuration for the cookiejar package, plus basic support procedures. +# + +# This is the class that we are creating +if {![llength [info commands ::http::cookiejar]]} { + ::oo::class create ::http::cookiejar +} + +namespace eval [info object namespace ::http::cookiejar] { + proc setInt {*var val} { + upvar 1 ${*var} var + if {[catch {incr dummy $val} msg]} { + return -code error $msg + } + set var $val + } + proc setInterval {trigger *var val} { + upvar 1 ${*var} var + if {![string is integer -strict $val] || $val < 1} { + return -code error "expected positive integer but got \"$val\"" + } + set var $val + {*}$trigger + } + proc setBool {*var val} { + upvar 1 ${*var} var + if {[catch {if {$val} {}} msg]} { + return -code error $msg + } + set var [expr {!!$val}] + } + + proc setLog {*var val} { + upvar 1 ${*var} var + set var [::tcl::prefix match -message "log level" \ + {debug info warn error} $val] + } + + # Keep this in sync with pkgIndex.tcl and with the install directories in + # Makefiles + variable version 0.2.0 + + variable domainlist \ + http://publicsuffix.org/list/effective_tld_names.dat + variable domainfile \ + [file join [file dirname [info script]] effective_tld_names.txt.gz] + # The list is directed to from http://publicsuffix.org/list/ + variable loglevel info + variable vacuumtrigger 200 + variable retainlimit 100 + variable offline false + variable purgeinterval 60000 + variable refreshinterval 10000000 + variable domaincache {} + + # Some support procedures, none particularly useful in general + namespace eval support { + # Set up a logger if the http package isn't actually loaded yet. + if {![llength [info commands ::http::Log]]} { + proc ::http::Log args { + # Do nothing by default... + } + } + + namespace export * + proc locn {secure domain path {key ""}} { + if {$key eq ""} { + format "%s://%s%s" [expr {$secure?"https":"http"}] \ + [::tcl::idna encode $domain] $path + } else { + format "%s://%s%s?%s" \ + [expr {$secure?"https":"http"}] [::tcl::idna encode $domain] \ + $path $key + } + } + proc splitDomain domain { + set pieces [split $domain "."] + for {set i [llength $pieces]} {[incr i -1] >= 0} {} { + lappend result [join [lrange $pieces $i end] "."] + } + return $result + } + proc splitPath path { + set pieces [split [string trimleft $path "/"] "/"] + set result / + for {set j 0} {$j < [llength $pieces]} {incr j} { + lappend result /[join [lrange $pieces 0 $j] "/"] + } + return $result + } + proc isoNow {} { + set ms [clock milliseconds] + set ts [expr {$ms / 1000}] + set ms [format %03d [expr {$ms % 1000}]] + clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1 + } + proc log {level msg args} { + namespace upvar [info object namespace ::http::cookiejar] \ + loglevel loglevel + set who [uplevel 1 self class] + set mth [uplevel 1 self method] + set map {debug 0 info 1 warn 2 error 3} + if {[string map $map $level] >= [string map $map $loglevel]} { + set msg [format $msg {*}$args] + set LVL [string toupper $level] + ::http::Log "[isoNow] $LVL $who $mth - $msg" + } + } + } +} + +# Now we have enough information to provide the package. +package provide cookiejar \ + [set [info object namespace ::http::cookiejar]::version] + +# The implementation of the cookiejar package +::oo::define ::http::cookiejar { + self { + method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} { + set tbl { + -domainfile {domainfile set} + -domainlist {domainlist set} + -domainrefresh {refreshinterval setInterval} + -loglevel {loglevel setLog} + -offline {offline setBool} + -purgeold {purgeinterval setInterval} + -retain {retainlimit setInt} + -vacuumtrigger {vacuumtrigger setInt} + } + dict lappend tbl -domainrefresh [namespace code { + my IntervalTrigger PostponeRefresh + }] + dict lappend tbl -purgeold [namespace code { + my IntervalTrigger PostponePurge + }] + if {$optionName eq "\u0000\u0000"} { + return [dict keys $tbl] + } + set opt [::tcl::prefix match -message "option" \ + [dict keys $tbl] $optionName] + set setter [lassign [dict get $tbl $opt] varname] + namespace upvar [namespace current] $varname var + if {$optionValue ne "\u0000\u0000"} { + {*}$setter var $optionValue + } + return $var + } + + method IntervalTrigger {method} { + # TODO: handle subclassing + foreach obj [info class instances [self]] { + [info object namespace $obj]::my $method + } + } + } + + variable purgeTimer deletions refreshTimer + constructor {{path ""}} { + namespace import [info object namespace [self class]]::support::* + + if {$path eq ""} { + sqlite3 [namespace current]::db :memory: + set storeorigin "constructed cookie store in memory" + } else { + sqlite3 [namespace current]::db $path + db timeout 500 + set storeorigin "loaded cookie store from $path" + } + + set deletions 0 + db transaction { + db eval { + --;# Store the persistent cookies in this table. + --;# Deletion policy: once they expire, or if explicitly + --;# killed. + CREATE TABLE IF NOT EXISTS persistentCookies ( + id INTEGER PRIMARY KEY, + secure INTEGER NOT NULL, + domain TEXT NOT NULL COLLATE NOCASE, + path TEXT NOT NULL, + key TEXT NOT NULL, + value TEXT NOT NULL, + originonly INTEGER NOT NULL, + expiry INTEGER NOT NULL, + lastuse INTEGER NOT NULL, + creation INTEGER NOT NULL); + CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique + ON persistentCookies (domain, path, key); + CREATE INDEX IF NOT EXISTS persistentLookup + ON persistentCookies (domain, path); + + --;# Store the session cookies in this table. + --;# Deletion policy: at cookiejar instance deletion, if + --;# explicitly killed, or if the number of session cookies is + --;# too large and the cookie has not been used recently. + CREATE TEMP TABLE sessionCookies ( + id INTEGER PRIMARY KEY, + secure INTEGER NOT NULL, + domain TEXT NOT NULL COLLATE NOCASE, + path TEXT NOT NULL, + key TEXT NOT NULL, + originonly INTEGER NOT NULL, + value TEXT NOT NULL, + lastuse INTEGER NOT NULL, + creation INTEGER NOT NULL); + CREATE UNIQUE INDEX sessionUnique + ON sessionCookies (domain, path, key); + CREATE INDEX sessionLookup ON sessionCookies (domain, path); + + --;# View to allow for simple looking up of a cookie. + --;# Deletion policy: NOT SUPPORTED via this view. + CREATE TEMP VIEW cookies AS + SELECT id, domain, ( + CASE originonly WHEN 1 THEN path ELSE '.' || path END + ) AS path, key, value, secure, 1 AS persistent + FROM persistentCookies + UNION + SELECT id, domain, ( + CASE originonly WHEN 1 THEN path ELSE '.' || path END + ) AS path, key, value, secure, 0 AS persistent + FROM sessionCookies; + + --;# Encoded domain permission policy; if forbidden is 1, no + --;# cookie may be ever set for the domain, and if forbidden + --;# is 0, cookies *may* be created for the domain (overriding + --;# the forbiddenSuper table). + --;# Deletion policy: normally not modified. + CREATE TABLE IF NOT EXISTS domains ( + domain TEXT PRIMARY KEY NOT NULL, + forbidden INTEGER NOT NULL); + + --;# Domains that may not have a cookie defined for direct + --;# child domains of them. + --;# Deletion policy: normally not modified. + CREATE TABLE IF NOT EXISTS forbiddenSuper ( + domain TEXT PRIMARY KEY); + + --;# When we last retrieved the domain list. + CREATE TABLE IF NOT EXISTS domainCacheMetadata ( + id INTEGER PRIMARY KEY, + retrievalDate INTEGER, + installDate INTEGER); + } + + set cookieCount "no" + db eval { + SELECT COUNT(*) AS cookieCount FROM persistentCookies + } + log info "%s with %s entries" $storeorigin $cookieCount + + my PostponePurge + + if {$path ne ""} { + if {[db exists {SELECT 1 FROM domains}]} { + my RefreshDomains + } else { + my InitDomainList + my PostponeRefresh + } + } else { + set data [my GetDomainListOffline metadata] + my InstallDomainData $data $metadata + my PostponeRefresh + } + } + } + + method PostponePurge {} { + namespace upvar [info object namespace [self class]] \ + purgeinterval interval + catch {after cancel $purgeTimer} + set purgeTimer [after $interval [namespace code {my PurgeCookies}]] + } + + method PostponeRefresh {} { + namespace upvar [info object namespace [self class]] \ + refreshinterval interval + catch {after cancel $refreshTimer} + set refreshTimer [after $interval [namespace code {my RefreshDomains}]] + } + + method RefreshDomains {} { + # TODO: domain list refresh policy + my PostponeRefresh + } + + method HttpGet {url {timeout 0} {maxRedirects 5}} { + for {set r 0} {$r < $maxRedirects} {incr r} { + set tok [::http::geturl $url -timeout $timeout] + try { + if {[::http::status $tok] eq "timeout"} { + return -code error "connection timed out" + } elseif {[::http::ncode $tok] == 200} { + return [::http::data $tok] + } elseif {[::http::ncode $tok] >= 400} { + return -code error [::http::error $tok] + } elseif {[dict exists [::http::meta $tok] Location]} { + set url [dict get [::http::meta $tok] Location] + continue + } + return -code error \ + "unexpected state: [::http::code $tok]" + } finally { + ::http::cleanup $tok + } + } + return -code error "too many redirects" + } + method GetDomainListOnline {metaVar} { + upvar 1 $metaVar meta + namespace upvar [info object namespace [self class]] \ + domainlist url domaincache cache + lassign $cache when data + if {$when > [clock seconds] - 3600} { + log debug "using cached value created at %s" \ + [clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1] + dict set meta retrievalDate $when + return $data + } + log debug "loading domain list from %s" $url + try { + set when [clock seconds] + set data [my HttpGet $url] + set cache [list $when $data] + # TODO: Should we use the Last-Modified header instead? + dict set meta retrievalDate $when + return $data + } on error msg { + log error "failed to fetch list of forbidden cookie domains from %s: %s" \ + $url $msg + return {} + } + } + method GetDomainListOffline {metaVar} { + upvar 1 $metaVar meta + namespace upvar [info object namespace [self class]] \ + domainfile filename + log debug "loading domain list from %s" $filename + try { + set f [open $filename] + try { + if {[string match *.gz $filename]} { + zlib push gunzip $f + } + fconfigure $f -encoding utf-8 + dict set meta retrievalDate [file mtime $filename] + return [read $f] + } finally { + close $f + } + } on error {msg opt} { + log error "failed to read list of forbidden cookie domains from %s: %s" \ + $filename $msg + return -options $opt $msg + } + } + method InitDomainList {} { + namespace upvar [info object namespace [self class]] \ + offline offline + if {!$offline} { + try { + set data [my GetDomainListOnline metadata] + if {[string length $data]} { + my InstallDomainData $data $metadata + return + } + } on error {} { + log warn "attempting to fall back to built in version" + } + } + set data [my GetDomainListOffline metadata] + my InstallDomainData $data $metadata + } + + method InstallDomainData {data meta} { + set n [db total_changes] + db transaction { + foreach line [split $data "\n"] { + if {[string trim $line] eq ""} { + continue + } elseif {[string match //* $line]} { + continue + } elseif {[string match !* $line]} { + set line [string range $line 1 end] + set idna [string tolower [::tcl::idna encode $line]] + set utf [::tcl::idna decode [string tolower $line]] + db eval { + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($utf, 0); + } + if {$idna ne $utf} { + db eval { + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 0); + } + } + } else { + if {[string match {\*.*} $line]} { + set line [string range $line 2 end] + set idna [string tolower [::tcl::idna encode $line]] + set utf [::tcl::idna decode [string tolower $line]] + db eval { + INSERT OR REPLACE INTO forbiddenSuper (domain) + VALUES ($utf); + } + if {$idna ne $utf} { + db eval { + INSERT OR REPLACE INTO forbiddenSuper (domain) + VALUES ($idna); + } + } + } else { + set idna [string tolower [::tcl::idna encode $line]] + set utf [::tcl::idna decode [string tolower $line]] + } + db eval { + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($utf, 1); + } + if {$idna ne $utf} { + db eval { + INSERT OR REPLACE INTO domains (domain, forbidden) + VALUES ($idna, 1); + } + } + } + if {$utf ne [::tcl::idna decode [string tolower $idna]]} { + log warn "mismatch in IDNA handling for %s (%d, %s, %s)" \ + $idna $line $utf [::tcl::idna decode $idna] + } + } + + dict with meta { + set installDate [clock seconds] + db eval { + INSERT OR REPLACE INTO domainCacheMetadata + (id, retrievalDate, installDate) + VALUES (1, $retrievalDate, $installDate); + } + } + } + set n [expr {[db total_changes] - $n}] + log info "constructed domain info with %d entries" $n + } + + # This forces the rebuild of the domain data, loading it from + method forceLoadDomainData {} { + db transaction { + db eval { + DELETE FROM domains; + DELETE FROM forbiddenSuper; + INSERT OR REPLACE INTO domainCacheMetadata + (id, retrievalDate, installDate) + VALUES (1, -1, -1); + } + my InitDomainList + } + } + + destructor { + catch { + after cancel $purgeTimer + } + catch { + after cancel $refreshTimer + } + catch { + db close + } + return + } + + method GetCookiesForHostAndPath {listVar secure host path fullhost} { + upvar 1 $listVar result + log debug "check for cookies for %s" [locn $secure $host $path] + set exact [expr {$host eq $fullhost}] + db eval { + SELECT key, value FROM persistentCookies + WHERE domain = $host AND path = $path AND secure <= $secure + AND (NOT originonly OR domain = $fullhost) + AND originonly = $exact + } { + lappend result $key $value + db eval { + UPDATE persistentCookies SET lastuse = $now WHERE id = $id + } + } + set now [clock seconds] + db eval { + SELECT id, key, value FROM sessionCookies + WHERE domain = $host AND path = $path AND secure <= $secure + AND (NOT originonly OR domain = $fullhost) + AND originonly = $exact + } { + lappend result $key $value + db eval { + UPDATE sessionCookies SET lastuse = $now WHERE id = $id + } + } + } + + method getCookies {proto host path} { + set result {} + set paths [splitPath $path] + if {[regexp {[^0-9.]} $host]} { + set domains [splitDomain [string tolower [::tcl::idna encode $host]]] + } else { + # Ugh, it's a numeric domain! Restrict it to just itself... + set domains [list $host] + } + set secure [string equal -nocase $proto "https"] + # Open question: how to move these manipulations into the database + # engine (if that's where they *should* be). + # + # Suggestion from kbk: + #LENGTH(theColumn) <= LENGTH($queryStr) AND + #SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr + # + # However, we instead do most of the work in Tcl because that lets us + # do the splitting exactly right, and it's far easier to work with + # strings in Tcl than in SQL. + db transaction { + foreach domain $domains { + foreach p $paths { + my GetCookiesForHostAndPath result $secure $domain $p $host + } + } + return $result + } + } + + method BadDomain options { + if {![dict exists $options domain]} { + log error "no domain present in options" + return 0 + } + dict with options {} + if {$domain ne $origin} { + log debug "cookie domain varies from origin (%s, %s)" \ + $domain $origin + if {[string match .* $domain]} { + set dotd $domain + } else { + set dotd .$domain + } + if {![string equal -length [string length $dotd] \ + [string reverse $dotd] [string reverse $origin]]} { + log warn "bad cookie: domain not suffix of origin" + return 1 + } + } + if {![regexp {[^0-9.]} $domain]} { + if {$domain eq $origin} { + # May set for itself + return 0 + } + log warn "bad cookie: for a numeric address" + return 1 + } + db eval { + SELECT forbidden FROM domains WHERE domain = $domain + } { + if {$forbidden} { + log warn "bad cookie: for a forbidden address" + } + return $forbidden + } + if {[regexp {^[^.]+\.(.+)$} $domain -> super] && [db exists { + SELECT 1 FROM forbiddenSuper WHERE domain = $super + }]} then { + log warn "bad cookie: for a forbidden address" + return 1 + } + return 0 + } + + # A defined extension point to allow users to easily impose extra policies + # on whether to accept cookies from a particular domain and path. + method policyAllow {operation domain path} { + return true + } + + method storeCookie {options} { + db transaction { + if {[my BadDomain $options]} { + return + } + set now [clock seconds] + set persistent [dict exists $options expires] + dict with options {} + if {!$persistent} { + if {![my policyAllow session $domain $path]} { + log warn "bad cookie: $domain prohibited by user policy" + return + } + db eval { + INSERT OR REPLACE INTO sessionCookies ( + secure, domain, path, key, value, originonly, creation, + lastuse) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, + $now, $now); + DELETE FROM persistentCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure AND originonly = $hostonly + } + incr deletions [db changes] + log debug "defined session cookie for %s" \ + [locn $secure $domain $path $key] + } elseif {$expires < $now} { + if {![my policyAllow delete $domain $path]} { + log warn "bad cookie: $domain prohibited by user policy" + return + } + db eval { + DELETE FROM persistentCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure AND originonly = $hostonly + } + set del [db changes] + db eval { + DELETE FROM sessionCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure AND originonly = $hostonly + } + incr deletions [incr del [db changes]] + log debug "deleted %d cookies for %s" \ + $del [locn $secure $domain $path $key] + } else { + if {![my policyAllow set $domain $path]} { + log warn "bad cookie: $domain prohibited by user policy" + return + } + db eval { + INSERT OR REPLACE INTO persistentCookies ( + secure, domain, path, key, value, originonly, expiry, + creation, lastuse) + VALUES ($secure, $domain, $path, $key, $value, $hostonly, + $expires, $now, $now); + DELETE FROM sessionCookies + WHERE domain = $domain AND path = $path AND key = $key + AND secure <= $secure AND originonly = $hostonly + } + incr deletions [db changes] + log debug "defined persistent cookie for %s, expires at %s" \ + [locn $secure $domain $path $key] \ + [clock format $expires] + } + } + } + + method PurgeCookies {} { + namespace upvar [info object namespace [self class]] \ + vacuumtrigger trigger retainlimit retain + my PostponePurge + set now [clock seconds] + log debug "purging cookies that expired before %s" [clock format $now] + db transaction { + db eval { + DELETE FROM persistentCookies WHERE expiry < $now + } + incr deletions [db changes] + db eval { + DELETE FROM persistentCookies WHERE id IN ( + SELECT id FROM persistentCookies ORDER BY lastuse ASC + LIMIT -1 OFFSET $retain) + } + incr deletions [db changes] + db eval { + DELETE FROM sessionCookies WHERE id IN ( + SELECT id FROM sessionCookies ORDER BY lastuse + LIMIT -1 OFFSET $retain) + } + incr deletions [db changes] + } + + # Once we've deleted a fair bit, vacuum the database. Must be done + # outside a transaction. + if {$deletions > $trigger} { + set deletions 0 + log debug "vacuuming cookie database" + catch { + db eval { + VACUUM + } + } + } + } + + forward Database db + + method lookup {{host ""} {key ""}} { + set host [string tolower [::tcl::idna encode $host]] + db transaction { + if {$host eq ""} { + set result {} + db eval { + SELECT DISTINCT domain FROM cookies + ORDER BY domain + } { + lappend result [::tcl::idna decode [string tolower $domain]] + } + return $result + } elseif {$key eq ""} { + set result {} + db eval { + SELECT DISTINCT key FROM cookies + WHERE domain = $host + ORDER BY key + } { + lappend result $key + } + return $result + } else { + db eval { + SELECT value FROM cookies + WHERE domain = $host AND key = $key + LIMIT 1 + } { + return $value + } + return -code error "no such key for that host" + } + } + } +} + +# Local variables: +# mode: tcl +# fill-column: 78 +# End: ADDED library/cookiejar/effective_tld_names.txt.gz Index: library/cookiejar/effective_tld_names.txt.gz ================================================================== --- /dev/null +++ library/cookiejar/effective_tld_names.txt.gz cannot compute difference between binary files ADDED library/cookiejar/idna.tcl Index: library/cookiejar/idna.tcl ================================================================== --- /dev/null +++ library/cookiejar/idna.tcl @@ -0,0 +1,292 @@ +# cookiejar.tcl -- +# +# Implementation of IDNA (Internationalized Domain Names for +# Applications) encoding/decoding system, built on a punycode engine +# developed directly from the code in RFC 3492, Appendix C (with +# substantial modifications). +# +# This implementation includes code from that RFC, translated to Tcl; the +# other parts are: +# Copyright (c) 2014 Donal K. Fellows +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +namespace eval ::tcl::idna { + namespace ensemble create -command puny -map { + encode punyencode + decode punydecode + } + namespace ensemble create -command ::tcl::idna -map { + encode IDNAencode + decode IDNAdecode + puny puny + version {::apply {{} {package present tcl::idna} ::}} + } + + proc IDNAencode hostname { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { + if {[regexp {[^-A-Za-z0-9]} $part]} { + if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} { + scan $ch %c c + if {$ch < "!" || $ch > "~"} { + set ch [format "\\u%04x" $c] + } + throw [list IDNA INVALID_NAME_CHARACTER $ch] \ + "bad character \"$ch\" in DNS name" + } + set part xn--[punyencode $part] + # Length restriction from RFC 5890, Sec 2.3.1 + if {[string length $part] > 63} { + throw [list IDNA OVERLONG_PART $part] \ + "hostname part too long" + } + } + lappend parts $part + } + return [join $parts .] + } + proc IDNAdecode hostname { + set parts {} + # Split term from RFC 3490, Sec 3.1 + foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { + if {[string match -nocase "xn--*" $part]} { + set part [punydecode [string range $part 4 end]] + } + lappend parts $part + } + return [join $parts .] + } + + variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] + # Bootstring parameters for Punycode + variable base 36 + variable tmin 1 + variable tmax 26 + variable skew 38 + variable damp 700 + variable initial_bias 72 + variable initial_n 0x80 + + variable max_codepoint 0x10FFFF + + proc adapt {delta first numchars} { + variable base + variable tmin + variable tmax + variable damp + variable skew + + set delta [expr {$delta / ($first ? $damp : 2)}] + incr delta [expr {$delta / $numchars}] + set k 0 + while {$delta > ($base - $tmin) * $tmax / 2} { + set delta [expr {$delta / ($base-$tmin)}] + incr k $base + } + return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}] + } + + # Main punycode encoding function + proc punyencode {string {case ""}} { + variable digits + variable tmin + variable tmax + variable base + variable initial_n + variable initial_bias + + if {![string is boolean $case]} { + return -code error "\"$case\" must be boolean" + } + + set in {} + foreach char [set string [split $string ""]] { + scan $char "%c" ch + lappend in $ch + } + set output {} + + # Initialize the state: + set n $initial_n + set delta 0 + set bias $initial_bias + + # Handle the basic code points: + foreach ch $string { + if {$ch < "\u0080"} { + if {$case eq ""} { + append output $ch + } elseif {[string is true $case]} { + append output [string toupper $ch] + } elseif {[string is false $case]} { + append output [string tolower $ch] + } + } + } + + set b [string length $output] + + # h is the number of code points that have been handled, b is the + # number of basic code points. + + if {$b > 0} { + append output "-" + } + + # Main encoding loop: + + for {set h $b} {$h < [llength $in]} {incr delta; incr n} { + # All non-basic code points < n have been handled already. Find + # the next larger one: + + set m inf + foreach ch $in { + if {$ch >= $n && $ch < $m} { + set m $ch + } + } + + # Increase delta enough to advance the decoder's state to + # , but guard against overflow: + + if {$m-$n > (0xFFFFFFFF-$delta)/($h+1)} { + throw {PUNYCODE OVERFLOW} "overflow in delta computation" + } + incr delta [expr {($m-$n) * ($h+1)}] + set n $m + + foreach ch $in { + if {$ch < $n && ([incr delta] & 0xFFFFFFFF) == 0} { + throw {PUNYCODE OVERFLOW} "overflow in delta computation" + } + + if {$ch != $n} { + continue + } + + # Represent delta as a generalized variable-length integer: + + for {set q $delta; set k $base} true {incr k $base} { + set t [expr {min(max($k-$bias, $tmin), $tmax)}] + if {$q < $t} { + break + } + append output \ + [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] + set q [expr {($q-$t) / ($base-$t)}] + } + + append output [lindex $digits $q] + set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] + set delta 0 + incr h + } + } + + return $output + } + + # Main punycode decode function + proc punydecode {string {case ""}} { + variable tmin + variable tmax + variable base + variable initial_n + variable initial_bias + variable max_codepoint + + if {![string is boolean $case]} { + return -code error "\"$case\" must be boolean" + } + + # Initialize the state: + + set n $initial_n + set i 0 + set first 1 + set bias $initial_bias + + # Split the string into the "real" ASCII characters and the ones to + # feed into the main decoder. Note that we don't need to check the + # result of [regexp] because that RE will technically match any string + # at all. + + regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post + if {[string is true -strict $case]} { + set pre [string toupper $pre] + } elseif {[string is false -strict $case]} { + set pre [string tolower $pre] + } + set output [split $pre ""] + set out [llength $output] + + # Main decoding loop: + + for {set in 0} {$in < [string length $post]} {incr in} { + # Decode a generalized variable-length integer into delta, which + # gets added to i. The overflow checking is easier if we increase + # i as we go, then subtract off its starting value at the end to + # obtain delta. + + for {set oldi $i; set w 1; set k $base} 1 {incr in} { + if {[set ch [string index $post $in]] eq ""} { + throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data" + } + if {[string match -nocase {[a-z]} $ch]} { + scan [string toupper $ch] %c digit + incr digit -65 + } elseif {[string match {[0-9]} $ch]} { + set digit [expr {$ch + 26}] + } else { + throw {PUNYCODE BAD_INPUT CHAR} \ + "bad decode character \"$ch\"" + } + incr i [expr {$digit * $w}] + set t [expr {min(max($tmin, $k-$bias), $tmax)}] + if {$digit < $t} { + set bias [adapt [expr {$i-$oldi}] $first [incr out]] + set first 0 + break + } + if {[set w [expr {$w * ($base - $t)}]] > 0x7FFFFFFF} { + throw {PUNYCODE OVERFLOW} \ + "excessively large integer computed in digit decode" + } + incr k $base + } + + # i was supposed to wrap around from out+1 to 0, incrementing n + # each time, so we'll fix that now: + + if {[incr n [expr {$i / $out}]] > 0x7FFFFFFF} { + throw {PUNYCODE OVERFLOW} \ + "excessively large integer computed in character choice" + } elseif {$n > $max_codepoint} { + if {$n >= 0x00D800 && $n < 0x00E000} { + # Bare surrogate?! + throw {PUNYCODE NON_BMP} \ + [format "unsupported character U+%06x" $n] + } + throw {PUNYCODE NON_UNICODE} "bad codepoint $n" + } + set i [expr {$i % $out}] + + # Insert n at position i of the output: + + set output [linsert $output $i [format "%c" $n]] + incr i + } + + return [join $output ""] + } +} + +package provide tcl::idna 1.0.1 + +# Local variables: +# mode: tcl +# fill-column: 78 +# End: ADDED library/cookiejar/pkgIndex.tcl Index: library/cookiejar/pkgIndex.tcl ================================================================== --- /dev/null +++ library/cookiejar/pkgIndex.tcl @@ -0,0 +1,3 @@ +if {![package vsatisfies [package provide Tcl] 8.6-]} {return} +package ifneeded cookiejar 0.2.0 [list source [file join $dir cookiejar.tcl]] +package ifneeded tcl::idna 1.0.1 [list source [file join $dir idna.tcl]] Index: library/dde/pkgIndex.tcl ================================================================== --- library/dde/pkgIndex.tcl +++ library/dde/pkgIndex.tcl @@ -1,7 +1,7 @@ -if {([info commands ::tcl::pkgconfig] eq "") - || ([info sharedlibextension] ne ".dll")} return +if {![package vsatisfies [package provide Tcl] 8.5-]} return +if {[info sharedlibextension] != ".dll"} return if {[::tcl::pkgconfig get debug]} { - package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde] + package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] dde] } else { - package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde] + package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde] } Index: library/encoding/tis-620.enc ================================================================== --- library/encoding/tis-620.enc +++ library/encoding/tis-620.enc DELETED library/http/cookiejar.tcl Index: library/http/cookiejar.tcl ================================================================== --- library/http/cookiejar.tcl +++ /dev/null @@ -1,745 +0,0 @@ -# cookiejar.tcl -- -# -# Implementation of an HTTP cookie storage engine using SQLite. The -# implementation is done as a TclOO class, and includes a punycode -# encoder and decoder (though only the encoder is currently used). -# -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. - -# Dependencies -package require Tcl 8.6- -package require http 2.8.4 -package require sqlite3 -package require tcl::idna 1.0 - -# -# Configuration for the cookiejar package, plus basic support procedures. -# - -# This is the class that we are creating -if {![llength [info commands ::http::cookiejar]]} { - ::oo::class create ::http::cookiejar -} - -namespace eval [info object namespace ::http::cookiejar] { - proc setInt {*var val} { - upvar 1 ${*var} var - if {[catch {incr dummy $val} msg]} { - return -code error $msg - } - set var $val - } - proc setInterval {trigger *var val} { - upvar 1 ${*var} var - if {![string is integer -strict $val] || $val < 1} { - return -code error "expected positive integer but got \"$val\"" - } - set var $val - {*}$trigger - } - proc setBool {*var val} { - upvar 1 ${*var} var - if {[catch {if {$val} {}} msg]} { - return -code error $msg - } - set var [expr {!!$val}] - } - - proc setLog {*var val} { - upvar 1 ${*var} var - set var [::tcl::prefix match -message "log level" \ - {debug info warn error} $val] - } - - # Keep this in sync with pkgIndex.tcl and with the install directories in - # Makefiles - variable version 0.1 - - variable domainlist \ - http://publicsuffix.org/list/effective_tld_names.dat - variable domainfile \ - [file join [file dirname [info script]] effective_tld_names.txt.gz] - # The list is directed to from http://publicsuffix.org/list/ - variable loglevel info - variable vacuumtrigger 200 - variable retainlimit 100 - variable offline false - variable purgeinterval 60000 - variable refreshinterval 10000000 - variable domaincache {} - - # Some support procedures, none particularly useful in general - namespace eval support { - # Set up a logger if the http package isn't actually loaded yet. - if {![llength [info commands ::http::Log]]} { - proc ::http::Log args { - # Do nothing by default... - } - } - - namespace export * - proc locn {secure domain path {key ""}} { - if {$key eq ""} { - format "%s://%s%s" [expr {$secure?"https":"http"}] \ - [::tcl::idna encode $domain] $path - } else { - format "%s://%s%s?%s" \ - [expr {$secure?"https":"http"}] [::tcl::idna encode $domain] \ - $path $key - } - } - proc splitDomain domain { - set pieces [split $domain "."] - for {set i [llength $pieces]} {[incr i -1] >= 0} {} { - lappend result [join [lrange $pieces $i end] "."] - } - return $result - } - proc splitPath path { - set pieces [split [string trimleft $path "/"] "/"] - for {set j -1} {$j < [llength $pieces]} {incr j} { - lappend result /[join [lrange $pieces 0 $j] "/"] - } - return $result - } - proc isoNow {} { - set ms [clock milliseconds] - set ts [expr {$ms / 1000}] - set ms [format %03d [expr {$ms % 1000}]] - clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1 - } - proc log {level msg args} { - namespace upvar [info object namespace ::http::cookiejar] \ - loglevel loglevel - set who [uplevel 1 self class] - set mth [uplevel 1 self method] - set map {debug 0 info 1 warn 2 error 3} - if {[string map $map $level] >= [string map $map $loglevel]} { - set msg [format $msg {*}$args] - set LVL [string toupper $level] - ::http::Log "[isoNow] $LVL $who $mth - $msg" - } - } - } -} - -# Now we have enough information to provide the package. -package provide cookiejar \ - [set [info object namespace ::http::cookiejar]::version] - -# The implementation of the cookiejar package -::oo::define ::http::cookiejar { - self { - method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} { - set tbl { - -domainfile {domainfile set} - -domainlist {domainlist set} - -domainrefresh {refreshinterval setInterval} - -loglevel {loglevel setLog} - -offline {offline setBool} - -purgeold {purgeinterval setInterval} - -retain {retainlimit setInt} - -vacuumtrigger {vacuumtrigger setInt} - } - dict lappend tbl -domainrefresh [namespace code { - my IntervalTrigger PostponeRefresh - }] - dict lappend tbl -purgeold [namespace code { - my IntervalTrigger PostponePurge - }] - if {$optionName eq "\u0000\u0000"} { - return [dict keys $tbl] - } - set opt [::tcl::prefix match -message "option" \ - [dict keys $tbl] $optionName] - set setter [lassign [dict get $tbl $opt] varname] - namespace upvar [namespace current] $varname var - if {$optionValue ne "\u0000\u0000"} { - {*}$setter var $optionValue - } - return $var - } - - method IntervalTrigger {method} { - # TODO: handle subclassing - foreach obj [info class instances [self]] { - [info object namespace $obj]::my $method - } - } - } - - variable purgeTimer deletions refreshTimer - constructor {{path ""}} { - namespace import [info object namespace [self class]]::support::* - - if {$path eq ""} { - sqlite3 [namespace current]::db :memory: - set storeorigin "constructed cookie store in memory" - } else { - sqlite3 [namespace current]::db $path - db timeout 500 - set storeorigin "loaded cookie store from $path" - } - - set deletions 0 - db transaction { - db eval { - --;# Store the persistent cookies in this table. - --;# Deletion policy: once they expire, or if explicitly - --;# killed. - CREATE TABLE IF NOT EXISTS persistentCookies ( - id INTEGER PRIMARY KEY, - secure INTEGER NOT NULL, - domain TEXT NOT NULL COLLATE NOCASE, - path TEXT NOT NULL, - key TEXT NOT NULL, - value TEXT NOT NULL, - originonly INTEGER NOT NULL, - expiry INTEGER NOT NULL, - lastuse INTEGER NOT NULL, - creation INTEGER NOT NULL); - CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique - ON persistentCookies (domain, path, key); - CREATE INDEX IF NOT EXISTS persistentLookup - ON persistentCookies (domain, path); - - --;# Store the session cookies in this table. - --;# Deletion policy: at cookiejar instance deletion, if - --;# explicitly killed, or if the number of session cookies is - --;# too large and the cookie has not been used recently. - CREATE TEMP TABLE sessionCookies ( - id INTEGER PRIMARY KEY, - secure INTEGER NOT NULL, - domain TEXT NOT NULL COLLATE NOCASE, - path TEXT NOT NULL, - key TEXT NOT NULL, - originonly INTEGER NOT NULL, - value TEXT NOT NULL, - lastuse INTEGER NOT NULL, - creation INTEGER NOT NULL); - CREATE UNIQUE INDEX sessionUnique - ON sessionCookies (domain, path, key); - CREATE INDEX sessionLookup ON sessionCookies (domain, path); - - --;# View to allow for simple looking up of a cookie. - --;# Deletion policy: NOT SUPPORTED via this view. - CREATE TEMP VIEW cookies AS - SELECT id, domain, ( - CASE originonly WHEN 1 THEN path ELSE '.' || path END - ) AS path, key, value, secure, 1 AS persistent - FROM persistentCookies - UNION - SELECT id, domain, ( - CASE originonly WHEN 1 THEN path ELSE '.' || path END - ) AS path, key, value, secure, 0 AS persistent - FROM sessionCookies; - - --;# Encoded domain permission policy; if forbidden is 1, no - --;# cookie may be ever set for the domain, and if forbidden - --;# is 0, cookies *may* be created for the domain (overriding - --;# the forbiddenSuper table). - --;# Deletion policy: normally not modified. - CREATE TABLE IF NOT EXISTS domains ( - domain TEXT PRIMARY KEY NOT NULL, - forbidden INTEGER NOT NULL); - - --;# Domains that may not have a cookie defined for direct - --;# child domains of them. - --;# Deletion policy: normally not modified. - CREATE TABLE IF NOT EXISTS forbiddenSuper ( - domain TEXT PRIMARY KEY); - - --;# When we last retrieved the domain list. - CREATE TABLE IF NOT EXISTS domainCacheMetadata ( - id INTEGER PRIMARY KEY, - retrievalDate INTEGER, - installDate INTEGER); - } - - set cookieCount "no" - db eval { - SELECT COUNT(*) AS cookieCount FROM persistentCookies - } - log info "%s with %s entries" $storeorigin $cookieCount - - my PostponePurge - - if {$path ne ""} { - if {[db exists {SELECT 1 FROM domains}]} { - my RefreshDomains - } else { - my InitDomainList - my PostponeRefresh - } - } else { - set data [my GetDomainListOffline metadata] - my InstallDomainData $data $metadata - my PostponeRefresh - } - } - } - - method PostponePurge {} { - namespace upvar [info object namespace [self class]] \ - purgeinterval interval - catch {after cancel $purgeTimer} - set purgeTimer [after $interval [namespace code {my PurgeCookies}]] - } - - method PostponeRefresh {} { - namespace upvar [info object namespace [self class]] \ - refreshinterval interval - catch {after cancel $refreshTimer} - set refreshTimer [after $interval [namespace code {my RefreshDomains}]] - } - - method RefreshDomains {} { - # TODO: domain list refresh policy - my PostponeRefresh - } - - method HttpGet {url {timeout 0} {maxRedirects 5}} { - for {set r 0} {$r < $maxRedirects} {incr r} { - set tok [::http::geturl $url -timeout $timeout] - try { - if {[::http::status $tok] eq "timeout"} { - return -code error "connection timed out" - } elseif {[::http::ncode $tok] == 200} { - return [::http::data $tok] - } elseif {[::http::ncode $tok] >= 400} { - return -code error [::http::error $tok] - } elseif {[dict exists [::http::meta $tok] Location]} { - set url [dict get [::http::meta $tok] Location] - continue - } - return -code error \ - "unexpected state: [::http::code $tok]" - } finally { - ::http::cleanup $tok - } - } - return -code error "too many redirects" - } - method GetDomainListOnline {metaVar} { - upvar 1 $metaVar meta - namespace upvar [info object namespace [self class]] \ - domainlist url domaincache cache - lassign $cache when data - if {$when > [clock seconds] - 3600} { - log debug "using cached value created at %s" \ - [clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1] - dict set meta retrievalDate $when - return $data - } - log debug "loading domain list from %s" $url - try { - set when [clock seconds] - set data [my HttpGet $url] - set cache [list $when $data] - # TODO: Should we use the Last-Modified header instead? - dict set meta retrievalDate $when - return $data - } on error msg { - log error "failed to fetch list of forbidden cookie domains from %s: %s" \ - $url $msg - return {} - } - } - method GetDomainListOffline {metaVar} { - upvar 1 $metaVar meta - namespace upvar [info object namespace [self class]] \ - domainfile filename - log debug "loading domain list from %s" $filename - try { - set f [open $filename] - try { - if {[string match *.gz $filename]} { - zlib push gunzip $f - } - fconfigure $f -encoding utf-8 - dict set meta retrievalDate [file mtime $filename] - return [read $f] - } finally { - close $f - } - } on error {msg opt} { - log error "failed to read list of forbidden cookie domains from %s: %s" \ - $filename $msg - return -options $opt $msg - } - } - method InitDomainList {} { - namespace upvar [info object namespace [self class]] \ - offline offline - if {!$offline} { - try { - set data [my GetDomainListOnline metadata] - if {[string length $data]} { - my InstallDomainData $data $metadata - return - } - } on error {} { - log warn "attempting to fall back to built in version" - } - } - set data [my GetDomainListOffline metadata] - my InstallDomainData $data $metadata - } - - method InstallDomainData {data meta} { - set n [db total_changes] - db transaction { - foreach line [split $data "\n"] { - if {[string trim $line] eq ""} { - continue - } elseif {[string match //* $line]} { - continue - } elseif {[string match !* $line]} { - set line [string range $line 1 end] - set idna [string tolower [::tcl::idna encode $line]] - set utf [::tcl::idna decode [string tolower $line]] - db eval { - INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($utf, 0); - } - if {$idna ne $utf} { - db eval { - INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($idna, 0); - } - } - } else { - if {[string match {\*.*} $line]} { - set line [string range $line 2 end] - set idna [string tolower [::tcl::idna encode $line]] - set utf [::tcl::idna decode [string tolower $line]] - db eval { - INSERT OR REPLACE INTO forbiddenSuper (domain) - VALUES ($utf); - } - if {$idna ne $utf} { - db eval { - INSERT OR REPLACE INTO forbiddenSuper (domain) - VALUES ($idna); - } - } - } else { - set idna [string tolower [::tcl::idna encode $line]] - set utf [::tcl::idna decode [string tolower $line]] - } - db eval { - INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($utf, 1); - } - if {$idna ne $utf} { - db eval { - INSERT OR REPLACE INTO domains (domain, forbidden) - VALUES ($idna, 1); - } - } - } - if {$utf ne [::tcl::idna decode [string tolower $idna]]} { - log warn "mismatch in IDNA handling for %s (%d, %s, %s)" \ - $idna $line $utf [::tcl::idna decode $idna] - } - } - - dict with meta { - set installDate [clock seconds] - db eval { - INSERT OR REPLACE INTO domainCacheMetadata - (id, retrievalDate, installDate) - VALUES (1, $retrievalDate, $installDate); - } - } - } - set n [expr {[db total_changes] - $n}] - log info "constructed domain info with %d entries" $n - } - - # This forces the rebuild of the domain data, loading it from - method forceLoadDomainData {} { - db transaction { - db eval { - DELETE FROM domains; - DELETE FROM forbiddenSuper; - INSERT OR REPLACE INTO domainCacheMetadata - (id, retrievalDate, installDate) - VALUES (1, -1, -1); - } - my InitDomainList - } - } - - destructor { - catch { - after cancel $purgeTimer - } - catch { - after cancel $refreshTimer - } - catch { - db close - } - return - } - - method GetCookiesForHostAndPath {listVar secure host path fullhost} { - upvar 1 $listVar result - log debug "check for cookies for %s" [locn $secure $host $path] - set exact [expr {$host eq $fullhost}] - db eval { - SELECT key, value FROM persistentCookies - WHERE domain = $host AND path = $path AND secure <= $secure - AND (NOT originonly OR domain = $fullhost) - AND originonly = $exact - } { - lappend result $key $value - db eval { - UPDATE persistentCookies SET lastuse = $now WHERE id = $id - } - } - set now [clock seconds] - db eval { - SELECT id, key, value FROM sessionCookies - WHERE domain = $host AND path = $path AND secure <= $secure - AND (NOT originonly OR domain = $fullhost) - AND originonly = $exact - } { - lappend result $key $value - db eval { - UPDATE sessionCookies SET lastuse = $now WHERE id = $id - } - } - } - - method getCookies {proto host path} { - set result {} - set paths [splitPath $path] - if {[regexp {[^0-9.]} $host]} { - set domains [splitDomain [string tolower [::tcl::idna encode $host]]] - } else { - # Ugh, it's a numeric domain! Restrict it to just itself... - set domains [list $host] - } - set secure [string equal -nocase $proto "https"] - # Open question: how to move these manipulations into the database - # engine (if that's where they *should* be). - # - # Suggestion from kbk: - #LENGTH(theColumn) <= LENGTH($queryStr) AND - #SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr - # - # However, we instead do most of the work in Tcl because that lets us - # do the splitting exactly right, and it's far easier to work with - # strings in Tcl than in SQL. - db transaction { - foreach domain $domains { - foreach p $paths { - my GetCookiesForHostAndPath result $secure $domain $p $host - } - } - return $result - } - } - - method BadDomain options { - if {![dict exists $options domain]} { - log error "no domain present in options" - return 0 - } - dict with options {} - if {$domain ne $origin} { - log debug "cookie domain varies from origin (%s, %s)" \ - $domain $origin - if {[string match .* $domain]} { - set dotd $domain - } else { - set dotd .$domain - } - if {![string equal -length [string length $dotd] \ - [string reverse $dotd] [string reverse $origin]]} { - log warn "bad cookie: domain not suffix of origin" - return 1 - } - } - if {![regexp {[^0-9.]} $domain]} { - if {$domain eq $origin} { - # May set for itself - return 0 - } - log warn "bad cookie: for a numeric address" - return 1 - } - db eval { - SELECT forbidden FROM domains WHERE domain = $domain - } { - if {$forbidden} { - log warn "bad cookie: for a forbidden address" - } - return $forbidden - } - if {[regexp {^[^.]+\.(.+)$} $domain -> super] && [db exists { - SELECT 1 FROM forbiddenSuper WHERE domain = $super - }]} then { - log warn "bad cookie: for a forbidden address" - return 1 - } - return 0 - } - - # A defined extension point to allow users to easily impose extra policies - # on whether to accept cookies from a particular domain and path. - method policyAllow {operation domain path} { - return true - } - - method storeCookie {options} { - db transaction { - if {[my BadDomain $options]} { - return - } - set now [clock seconds] - set persistent [dict exists $options expires] - dict with options {} - if {!$persistent} { - if {![my policyAllow session $domain $path]} { - log warn "bad cookie: $domain prohibited by user policy" - return - } - db eval { - INSERT OR REPLACE INTO sessionCookies ( - secure, domain, path, key, value, originonly, creation, - lastuse) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, - $now, $now); - DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure AND originonly = $hostonly - } - incr deletions [db changes] - log debug "defined session cookie for %s" \ - [locn $secure $domain $path $key] - } elseif {$expires < $now} { - if {![my policyAllow delete $domain $path]} { - log warn "bad cookie: $domain prohibited by user policy" - return - } - db eval { - DELETE FROM persistentCookies - WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure AND originonly = $hostonly - } - set del [db changes] - db eval { - DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure AND originonly = $hostonly - } - incr deletions [incr del [db changes]] - log debug "deleted %d cookies for %s" \ - $del [locn $secure $domain $path $key] - } else { - if {![my policyAllow set $domain $path]} { - log warn "bad cookie: $domain prohibited by user policy" - return - } - db eval { - INSERT OR REPLACE INTO persistentCookies ( - secure, domain, path, key, value, originonly, expiry, - creation, lastuse) - VALUES ($secure, $domain, $path, $key, $value, $hostonly, - $expires, $now, $now); - DELETE FROM sessionCookies - WHERE domain = $domain AND path = $path AND key = $key - AND secure <= $secure AND originonly = $hostonly - } - incr deletions [db changes] - log debug "defined persistent cookie for %s, expires at %s" \ - [locn $secure $domain $path $key] \ - [clock format $expires] - } - } - } - - method PurgeCookies {} { - namespace upvar [info object namespace [self class]] \ - vacuumtrigger trigger retainlimit retain - my PostponePurge - set now [clock seconds] - log debug "purging cookies that expired before %s" [clock format $now] - db transaction { - db eval { - DELETE FROM persistentCookies WHERE expiry < $now - } - incr deletions [db changes] - db eval { - DELETE FROM persistentCookies WHERE id IN ( - SELECT id FROM persistentCookies ORDER BY lastuse ASC - LIMIT -1 OFFSET $retain) - } - incr deletions [db changes] - db eval { - DELETE FROM sessionCookies WHERE id IN ( - SELECT id FROM sessionCookies ORDER BY lastuse - LIMIT -1 OFFSET $retain) - } - incr deletions [db changes] - } - - # Once we've deleted a fair bit, vacuum the database. Must be done - # outside a transaction. - if {$deletions > $trigger} { - set deletions 0 - log debug "vacuuming cookie database" - catch { - db eval { - VACUUM - } - } - } - } - - forward Database db - - method lookup {{host ""} {key ""}} { - set host [string tolower [::tcl::idna encode $host]] - db transaction { - if {$host eq ""} { - set result {} - db eval { - SELECT DISTINCT domain FROM cookies - ORDER BY domain - } { - lappend result [::tcl::idna decode [string tolower $domain]] - } - return $result - } elseif {$key eq ""} { - set result {} - db eval { - SELECT DISTINCT key FROM cookies - WHERE domain = $host - ORDER BY key - } { - lappend result $key - } - return $result - } else { - db eval { - SELECT value FROM cookies - WHERE domain = $host AND key = $key - LIMIT 1 - } { - return $value - } - return -code error "no such key for that host" - } - } - } -} - -# Local variables: -# mode: tcl -# fill-column: 78 -# End: DELETED library/http/effective_tld_names.txt.gz Index: library/http/effective_tld_names.txt.gz ================================================================== --- library/http/effective_tld_names.txt.gz +++ /dev/null cannot compute difference between binary files Index: library/http/http.tcl ================================================================== --- library/http/http.tcl +++ library/http/http.tcl @@ -9,11 +9,11 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.0 +package provide http 2.9.1 namespace eval http { # Allow resourcing to not clobber existing data variable http @@ -3018,11 +3018,11 @@ } # There's a bunch of XML-as-application-format things about. See RFC 3023 # and so on. if {$major eq "application"} { set minor [string trimright $minor] - if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} { + if {$minor in {"json" "xml" "xml-external-parsed-entity" "xml-dtd"}} { return false } } # Not just application/foobar+xml but also image/svg+xml, so let us not # restrict things for now... DELETED library/http/idna.tcl Index: library/http/idna.tcl ================================================================== --- library/http/idna.tcl +++ /dev/null @@ -1,292 +0,0 @@ -# cookiejar.tcl -- -# -# Implementation of IDNA (Internationalized Domain Names for -# Applications) encoding/decoding system, built on a punycode engine -# developed directly from the code in RFC 3492, Appendix C (with -# substantial modifications). -# -# This implementation includes code from that RFC, translated to Tcl; the -# other parts are: -# Copyright (c) 2014 Donal K. Fellows -# -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. - -namespace eval ::tcl::idna { - namespace ensemble create -command puny -map { - encode punyencode - decode punydecode - } - namespace ensemble create -command ::tcl::idna -map { - encode IDNAencode - decode IDNAdecode - puny puny - version {::apply {{} {package present tcl::idna} ::}} - } - - proc IDNAencode hostname { - set parts {} - # Split term from RFC 3490, Sec 3.1 - foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { - if {[regexp {[^-A-Za-z0-9]} $part]} { - if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} { - scan $ch %c c - if {$ch < "!" || $ch > "~"} { - set ch [format "\\u%04x" $c] - } - throw [list IDNA INVALID_NAME_CHARACTER $ch] \ - "bad character \"$ch\" in DNS name" - } - set part xn--[punyencode $part] - # Length restriction from RFC 5890, Sec 2.3.1 - if {[string length $part] > 63} { - throw [list IDNA OVERLONG_PART $part] \ - "hostname part too long" - } - } - lappend parts $part - } - return [join $parts .] - } - proc IDNAdecode hostname { - set parts {} - # Split term from RFC 3490, Sec 3.1 - foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] { - if {[string match -nocase "xn--*" $part]} { - set part [punydecode [string range $part 4 end]] - } - lappend parts $part - } - return [join $parts .] - } - - variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""] - # Bootstring parameters for Punycode - variable base 36 - variable tmin 1 - variable tmax 26 - variable skew 38 - variable damp 700 - variable initial_bias 72 - variable initial_n 0x80 - - variable max_codepoint 0x10FFFF - - proc adapt {delta first numchars} { - variable base - variable tmin - variable tmax - variable damp - variable skew - - set delta [expr {$delta / ($first ? $damp : 2)}] - incr delta [expr {$delta / $numchars}] - set k 0 - while {$delta > ($base - $tmin) * $tmax / 2} { - set delta [expr {$delta / ($base-$tmin)}] - incr k $base - } - return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}] - } - - # Main punycode encoding function - proc punyencode {string {case ""}} { - variable digits - variable tmin - variable tmax - variable base - variable initial_n - variable initial_bias - - if {![string is boolean $case]} { - return -code error "\"$case\" must be boolean" - } - - set in {} - foreach char [set string [split $string ""]] { - scan $char "%c" ch - lappend in $ch - } - set output {} - - # Initialize the state: - set n $initial_n - set delta 0 - set bias $initial_bias - - # Handle the basic code points: - foreach ch $string { - if {$ch < "\u0080"} { - if {$case eq ""} { - append output $ch - } elseif {[string is true $case]} { - append output [string toupper $ch] - } elseif {[string is false $case]} { - append output [string tolower $ch] - } - } - } - - set b [string length $output] - - # h is the number of code points that have been handled, b is the - # number of basic code points. - - if {$b > 0} { - append output "-" - } - - # Main encoding loop: - - for {set h $b} {$h < [llength $in]} {incr delta; incr n} { - # All non-basic code points < n have been handled already. Find - # the next larger one: - - set m inf - foreach ch $in { - if {$ch >= $n && $ch < $m} { - set m $ch - } - } - - # Increase delta enough to advance the decoder's state to - # , but guard against overflow: - - if {$m-$n > (0xffffffff-$delta)/($h+1)} { - throw {PUNYCODE OVERFLOW} "overflow in delta computation" - } - incr delta [expr {($m-$n) * ($h+1)}] - set n $m - - foreach ch $in { - if {$ch < $n && ([incr delta] & 0xffffffff) == 0} { - throw {PUNYCODE OVERFLOW} "overflow in delta computation" - } - - if {$ch != $n} { - continue - } - - # Represent delta as a generalized variable-length integer: - - for {set q $delta; set k $base} true {incr k $base} { - set t [expr {min(max($k-$bias, $tmin), $tmax)}] - if {$q < $t} { - break - } - append output \ - [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]] - set q [expr {($q-$t) / ($base-$t)}] - } - - append output [lindex $digits $q] - set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]] - set delta 0 - incr h - } - } - - return $output - } - - # Main punycode decode function - proc punydecode {string {case ""}} { - variable tmin - variable tmax - variable base - variable initial_n - variable initial_bias - variable max_codepoint - - if {![string is boolean $case]} { - return -code error "\"$case\" must be boolean" - } - - # Initialize the state: - - set n $initial_n - set i 0 - set first 1 - set bias $initial_bias - - # Split the string into the "real" ASCII characters and the ones to - # feed into the main decoder. Note that we don't need to check the - # result of [regexp] because that RE will technically match any string - # at all. - - regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post - if {[string is true -strict $case]} { - set pre [string toupper $pre] - } elseif {[string is false -strict $case]} { - set pre [string tolower $pre] - } - set output [split $pre ""] - set out [llength $output] - - # Main decoding loop: - - for {set in 0} {$in < [string length $post]} {incr in} { - # Decode a generalized variable-length integer into delta, which - # gets added to i. The overflow checking is easier if we increase - # i as we go, then subtract off its starting value at the end to - # obtain delta. - - for {set oldi $i; set w 1; set k $base} 1 {incr in} { - if {[set ch [string index $post $in]] eq ""} { - throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data" - } - if {[string match -nocase {[a-z]} $ch]} { - scan [string toupper $ch] %c digit - incr digit -65 - } elseif {[string match {[0-9]} $ch]} { - set digit [expr {$ch + 26}] - } else { - throw {PUNYCODE BAD_INPUT CHAR} \ - "bad decode character \"$ch\"" - } - incr i [expr {$digit * $w}] - set t [expr {min(max($tmin, $k-$bias), $tmax)}] - if {$digit < $t} { - set bias [adapt [expr {$i-$oldi}] $first [incr out]] - set first 0 - break - } - if {[set w [expr {$w * ($base - $t)}]] > 0x7fffffff} { - throw {PUNYCODE OVERFLOW} \ - "excessively large integer computed in digit decode" - } - incr k $base - } - - # i was supposed to wrap around from out+1 to 0, incrementing n - # each time, so we'll fix that now: - - if {[incr n [expr {$i / $out}]] > 0x7fffffff} { - throw {PUNYCODE OVERFLOW} \ - "excessively large integer computed in character choice" - } elseif {$n > $max_codepoint} { - if {$n >= 0x00d800 && $n < 0x00e000} { - # Bare surrogate?! - throw {PUNYCODE NON_BMP} \ - [format "unsupported character U+%06x" $n] - } - throw {PUNYCODE NON_UNICODE} "bad codepoint $n" - } - set i [expr {$i % $out}] - - # Insert n at position i of the output: - - set output [linsert $output $i [format "%c" $n]] - incr i - } - - return [join $output ""] - } -} - -package provide tcl::idna 1.0 - -# Local variables: -# mode: tcl -# fill-column: 78 -# End: Index: library/http/pkgIndex.tcl ================================================================== --- library/http/pkgIndex.tcl +++ library/http/pkgIndex.tcl @@ -1,4 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] -package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]] -package ifneeded tcl::idna 1.0 [list source [file join $dir idna.tcl]] +package ifneeded http 2.9.1 [list tclPkgSetup $dir http 2.9.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] Index: library/init.tcl ================================================================== --- library/init.tcl +++ library/init.tcl @@ -17,11 +17,11 @@ # This test intentionally written in pre-7.5 Tcl if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 9.0a0 +package require -exact Tcl 8.7a4 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: # # The environment variable TCLLIBPATH @@ -58,17 +58,17 @@ set Dir [file join [file dirname [file dirname \ [info nameofexecutable]]] lib] if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } - catch { + if {[info exists ::tcl_pkgPath]} { catch { foreach Dir $::tcl_pkgPath { if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } } - } + }} if {![interp issafe]} { variable Path [encoding dirs] set Dir [file join $::tcl_library encoding] if {$Dir ni $Path} { @@ -614,11 +614,13 @@ } return "" } set path "[file dirname [info nameof]];.;" - if {[info exists env(WINDIR)]} { + if {[info exists env(SystemRoot)]} { + set windir $env(SystemRoot) + } elseif {[info exists env(WINDIR)]} { set windir $env(WINDIR) } if {[info exists windir]} { append path "$windir/system32;$windir/system;$windir;" } Index: library/manifest.txt ================================================================== --- library/manifest.txt +++ library/manifest.txt @@ -3,16 +3,18 @@ ### apply {{dir} { set ::test [info script] set isafe [interp issafe] foreach {safe package version file} { - 0 http 2.9.0 {http http.tcl} + 0 http 2.9.1 {http http.tcl} 1 msgcat 1.7.0 {msgcat msgcat.tcl} 1 opt 0.4.7 {opt optparse.tcl} + 0 cookiejar 0.2.0 {cookiejar cookiejar.tcl} + 0 tcl::idna 1.0.1 {cookiejar idna.tcl} 0 platform 1.0.14 {platform platform.tcl} 0 platform::shell 1.1.4 {platform shell.tcl} - 1 tcltest 2.5.0 {tcltest tcltest.tcl} + 1 tcltest 2.5.3 {tcltest tcltest.tcl} } { if {$isafe && !$safe} continue package ifneeded $package $version [list source [file join $dir {*}$file]] } }} $dir Index: library/reg/pkgIndex.tcl ================================================================== --- library/reg/pkgIndex.tcl +++ library/reg/pkgIndex.tcl @@ -1,9 +1,9 @@ -if {([info commands ::tcl::pkgconfig] eq "") - || ([info sharedlibextension] ne ".dll")} return +if {![package vsatisfies [package provide Tcl] 8.5-]} return +if {[info sharedlibextension] != ".dll"} return if {[::tcl::pkgconfig get debug]} { - package ifneeded registry 1.3.3 \ + package ifneeded registry 1.3.5 \ [list load [file join $dir tclreg13g.dll] registry] } else { - package ifneeded registry 1.3.3 \ + package ifneeded registry 1.3.5 \ [list load [file join $dir tclreg13.dll] registry] } Index: library/safe.tcl ================================================================== --- library/safe.tcl +++ library/safe.tcl @@ -18,11 +18,11 @@ # Private procs starts with uppercase. # Public procs are exported and starts with lowercase # # Needed utilities package -package require opt 0.4.1 +package require opt 0.4.7 # Create the safe namespace namespace eval ::safe { # Exported API: namespace export interpCreate interpInit interpConfigure interpDelete \ @@ -111,11 +111,11 @@ # This is even more complicated by the boolean flags with no values that # we had the bad idea to support for the sake of user simplicity in # create/init but which makes life hard in configure... # So this will be hopefully written and some integrated with opt1.0 -# (hopefully for tcl9.0 ?) +# (hopefully for tcl8.1 ?) proc ::safe::interpConfigure {args} { switch [llength $args] { 1 { # If we have exactly 1 argument the semantic is to return all # the current configuration. We still call OptKeyParse though Index: library/tcltest/pkgIndex.tcl ================================================================== --- library/tcltest/pkgIndex.tcl +++ library/tcltest/pkgIndex.tcl @@ -7,6 +7,6 @@ # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.5.3 [list source [file join $dir tcltest.tcl]] Index: library/tcltest/tcltest.tcl ================================================================== --- library/tcltest/tcltest.tcl +++ library/tcltest/tcltest.tcl @@ -20,11 +20,11 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.5.0 + variable Version 2.5.3 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] @@ -968,11 +968,11 @@ DebugPuts 3 "entering testConstraint $constraint $value" if {[llength [info level 0]] == 2} { return $testConstraints($constraint) } # Check for boolean values - if {[catch {expr {$value && $value}} msg]} { + if {[catch {expr {$value && 1}} msg]} { return -code error $msg } if {[limitConstraints] && ($constraint ni $Option(-constraints))} { set value 0 } @@ -1980,20 +1980,28 @@ if {[file exists [file join [workingDirectory] core]]} { set coreModTime [file mtime [file join [workingDirectory] core]] } } - # First, run the setup script + # First, run the setup script (or a hook if it presents): + if {[set cmd [namespace which -command [namespace current]::SetupTest]] ne ""} { + set setup [list $cmd $setup] + } + set processTest 1 set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup) $::errorCode + if {$errorCodeRes(setup) eq "BYPASS-SKIPPED-TEST"} { + _noticeSkipped $name $setupMsg + set processTest [set code 0] + } } set setupFailure [expr {$code != 0}] # Only run the test body if the setup was successful - if {!$setupFailure} { + if {$processTest && !$setupFailure} { # Register startup time if {[IsVerbose msec] || [IsVerbose usec]} { set timeStart [clock microseconds] } @@ -2012,29 +2020,33 @@ } lassign $testResult actualAnswer returnCode if {$returnCode == 1} { set errorInfo(body) $::errorInfo set errorCodeRes(body) $::errorCode + if {$errorCodeRes(body) eq "BYPASS-SKIPPED-TEST"} { + _noticeSkipped $name $actualAnswer + set processTest [set returnCode 0] + } } } # check if the return code matched the expected return code set codeFailure 0 - if {!$setupFailure && ($returnCode ni $returnCodes)} { + if {$processTest && !$setupFailure && ($returnCode ni $returnCodes)} { set codeFailure 1 } set errorCodeFailure 0 - if {!$setupFailure && !$codeFailure && $returnCode == 1 && \ + if {$processTest && !$setupFailure && !$codeFailure && $returnCode == 1 && \ ![string match $errorCode $errorCodeRes(body)]} { set errorCodeFailure 1 } # If expected output/error strings exist, we have to compare # them. If the comparison fails, then so did the test. set outputFailure 0 variable outData - if {[info exists output] && !$codeFailure} { + if {$processTest && [info exists output] && !$codeFailure} { if {[set outputCompare [catch { CompareStrings $outData $output $match } outputMatch]] == 0} { set outputFailure [expr {!$outputMatch}] } else { @@ -2042,11 +2054,11 @@ } } set errorFailure 0 variable errData - if {[info exists errorOutput] && !$codeFailure} { + if {$processTest && [info exists errorOutput] && !$codeFailure} { if {[set errorCompare [catch { CompareStrings $errData $errorOutput $match } errorMatch]] == 0} { set errorFailure [expr {!$errorMatch}] } else { @@ -2054,21 +2066,26 @@ } } # check if the answer matched the expected answer # Only check if we ran the body of the test (no setup failure) - if {$setupFailure || $codeFailure} { + if {!$processTest} { + set scriptFailure 0 + } elseif {$setupFailure || $codeFailure} { set scriptFailure 0 } elseif {[set scriptCompare [catch { CompareStrings $actualAnswer $result $match } scriptMatch]] == 0} { set scriptFailure [expr {!$scriptMatch}] } else { set scriptFailure 1 } - # Always run the cleanup script + # Always run the cleanup script (or a hook if it presents): + if {[set cmd [namespace which -command [namespace current]::CleanupTest]] ne ""} { + set cleanup [list $cmd $cleanup] + } set code [catch {uplevel 1 $cleanup} cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo set errorCodeRes(cleanup) $::errorCode } @@ -2114,10 +2131,16 @@ } if {[IsVerbose msec]} { puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms" } } + + # if skipped, it is safe to return here + if {!$processTest} { + incr testLevel -1 + return + } # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure || $cleanupFailure || $coreFailure || $outputFailure || $errorFailure || $codeFailure @@ -2175,11 +2198,11 @@ if {[info exists errorInfo(setup)]} { puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)" puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)" } } - if {$scriptFailure} { + if {$processTest && $scriptFailure} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result: $scriptMatch" } else { puts [outputChannel] "---- Result was:\n$actualAnswer" puts [outputChannel] "---- Result should have been\ @@ -2241,10 +2264,36 @@ puts [outputChannel] "==== $name FAILED\n" incr testLevel -1 return } + +# Skip -- +# +# Skips a running test and add a reason to skipped "constraints". Can be used +# to conditional intended abort of the test. +# +# Side Effects: Maintains tally of total tests seen and tests skipped. +# +proc tcltest::Skip {reason} { + return -code error -errorcode BYPASS-SKIPPED-TEST $reason +} + +proc tcltest::_noticeSkipped {name reason} { + variable testLevel + variable numTests + + if {[IsVerbose skip]} { + puts [outputChannel] "++++ $name SKIPPED: $reason" + } + + if {$testLevel == 1} { + incr numTests(Skipped) + AddToSkippedBecause $reason + } +} + # Skipped -- # # Given a test name and it constraints, returns a boolean indicating # whether the current configuration says the test should be skipped. @@ -2322,18 +2371,11 @@ } } } if {!$doTest} { - if {[IsVerbose skip]} { - puts [outputChannel] "++++ $name SKIPPED: $constraints" - } - - if {$testLevel == 1} { - incr numTests(Skipped) - AddToSkippedBecause $constraints - } + _noticeSkipped $name $constraints return 1 } } return 0 } @@ -2352,10 +2394,14 @@ if {[llength [info commands memory]] == 1} { memory tag $name } + # run the test script (or a hook if it presents): + if {[set cmd [namespace which -command [namespace current]::EvalTest]] ne ""} { + set script [list $cmd $script] + } set code [catch {uplevel 1 $script} actualAnswer] return [list $actualAnswer $code] } @@ -3059,22 +3105,28 @@ set directory [temporaryDirectory] } set fullName [file join $directory $name] DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName" set idx [lsearch -exact $filesMade $fullName] - set filesMade [lreplace $filesMade $idx $idx] if {$idx == -1} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n not created by makeFile" } + } else { + set filesMade [lreplace $filesMade $idx $idx] } if {![file isfile $fullName]} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n not a file" } } - return [file delete -- $fullName] + if {[catch {file delete -- $fullName} msg ]} { + DebugDo 1 { + Warn "removeFile removing \"$fullName\":\n failed: $msg" + } + } + return } # tcltest::makeDirectory -- # # Create a new dir with the name . Index: library/tm.tcl ================================================================== --- library/tm.tcl +++ library/tm.tcl @@ -309,11 +309,11 @@ # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform - lassign [split [info tclversion] .] major minor + regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set exe [file normalize [info nameofexecutable]] # Note that we're using [::list], not [list] because [list] means # something other than [::list] in this namespace. roots [::list \ @@ -352,11 +352,11 @@ # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor + regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { set px [file join $p ${major}.${n}] if {![interp issafe]} {set px [file normalize $px]} Index: library/tzdata/Africa/Casablanca ================================================================== --- library/tzdata/Africa/Casablanca +++ library/tzdata/Africa/Casablanca @@ -58,11 +58,11 @@ {1529200800 3600 1 +00} {1540695600 3600 0 +01} {1557021600 0 1 +01} {1560045600 3600 0 +01} {1587261600 0 1 +01} - {1590285600 3600 0 +01} + {1590890400 3600 0 +01} {1618106400 0 1 +01} {1621130400 3600 0 +01} {1648346400 0 1 +01} {1651975200 3600 0 +01} {1679191200 0 1 +01} @@ -74,11 +74,11 @@ {1771120800 0 1 +01} {1774144800 3600 0 +01} {1801965600 0 1 +01} {1804989600 3600 0 +01} {1832205600 0 1 +01} - {1835229600 3600 0 +01} + {1835834400 3600 0 +01} {1863050400 0 1 +01} {1866074400 3600 0 +01} {1893290400 0 1 +01} {1896919200 3600 0 +01} {1924135200 0 1 +01} @@ -90,11 +90,113 @@ {2016064800 0 1 +01} {2019088800 3600 0 +01} {2046304800 0 1 +01} {2049933600 3600 0 +01} {2077149600 0 1 +01} - {2080173600 3600 0 +01} + {2080778400 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} + {2169079200 0 1 +01} + {2172103200 3600 0 +01} + {2199924000 0 1 +01} + {2202948000 3600 0 +01} + {2230164000 0 1 +01} + {2233792800 3600 0 +01} + {2261008800 0 1 +01} + {2264032800 3600 0 +01} + {2291248800 0 1 +01} + {2294877600 3600 0 +01} + {2322093600 0 1 +01} + {2325722400 3600 0 +01} + {2352938400 0 1 +01} + {2355962400 3600 0 +01} + {2383178400 0 1 +01} + {2386807200 3600 0 +01} + {2414023200 0 1 +01} + {2417047200 3600 0 +01} + {2444868000 0 1 +01} + {2447892000 3600 0 +01} + {2475108000 0 1 +01} + {2478736800 3600 0 +01} + {2505952800 0 1 +01} + {2508976800 3600 0 +01} + {2536192800 0 1 +01} + {2539821600 3600 0 +01} + {2567037600 0 1 +01} + {2570666400 3600 0 +01} + {2597882400 0 1 +01} + {2600906400 3600 0 +01} + {2628122400 0 1 +01} + {2631751200 3600 0 +01} + {2658967200 0 1 +01} + {2661991200 3600 0 +01} + {2689812000 0 1 +01} + {2692836000 3600 0 +01} + {2720052000 0 1 +01} + {2723680800 3600 0 +01} + {2750896800 0 1 +01} + {2753920800 3600 0 +01} + {2781136800 0 1 +01} + {2784765600 3600 0 +01} + {2811981600 0 1 +01} + {2815610400 3600 0 +01} + {2842826400 0 1 +01} + {2845850400 3600 0 +01} + {2873066400 0 1 +01} + {2876695200 3600 0 +01} + {2903911200 0 1 +01} + {2906935200 3600 0 +01} + {2934756000 0 1 +01} + {2937780000 3600 0 +01} + {2964996000 0 1 +01} + {2968624800 3600 0 +01} + {2995840800 0 1 +01} + {2998864800 3600 0 +01} + {3026080800 0 1 +01} + {3029709600 3600 0 +01} + {3056925600 0 1 +01} + {3060554400 3600 0 +01} + {3087770400 0 1 +01} + {3090794400 3600 0 +01} + {3118010400 0 1 +01} + {3121639200 3600 0 +01} + {3148855200 0 1 +01} + {3151879200 3600 0 +01} + {3179700000 0 1 +01} + {3182724000 3600 0 +01} + {3209940000 0 1 +01} + {3213568800 3600 0 +01} + {3240784800 0 1 +01} + {3243808800 3600 0 +01} + {3271024800 0 1 +01} + {3274653600 3600 0 +01} + {3301869600 0 1 +01} + {3305498400 3600 0 +01} + {3332714400 0 1 +01} + {3335738400 3600 0 +01} + {3362954400 0 1 +01} + {3366583200 3600 0 +01} + {3393799200 0 1 +01} + {3396823200 3600 0 +01} + {3424644000 0 1 +01} + {3427668000 3600 0 +01} + {3454884000 0 1 +01} + {3458512800 3600 0 +01} + {3485728800 0 1 +01} + {3488752800 3600 0 +01} + {3515968800 0 1 +01} + {3519597600 3600 0 +01} + {3546813600 0 1 +01} + {3549837600 3600 0 +01} + {3577658400 0 1 +01} + {3580682400 3600 0 +01} + {3607898400 0 1 +01} + {3611527200 3600 0 +01} + {3638743200 0 1 +01} + {3641767200 3600 0 +01} + {3669588000 0 1 +01} + {3672612000 3600 0 +01} + {3699828000 0 1 +01} + {3703456800 3600 0 +01} } Index: library/tzdata/Africa/El_Aaiun ================================================================== --- library/tzdata/Africa/El_Aaiun +++ library/tzdata/Africa/El_Aaiun @@ -47,11 +47,11 @@ {1529200800 3600 1 +00} {1540695600 3600 0 +01} {1557021600 0 1 +01} {1560045600 3600 0 +01} {1587261600 0 1 +01} - {1590285600 3600 0 +01} + {1590890400 3600 0 +01} {1618106400 0 1 +01} {1621130400 3600 0 +01} {1648346400 0 1 +01} {1651975200 3600 0 +01} {1679191200 0 1 +01} @@ -63,11 +63,11 @@ {1771120800 0 1 +01} {1774144800 3600 0 +01} {1801965600 0 1 +01} {1804989600 3600 0 +01} {1832205600 0 1 +01} - {1835229600 3600 0 +01} + {1835834400 3600 0 +01} {1863050400 0 1 +01} {1866074400 3600 0 +01} {1893290400 0 1 +01} {1896919200 3600 0 +01} {1924135200 0 1 +01} @@ -79,11 +79,113 @@ {2016064800 0 1 +01} {2019088800 3600 0 +01} {2046304800 0 1 +01} {2049933600 3600 0 +01} {2077149600 0 1 +01} - {2080173600 3600 0 +01} + {2080778400 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} + {2169079200 0 1 +01} + {2172103200 3600 0 +01} + {2199924000 0 1 +01} + {2202948000 3600 0 +01} + {2230164000 0 1 +01} + {2233792800 3600 0 +01} + {2261008800 0 1 +01} + {2264032800 3600 0 +01} + {2291248800 0 1 +01} + {2294877600 3600 0 +01} + {2322093600 0 1 +01} + {2325722400 3600 0 +01} + {2352938400 0 1 +01} + {2355962400 3600 0 +01} + {2383178400 0 1 +01} + {2386807200 3600 0 +01} + {2414023200 0 1 +01} + {2417047200 3600 0 +01} + {2444868000 0 1 +01} + {2447892000 3600 0 +01} + {2475108000 0 1 +01} + {2478736800 3600 0 +01} + {2505952800 0 1 +01} + {2508976800 3600 0 +01} + {2536192800 0 1 +01} + {2539821600 3600 0 +01} + {2567037600 0 1 +01} + {2570666400 3600 0 +01} + {2597882400 0 1 +01} + {2600906400 3600 0 +01} + {2628122400 0 1 +01} + {2631751200 3600 0 +01} + {2658967200 0 1 +01} + {2661991200 3600 0 +01} + {2689812000 0 1 +01} + {2692836000 3600 0 +01} + {2720052000 0 1 +01} + {2723680800 3600 0 +01} + {2750896800 0 1 +01} + {2753920800 3600 0 +01} + {2781136800 0 1 +01} + {2784765600 3600 0 +01} + {2811981600 0 1 +01} + {2815610400 3600 0 +01} + {2842826400 0 1 +01} + {2845850400 3600 0 +01} + {2873066400 0 1 +01} + {2876695200 3600 0 +01} + {2903911200 0 1 +01} + {2906935200 3600 0 +01} + {2934756000 0 1 +01} + {2937780000 3600 0 +01} + {2964996000 0 1 +01} + {2968624800 3600 0 +01} + {2995840800 0 1 +01} + {2998864800 3600 0 +01} + {3026080800 0 1 +01} + {3029709600 3600 0 +01} + {3056925600 0 1 +01} + {3060554400 3600 0 +01} + {3087770400 0 1 +01} + {3090794400 3600 0 +01} + {3118010400 0 1 +01} + {3121639200 3600 0 +01} + {3148855200 0 1 +01} + {3151879200 3600 0 +01} + {3179700000 0 1 +01} + {3182724000 3600 0 +01} + {3209940000 0 1 +01} + {3213568800 3600 0 +01} + {3240784800 0 1 +01} + {3243808800 3600 0 +01} + {3271024800 0 1 +01} + {3274653600 3600 0 +01} + {3301869600 0 1 +01} + {3305498400 3600 0 +01} + {3332714400 0 1 +01} + {3335738400 3600 0 +01} + {3362954400 0 1 +01} + {3366583200 3600 0 +01} + {3393799200 0 1 +01} + {3396823200 3600 0 +01} + {3424644000 0 1 +01} + {3427668000 3600 0 +01} + {3454884000 0 1 +01} + {3458512800 3600 0 +01} + {3485728800 0 1 +01} + {3488752800 3600 0 +01} + {3515968800 0 1 +01} + {3519597600 3600 0 +01} + {3546813600 0 1 +01} + {3549837600 3600 0 +01} + {3577658400 0 1 +01} + {3580682400 3600 0 +01} + {3607898400 0 1 +01} + {3611527200 3600 0 +01} + {3638743200 0 1 +01} + {3641767200 3600 0 +01} + {3669588000 0 1 +01} + {3672612000 3600 0 +01} + {3699828000 0 1 +01} + {3703456800 3600 0 +01} } Index: library/tzdata/America/Campo_Grande ================================================================== --- library/tzdata/America/Campo_Grande +++ library/tzdata/America/Campo_Grande @@ -91,167 +91,6 @@ {1487473200 -14400 0 -04} {1508040000 -10800 1 -04} {1518922800 -14400 0 -04} {1541304000 -10800 1 -04} {1550372400 -14400 0 -04} - {1572753600 -10800 1 -04} - {1581822000 -14400 0 -04} - {1604203200 -10800 1 -04} - {1613876400 -14400 0 -04} - {1636257600 -10800 1 -04} - {1645326000 -14400 0 -04} - {1667707200 -10800 1 -04} - {1677380400 -14400 0 -04} - {1699156800 -10800 1 -04} - {1708225200 -14400 0 -04} - {1730606400 -10800 1 -04} - {1739674800 -14400 0 -04} - {1762056000 -10800 1 -04} - {1771729200 -14400 0 -04} - {1793505600 -10800 1 -04} - {1803178800 -14400 0 -04} - {1825560000 -10800 1 -04} - {1834628400 -14400 0 -04} - {1857009600 -10800 1 -04} - {1866078000 -14400 0 -04} - {1888459200 -10800 1 -04} - {1897527600 -14400 0 -04} - {1919908800 -10800 1 -04} - {1928977200 -14400 0 -04} - {1951358400 -10800 1 -04} - {1960426800 -14400 0 -04} - {1983412800 -10800 1 -04} - {1992481200 -14400 0 -04} - {2014862400 -10800 1 -04} - {2024535600 -14400 0 -04} - {2046312000 -10800 1 -04} - {2055380400 -14400 0 -04} - {2077761600 -10800 1 -04} - {2086830000 -14400 0 -04} - {2109211200 -10800 1 -04} - {2118884400 -14400 0 -04} - {2140660800 -10800 1 -04} - {2150334000 -14400 0 -04} - {2172715200 -10800 1 -04} - {2181783600 -14400 0 -04} - {2204164800 -10800 1 -04} - {2213233200 -14400 0 -04} - {2235614400 -10800 1 -04} - {2244682800 -14400 0 -04} - {2267064000 -10800 1 -04} - {2276132400 -14400 0 -04} - {2298513600 -10800 1 -04} - {2307582000 -14400 0 -04} - {2329963200 -10800 1 -04} - {2339636400 -14400 0 -04} - {2362017600 -10800 1 -04} - {2371086000 -14400 0 -04} - {2393467200 -10800 1 -04} - {2402535600 -14400 0 -04} - {2424916800 -10800 1 -04} - {2433985200 -14400 0 -04} - {2456366400 -10800 1 -04} - {2465434800 -14400 0 -04} - {2487816000 -10800 1 -04} - {2497489200 -14400 0 -04} - {2519870400 -10800 1 -04} - {2528938800 -14400 0 -04} - {2551320000 -10800 1 -04} - {2560388400 -14400 0 -04} - {2582769600 -10800 1 -04} - {2591838000 -14400 0 -04} - {2614219200 -10800 1 -04} - {2623287600 -14400 0 -04} - {2645668800 -10800 1 -04} - {2654737200 -14400 0 -04} - {2677118400 -10800 1 -04} - {2686791600 -14400 0 -04} - {2709172800 -10800 1 -04} - {2718241200 -14400 0 -04} - {2740622400 -10800 1 -04} - {2749690800 -14400 0 -04} - {2772072000 -10800 1 -04} - {2781140400 -14400 0 -04} - {2803521600 -10800 1 -04} - {2812590000 -14400 0 -04} - {2834971200 -10800 1 -04} - {2844039600 -14400 0 -04} - {2867025600 -10800 1 -04} - {2876094000 -14400 0 -04} - {2898475200 -10800 1 -04} - {2907543600 -14400 0 -04} - {2929924800 -10800 1 -04} - {2938993200 -14400 0 -04} - {2961374400 -10800 1 -04} - {2970442800 -14400 0 -04} - {2992824000 -10800 1 -04} - {3001892400 -14400 0 -04} - {3024273600 -10800 1 -04} - {3033946800 -14400 0 -04} - {3056328000 -10800 1 -04} - {3065396400 -14400 0 -04} - {3087777600 -10800 1 -04} - {3096846000 -14400 0 -04} - {3119227200 -10800 1 -04} - {3128295600 -14400 0 -04} - {3150676800 -10800 1 -04} - {3159745200 -14400 0 -04} - {3182126400 -10800 1 -04} - {3191194800 -14400 0 -04} - {3213576000 -10800 1 -04} - {3223249200 -14400 0 -04} - {3245630400 -10800 1 -04} - {3254698800 -14400 0 -04} - {3277080000 -10800 1 -04} - {3286148400 -14400 0 -04} - {3308529600 -10800 1 -04} - {3317598000 -14400 0 -04} - {3339979200 -10800 1 -04} - {3349047600 -14400 0 -04} - {3371428800 -10800 1 -04} - {3381102000 -14400 0 -04} - {3403483200 -10800 1 -04} - {3412551600 -14400 0 -04} - {3434932800 -10800 1 -04} - {3444001200 -14400 0 -04} - {3466382400 -10800 1 -04} - {3475450800 -14400 0 -04} - {3497832000 -10800 1 -04} - {3506900400 -14400 0 -04} - {3529281600 -10800 1 -04} - {3538350000 -14400 0 -04} - {3560731200 -10800 1 -04} - {3570404400 -14400 0 -04} - {3592785600 -10800 1 -04} - {3601854000 -14400 0 -04} - {3624235200 -10800 1 -04} - {3633303600 -14400 0 -04} - {3655684800 -10800 1 -04} - {3664753200 -14400 0 -04} - {3687134400 -10800 1 -04} - {3696202800 -14400 0 -04} - {3718584000 -10800 1 -04} - {3727652400 -14400 0 -04} - {3750638400 -10800 1 -04} - {3759706800 -14400 0 -04} - {3782088000 -10800 1 -04} - {3791156400 -14400 0 -04} - {3813537600 -10800 1 -04} - {3822606000 -14400 0 -04} - {3844987200 -10800 1 -04} - {3854055600 -14400 0 -04} - {3876436800 -10800 1 -04} - {3885505200 -14400 0 -04} - {3907886400 -10800 1 -04} - {3917559600 -14400 0 -04} - {3939940800 -10800 1 -04} - {3949009200 -14400 0 -04} - {3971390400 -10800 1 -04} - {3980458800 -14400 0 -04} - {4002840000 -10800 1 -04} - {4011908400 -14400 0 -04} - {4034289600 -10800 1 -04} - {4043358000 -14400 0 -04} - {4065739200 -10800 1 -04} - {4074807600 -14400 0 -04} - {4097188800 -10800 1 -04} } Index: library/tzdata/America/Cuiaba ================================================================== --- library/tzdata/America/Cuiaba +++ library/tzdata/America/Cuiaba @@ -91,167 +91,6 @@ {1487473200 -14400 0 -04} {1508040000 -10800 1 -04} {1518922800 -14400 0 -04} {1541304000 -10800 1 -04} {1550372400 -14400 0 -04} - {1572753600 -10800 1 -04} - {1581822000 -14400 0 -04} - {1604203200 -10800 1 -04} - {1613876400 -14400 0 -04} - {1636257600 -10800 1 -04} - {1645326000 -14400 0 -04} - {1667707200 -10800 1 -04} - {1677380400 -14400 0 -04} - {1699156800 -10800 1 -04} - {1708225200 -14400 0 -04} - {1730606400 -10800 1 -04} - {1739674800 -14400 0 -04} - {1762056000 -10800 1 -04} - {1771729200 -14400 0 -04} - {1793505600 -10800 1 -04} - {1803178800 -14400 0 -04} - {1825560000 -10800 1 -04} - {1834628400 -14400 0 -04} - {1857009600 -10800 1 -04} - {1866078000 -14400 0 -04} - {1888459200 -10800 1 -04} - {1897527600 -14400 0 -04} - {1919908800 -10800 1 -04} - {1928977200 -14400 0 -04} - {1951358400 -10800 1 -04} - {1960426800 -14400 0 -04} - {1983412800 -10800 1 -04} - {1992481200 -14400 0 -04} - {2014862400 -10800 1 -04} - {2024535600 -14400 0 -04} - {2046312000 -10800 1 -04} - {2055380400 -14400 0 -04} - {2077761600 -10800 1 -04} - {2086830000 -14400 0 -04} - {2109211200 -10800 1 -04} - {2118884400 -14400 0 -04} - {2140660800 -10800 1 -04} - {2150334000 -14400 0 -04} - {2172715200 -10800 1 -04} - {2181783600 -14400 0 -04} - {2204164800 -10800 1 -04} - {2213233200 -14400 0 -04} - {2235614400 -10800 1 -04} - {2244682800 -14400 0 -04} - {2267064000 -10800 1 -04} - {2276132400 -14400 0 -04} - {2298513600 -10800 1 -04} - {2307582000 -14400 0 -04} - {2329963200 -10800 1 -04} - {2339636400 -14400 0 -04} - {2362017600 -10800 1 -04} - {2371086000 -14400 0 -04} - {2393467200 -10800 1 -04} - {2402535600 -14400 0 -04} - {2424916800 -10800 1 -04} - {2433985200 -14400 0 -04} - {2456366400 -10800 1 -04} - {2465434800 -14400 0 -04} - {2487816000 -10800 1 -04} - {2497489200 -14400 0 -04} - {2519870400 -10800 1 -04} - {2528938800 -14400 0 -04} - {2551320000 -10800 1 -04} - {2560388400 -14400 0 -04} - {2582769600 -10800 1 -04} - {2591838000 -14400 0 -04} - {2614219200 -10800 1 -04} - {2623287600 -14400 0 -04} - {2645668800 -10800 1 -04} - {2654737200 -14400 0 -04} - {2677118400 -10800 1 -04} - {2686791600 -14400 0 -04} - {2709172800 -10800 1 -04} - {2718241200 -14400 0 -04} - {2740622400 -10800 1 -04} - {2749690800 -14400 0 -04} - {2772072000 -10800 1 -04} - {2781140400 -14400 0 -04} - {2803521600 -10800 1 -04} - {2812590000 -14400 0 -04} - {2834971200 -10800 1 -04} - {2844039600 -14400 0 -04} - {2867025600 -10800 1 -04} - {2876094000 -14400 0 -04} - {2898475200 -10800 1 -04} - {2907543600 -14400 0 -04} - {2929924800 -10800 1 -04} - {2938993200 -14400 0 -04} - {2961374400 -10800 1 -04} - {2970442800 -14400 0 -04} - {2992824000 -10800 1 -04} - {3001892400 -14400 0 -04} - {3024273600 -10800 1 -04} - {3033946800 -14400 0 -04} - {3056328000 -10800 1 -04} - {3065396400 -14400 0 -04} - {3087777600 -10800 1 -04} - {3096846000 -14400 0 -04} - {3119227200 -10800 1 -04} - {3128295600 -14400 0 -04} - {3150676800 -10800 1 -04} - {3159745200 -14400 0 -04} - {3182126400 -10800 1 -04} - {3191194800 -14400 0 -04} - {3213576000 -10800 1 -04} - {3223249200 -14400 0 -04} - {3245630400 -10800 1 -04} - {3254698800 -14400 0 -04} - {3277080000 -10800 1 -04} - {3286148400 -14400 0 -04} - {3308529600 -10800 1 -04} - {3317598000 -14400 0 -04} - {3339979200 -10800 1 -04} - {3349047600 -14400 0 -04} - {3371428800 -10800 1 -04} - {3381102000 -14400 0 -04} - {3403483200 -10800 1 -04} - {3412551600 -14400 0 -04} - {3434932800 -10800 1 -04} - {3444001200 -14400 0 -04} - {3466382400 -10800 1 -04} - {3475450800 -14400 0 -04} - {3497832000 -10800 1 -04} - {3506900400 -14400 0 -04} - {3529281600 -10800 1 -04} - {3538350000 -14400 0 -04} - {3560731200 -10800 1 -04} - {3570404400 -14400 0 -04} - {3592785600 -10800 1 -04} - {3601854000 -14400 0 -04} - {3624235200 -10800 1 -04} - {3633303600 -14400 0 -04} - {3655684800 -10800 1 -04} - {3664753200 -14400 0 -04} - {3687134400 -10800 1 -04} - {3696202800 -14400 0 -04} - {3718584000 -10800 1 -04} - {3727652400 -14400 0 -04} - {3750638400 -10800 1 -04} - {3759706800 -14400 0 -04} - {3782088000 -10800 1 -04} - {3791156400 -14400 0 -04} - {3813537600 -10800 1 -04} - {3822606000 -14400 0 -04} - {3844987200 -10800 1 -04} - {3854055600 -14400 0 -04} - {3876436800 -10800 1 -04} - {3885505200 -14400 0 -04} - {3907886400 -10800 1 -04} - {3917559600 -14400 0 -04} - {3939940800 -10800 1 -04} - {3949009200 -14400 0 -04} - {3971390400 -10800 1 -04} - {3980458800 -14400 0 -04} - {4002840000 -10800 1 -04} - {4011908400 -14400 0 -04} - {4034289600 -10800 1 -04} - {4043358000 -14400 0 -04} - {4065739200 -10800 1 -04} - {4074807600 -14400 0 -04} - {4097188800 -10800 1 -04} } Index: library/tzdata/America/Dawson ================================================================== --- library/tzdata/America/Dawson +++ library/tzdata/America/Dawson @@ -91,166 +91,7 @@ {1509872400 -28800 0 PST} {1520762400 -25200 1 PDT} {1541322000 -28800 0 PST} {1552212000 -25200 1 PDT} {1572771600 -28800 0 PST} - {1583661600 -25200 1 PDT} - {1604221200 -28800 0 PST} - {1615716000 -25200 1 PDT} - {1636275600 -28800 0 PST} - {1647165600 -25200 1 PDT} - {1667725200 -28800 0 PST} - {1678615200 -25200 1 PDT} - {1699174800 -28800 0 PST} - {1710064800 -25200 1 PDT} - {1730624400 -28800 0 PST} - {1741514400 -25200 1 PDT} - {1762074000 -28800 0 PST} - {1772964000 -25200 1 PDT} - {1793523600 -28800 0 PST} - {1805018400 -25200 1 PDT} - {1825578000 -28800 0 PST} - {1836468000 -25200 1 PDT} - {1857027600 -28800 0 PST} - {1867917600 -25200 1 PDT} - {1888477200 -28800 0 PST} - {1899367200 -25200 1 PDT} - {1919926800 -28800 0 PST} - {1930816800 -25200 1 PDT} - {1951376400 -28800 0 PST} - {1962871200 -25200 1 PDT} - {1983430800 -28800 0 PST} - {1994320800 -25200 1 PDT} - {2014880400 -28800 0 PST} - {2025770400 -25200 1 PDT} - {2046330000 -28800 0 PST} - {2057220000 -25200 1 PDT} - {2077779600 -28800 0 PST} - {2088669600 -25200 1 PDT} - {2109229200 -28800 0 PST} - {2120119200 -25200 1 PDT} - {2140678800 -28800 0 PST} - {2152173600 -25200 1 PDT} - {2172733200 -28800 0 PST} - {2183623200 -25200 1 PDT} - {2204182800 -28800 0 PST} - {2215072800 -25200 1 PDT} - {2235632400 -28800 0 PST} - {2246522400 -25200 1 PDT} - {2267082000 -28800 0 PST} - {2277972000 -25200 1 PDT} - {2298531600 -28800 0 PST} - {2309421600 -25200 1 PDT} - {2329981200 -28800 0 PST} - {2341476000 -25200 1 PDT} - {2362035600 -28800 0 PST} - {2372925600 -25200 1 PDT} - {2393485200 -28800 0 PST} - {2404375200 -25200 1 PDT} - {2424934800 -28800 0 PST} - {2435824800 -25200 1 PDT} - {2456384400 -28800 0 PST} - {2467274400 -25200 1 PDT} - {2487834000 -28800 0 PST} - {2499328800 -25200 1 PDT} - {2519888400 -28800 0 PST} - {2530778400 -25200 1 PDT} - {2551338000 -28800 0 PST} - {2562228000 -25200 1 PDT} - {2582787600 -28800 0 PST} - {2593677600 -25200 1 PDT} - {2614237200 -28800 0 PST} - {2625127200 -25200 1 PDT} - {2645686800 -28800 0 PST} - {2656576800 -25200 1 PDT} - {2677136400 -28800 0 PST} - {2688631200 -25200 1 PDT} - {2709190800 -28800 0 PST} - {2720080800 -25200 1 PDT} - {2740640400 -28800 0 PST} - {2751530400 -25200 1 PDT} - {2772090000 -28800 0 PST} - {2782980000 -25200 1 PDT} - {2803539600 -28800 0 PST} - {2814429600 -25200 1 PDT} - {2834989200 -28800 0 PST} - {2846484000 -25200 1 PDT} - {2867043600 -28800 0 PST} - {2877933600 -25200 1 PDT} - {2898493200 -28800 0 PST} - {2909383200 -25200 1 PDT} - {2929942800 -28800 0 PST} - {2940832800 -25200 1 PDT} - {2961392400 -28800 0 PST} - {2972282400 -25200 1 PDT} - {2992842000 -28800 0 PST} - {3003732000 -25200 1 PDT} - {3024291600 -28800 0 PST} - {3035786400 -25200 1 PDT} - {3056346000 -28800 0 PST} - {3067236000 -25200 1 PDT} - {3087795600 -28800 0 PST} - {3098685600 -25200 1 PDT} - {3119245200 -28800 0 PST} - {3130135200 -25200 1 PDT} - {3150694800 -28800 0 PST} - {3161584800 -25200 1 PDT} - {3182144400 -28800 0 PST} - {3193034400 -25200 1 PDT} - {3213594000 -28800 0 PST} - {3225088800 -25200 1 PDT} - {3245648400 -28800 0 PST} - {3256538400 -25200 1 PDT} - {3277098000 -28800 0 PST} - {3287988000 -25200 1 PDT} - {3308547600 -28800 0 PST} - {3319437600 -25200 1 PDT} - {3339997200 -28800 0 PST} - {3350887200 -25200 1 PDT} - {3371446800 -28800 0 PST} - {3382941600 -25200 1 PDT} - {3403501200 -28800 0 PST} - {3414391200 -25200 1 PDT} - {3434950800 -28800 0 PST} - {3445840800 -25200 1 PDT} - {3466400400 -28800 0 PST} - {3477290400 -25200 1 PDT} - {3497850000 -28800 0 PST} - {3508740000 -25200 1 PDT} - {3529299600 -28800 0 PST} - {3540189600 -25200 1 PDT} - {3560749200 -28800 0 PST} - {3572244000 -25200 1 PDT} - {3592803600 -28800 0 PST} - {3603693600 -25200 1 PDT} - {3624253200 -28800 0 PST} - {3635143200 -25200 1 PDT} - {3655702800 -28800 0 PST} - {3666592800 -25200 1 PDT} - {3687152400 -28800 0 PST} - {3698042400 -25200 1 PDT} - {3718602000 -28800 0 PST} - {3730096800 -25200 1 PDT} - {3750656400 -28800 0 PST} - {3761546400 -25200 1 PDT} - {3782106000 -28800 0 PST} - {3792996000 -25200 1 PDT} - {3813555600 -28800 0 PST} - {3824445600 -25200 1 PDT} - {3845005200 -28800 0 PST} - {3855895200 -25200 1 PDT} - {3876454800 -28800 0 PST} - {3887344800 -25200 1 PDT} - {3907904400 -28800 0 PST} - {3919399200 -25200 1 PDT} - {3939958800 -28800 0 PST} - {3950848800 -25200 1 PDT} - {3971408400 -28800 0 PST} - {3982298400 -25200 1 PDT} - {4002858000 -28800 0 PST} - {4013748000 -25200 1 PDT} - {4034307600 -28800 0 PST} - {4045197600 -25200 1 PDT} - {4065757200 -28800 0 PST} - {4076647200 -25200 1 PDT} - {4097206800 -28800 0 PST} + {1583661600 -25200 0 MST} } Index: library/tzdata/America/Detroit ================================================================== --- library/tzdata/America/Detroit +++ library/tzdata/America/Detroit @@ -9,10 +9,15 @@ {-769395600 -14400 1 EPT} {-765396000 -18000 0 EST} {-757364400 -18000 0 EST} {-684349200 -14400 1 EDT} {-671047200 -18000 0 EST} + {-80506740 -14400 0 EDT} + {-68666400 -18000 0 EST} + {-52938000 -14400 1 EDT} + {-37216800 -18000 0 EST} + {-31518000 -18000 0 EST} {94712400 -18000 0 EST} {104914800 -14400 1 EDT} {120636000 -18000 0 EST} {126687600 -14400 1 EDT} {152085600 -18000 0 EST} Index: library/tzdata/America/Edmonton ================================================================== --- library/tzdata/America/Edmonton +++ library/tzdata/America/Edmonton @@ -18,14 +18,10 @@ {-880210800 -21600 1 MWT} {-769395600 -21600 1 MPT} {-765388800 -25200 0 MST} {-715791600 -21600 1 MDT} {-702489600 -25200 0 MST} - {-84380400 -21600 1 MDT} - {-68659200 -25200 0 MST} - {-21481200 -21600 1 MDT} - {-5760000 -25200 0 MST} {73472400 -21600 1 MDT} {89193600 -25200 0 MST} {104922000 -21600 1 MDT} {120643200 -25200 0 MST} {136371600 -21600 1 MDT} Index: library/tzdata/America/Godthab ================================================================== --- library/tzdata/America/Godthab +++ library/tzdata/America/Godthab @@ -1,246 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Godthab) { - {-9223372036854775808 -12416 0 LMT} - {-1686083584 -10800 0 -03} - {323845200 -7200 0 -02} - {338950800 -10800 0 -03} - {354675600 -7200 1 -02} - {370400400 -10800 0 -03} - {386125200 -7200 1 -02} - {401850000 -10800 0 -03} - {417574800 -7200 1 -02} - {433299600 -10800 0 -03} - {449024400 -7200 1 -02} - {465354000 -10800 0 -03} - {481078800 -7200 1 -02} - {496803600 -10800 0 -03} - {512528400 -7200 1 -02} - {528253200 -10800 0 -03} - {543978000 -7200 1 -02} - {559702800 -10800 0 -03} - {575427600 -7200 1 -02} - {591152400 -10800 0 -03} - {606877200 -7200 1 -02} - {622602000 -10800 0 -03} - {638326800 -7200 1 -02} - {654656400 -10800 0 -03} - {670381200 -7200 1 -02} - {686106000 -10800 0 -03} - {701830800 -7200 1 -02} - {717555600 -10800 0 -03} - {733280400 -7200 1 -02} - {749005200 -10800 0 -03} - {764730000 -7200 1 -02} - {780454800 -10800 0 -03} - {796179600 -7200 1 -02} - {811904400 -10800 0 -03} - {828234000 -7200 1 -02} - {846378000 -10800 0 -03} - {859683600 -7200 1 -02} - {877827600 -10800 0 -03} - {891133200 -7200 1 -02} - {909277200 -10800 0 -03} - {922582800 -7200 1 -02} - {941331600 -10800 0 -03} - {954032400 -7200 1 -02} - {972781200 -10800 0 -03} - {985482000 -7200 1 -02} - {1004230800 -10800 0 -03} - {1017536400 -7200 1 -02} - {1035680400 -10800 0 -03} - {1048986000 -7200 1 -02} - {1067130000 -10800 0 -03} - {1080435600 -7200 1 -02} - {1099184400 -10800 0 -03} - {1111885200 -7200 1 -02} - {1130634000 -10800 0 -03} - {1143334800 -7200 1 -02} - {1162083600 -10800 0 -03} - {1174784400 -7200 1 -02} - {1193533200 -10800 0 -03} - {1206838800 -7200 1 -02} - {1224982800 -10800 0 -03} - {1238288400 -7200 1 -02} - {1256432400 -10800 0 -03} - {1269738000 -7200 1 -02} - {1288486800 -10800 0 -03} - {1301187600 -7200 1 -02} - {1319936400 -10800 0 -03} - {1332637200 -7200 1 -02} - {1351386000 -10800 0 -03} - {1364691600 -7200 1 -02} - {1382835600 -10800 0 -03} - {1396141200 -7200 1 -02} - {1414285200 -10800 0 -03} - {1427590800 -7200 1 -02} - {1445734800 -10800 0 -03} - {1459040400 -7200 1 -02} - {1477789200 -10800 0 -03} - {1490490000 -7200 1 -02} - {1509238800 -10800 0 -03} - {1521939600 -7200 1 -02} - {1540688400 -10800 0 -03} - {1553994000 -7200 1 -02} - {1572138000 -10800 0 -03} - {1585443600 -7200 1 -02} - {1603587600 -10800 0 -03} - {1616893200 -7200 1 -02} - {1635642000 -10800 0 -03} - {1648342800 -7200 1 -02} - {1667091600 -10800 0 -03} - {1679792400 -7200 1 -02} - {1698541200 -10800 0 -03} - {1711846800 -7200 1 -02} - {1729990800 -10800 0 -03} - {1743296400 -7200 1 -02} - {1761440400 -10800 0 -03} - {1774746000 -7200 1 -02} - {1792890000 -10800 0 -03} - {1806195600 -7200 1 -02} - {1824944400 -10800 0 -03} - {1837645200 -7200 1 -02} - {1856394000 -10800 0 -03} - {1869094800 -7200 1 -02} - {1887843600 -10800 0 -03} - {1901149200 -7200 1 -02} - {1919293200 -10800 0 -03} - {1932598800 -7200 1 -02} - {1950742800 -10800 0 -03} - {1964048400 -7200 1 -02} - {1982797200 -10800 0 -03} - {1995498000 -7200 1 -02} - {2014246800 -10800 0 -03} - {2026947600 -7200 1 -02} - {2045696400 -10800 0 -03} - {2058397200 -7200 1 -02} - {2077146000 -10800 0 -03} - {2090451600 -7200 1 -02} - {2108595600 -10800 0 -03} - {2121901200 -7200 1 -02} - {2140045200 -10800 0 -03} - {2153350800 -7200 1 -02} - {2172099600 -10800 0 -03} - {2184800400 -7200 1 -02} - {2203549200 -10800 0 -03} - {2216250000 -7200 1 -02} - {2234998800 -10800 0 -03} - {2248304400 -7200 1 -02} - {2266448400 -10800 0 -03} - {2279754000 -7200 1 -02} - {2297898000 -10800 0 -03} - {2311203600 -7200 1 -02} - {2329347600 -10800 0 -03} - {2342653200 -7200 1 -02} - {2361402000 -10800 0 -03} - {2374102800 -7200 1 -02} - {2392851600 -10800 0 -03} - {2405552400 -7200 1 -02} - {2424301200 -10800 0 -03} - {2437606800 -7200 1 -02} - {2455750800 -10800 0 -03} - {2469056400 -7200 1 -02} - {2487200400 -10800 0 -03} - {2500506000 -7200 1 -02} - {2519254800 -10800 0 -03} - {2531955600 -7200 1 -02} - {2550704400 -10800 0 -03} - {2563405200 -7200 1 -02} - {2582154000 -10800 0 -03} - {2595459600 -7200 1 -02} - {2613603600 -10800 0 -03} - {2626909200 -7200 1 -02} - {2645053200 -10800 0 -03} - {2658358800 -7200 1 -02} - {2676502800 -10800 0 -03} - {2689808400 -7200 1 -02} - {2708557200 -10800 0 -03} - {2721258000 -7200 1 -02} - {2740006800 -10800 0 -03} - {2752707600 -7200 1 -02} - {2771456400 -10800 0 -03} - {2784762000 -7200 1 -02} - {2802906000 -10800 0 -03} - {2816211600 -7200 1 -02} - {2834355600 -10800 0 -03} - {2847661200 -7200 1 -02} - {2866410000 -10800 0 -03} - {2879110800 -7200 1 -02} - {2897859600 -10800 0 -03} - {2910560400 -7200 1 -02} - {2929309200 -10800 0 -03} - {2942010000 -7200 1 -02} - {2960758800 -10800 0 -03} - {2974064400 -7200 1 -02} - {2992208400 -10800 0 -03} - {3005514000 -7200 1 -02} - {3023658000 -10800 0 -03} - {3036963600 -7200 1 -02} - {3055712400 -10800 0 -03} - {3068413200 -7200 1 -02} - {3087162000 -10800 0 -03} - {3099862800 -7200 1 -02} - {3118611600 -10800 0 -03} - {3131917200 -7200 1 -02} - {3150061200 -10800 0 -03} - {3163366800 -7200 1 -02} - {3181510800 -10800 0 -03} - {3194816400 -7200 1 -02} - {3212960400 -10800 0 -03} - {3226266000 -7200 1 -02} - {3245014800 -10800 0 -03} - {3257715600 -7200 1 -02} - {3276464400 -10800 0 -03} - {3289165200 -7200 1 -02} - {3307914000 -10800 0 -03} - {3321219600 -7200 1 -02} - {3339363600 -10800 0 -03} - {3352669200 -7200 1 -02} - {3370813200 -10800 0 -03} - {3384118800 -7200 1 -02} - {3402867600 -10800 0 -03} - {3415568400 -7200 1 -02} - {3434317200 -10800 0 -03} - {3447018000 -7200 1 -02} - {3465766800 -10800 0 -03} - {3479072400 -7200 1 -02} - {3497216400 -10800 0 -03} - {3510522000 -7200 1 -02} - {3528666000 -10800 0 -03} - {3541971600 -7200 1 -02} - {3560115600 -10800 0 -03} - {3573421200 -7200 1 -02} - {3592170000 -10800 0 -03} - {3604870800 -7200 1 -02} - {3623619600 -10800 0 -03} - {3636320400 -7200 1 -02} - {3655069200 -10800 0 -03} - {3668374800 -7200 1 -02} - {3686518800 -10800 0 -03} - {3699824400 -7200 1 -02} - {3717968400 -10800 0 -03} - {3731274000 -7200 1 -02} - {3750022800 -10800 0 -03} - {3762723600 -7200 1 -02} - {3781472400 -10800 0 -03} - {3794173200 -7200 1 -02} - {3812922000 -10800 0 -03} - {3825622800 -7200 1 -02} - {3844371600 -10800 0 -03} - {3857677200 -7200 1 -02} - {3875821200 -10800 0 -03} - {3889126800 -7200 1 -02} - {3907270800 -10800 0 -03} - {3920576400 -7200 1 -02} - {3939325200 -10800 0 -03} - {3952026000 -7200 1 -02} - {3970774800 -10800 0 -03} - {3983475600 -7200 1 -02} - {4002224400 -10800 0 -03} - {4015530000 -7200 1 -02} - {4033674000 -10800 0 -03} - {4046979600 -7200 1 -02} - {4065123600 -10800 0 -03} - {4078429200 -7200 1 -02} - {4096573200 -10800 0 -03} -} +if {![info exists TZData(America/Nuuk)]} { + LoadTimeZoneFile America/Nuuk +} +set TZData(:America/Godthab) $TZData(:America/Nuuk) Index: library/tzdata/America/Indiana/Tell_City ================================================================== --- library/tzdata/America/Indiana/Tell_City +++ library/tzdata/America/Indiana/Tell_City @@ -9,16 +9,10 @@ {-1583686800 -21600 0 CST} {-880214400 -18000 1 CWT} {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} - {-747244800 -18000 1 CDT} - {-733942800 -21600 0 CST} - {-526492800 -18000 1 CDT} - {-513190800 -21600 0 CST} - {-495043200 -18000 1 CDT} - {-481741200 -21600 0 CST} {-462996000 -18000 1 CDT} {-450291600 -21600 0 CST} {-431539200 -18000 1 CDT} {-418237200 -21600 0 CST} {-400089600 -18000 1 CDT} @@ -26,20 +20,22 @@ {-368640000 -18000 1 CDT} {-355338000 -21600 0 CST} {-337190400 -18000 1 CDT} {-323888400 -21600 0 CST} {-305740800 -18000 1 CDT} - {-289414800 -21600 0 CST} + {-292438800 -21600 0 CST} {-273686400 -18000 1 CDT} - {-260989200 -21600 0 CST} + {-257965200 -21600 0 CST} {-242236800 -18000 1 CDT} {-226515600 -21600 0 CST} {-210787200 -18000 1 CDT} {-195066000 -21600 0 CST} {-179337600 -18000 0 EST} - {-31518000 -18000 0 EST} - {-21488400 -14400 1 EDT} + {-68662800 -21600 0 CST} + {-52934400 -18000 1 CDT} + {-37213200 -21600 0 CST} + {-21484800 -14400 0 EDT} {-5767200 -18000 0 EST} {9961200 -14400 1 EDT} {25682400 -18000 0 EST} {31554000 -18000 0 EST} {1143961200 -21600 0 CST} Index: library/tzdata/America/Kentucky/Louisville ================================================================== --- library/tzdata/America/Kentucky/Louisville +++ library/tzdata/America/Kentucky/Louisville @@ -15,16 +15,13 @@ {-883591200 -21600 0 CST} {-880214400 -18000 1 CWT} {-769395600 -18000 1 CPT} {-765392400 -21600 0 CST} {-757360800 -21600 0 CST} - {-747244800 -18000 1 CDT} + {-747251940 -18000 1 CDT} {-744224400 -21600 0 CST} - {-715795200 -18000 1 CDT} - {-684349200 -18000 1 CDT} - {-652899600 -18000 1 CDT} - {-620845200 -18000 1 CDT} + {-620841600 -18000 1 CDT} {-608144400 -21600 0 CST} {-589392000 -18000 1 CDT} {-576090000 -21600 0 CST} {-557942400 -18000 1 CDT} {-544640400 -21600 0 CST} @@ -43,11 +40,11 @@ {-337190400 -18000 1 CDT} {-321469200 -21600 0 CST} {-305740800 -18000 1 CDT} {-289414800 -21600 0 CST} {-273686400 -18000 1 CDT} - {-266432400 -18000 0 EST} + {-266428800 -18000 0 EST} {-63140400 -18000 0 EST} {-52938000 -14400 1 EDT} {-37216800 -18000 0 EST} {-21488400 -14400 1 EDT} {-5767200 -18000 0 EST} ADDED library/tzdata/America/Nuuk Index: library/tzdata/America/Nuuk ================================================================== --- /dev/null +++ library/tzdata/America/Nuuk @@ -0,0 +1,246 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:America/Nuuk) { + {-9223372036854775808 -12416 0 LMT} + {-1686083584 -10800 0 -03} + {323845200 -7200 0 -02} + {338950800 -10800 0 -03} + {354675600 -7200 1 -02} + {370400400 -10800 0 -03} + {386125200 -7200 1 -02} + {401850000 -10800 0 -03} + {417574800 -7200 1 -02} + {433299600 -10800 0 -03} + {449024400 -7200 1 -02} + {465354000 -10800 0 -03} + {481078800 -7200 1 -02} + {496803600 -10800 0 -03} + {512528400 -7200 1 -02} + {528253200 -10800 0 -03} + {543978000 -7200 1 -02} + {559702800 -10800 0 -03} + {575427600 -7200 1 -02} + {591152400 -10800 0 -03} + {606877200 -7200 1 -02} + {622602000 -10800 0 -03} + {638326800 -7200 1 -02} + {654656400 -10800 0 -03} + {670381200 -7200 1 -02} + {686106000 -10800 0 -03} + {701830800 -7200 1 -02} + {717555600 -10800 0 -03} + {733280400 -7200 1 -02} + {749005200 -10800 0 -03} + {764730000 -7200 1 -02} + {780454800 -10800 0 -03} + {796179600 -7200 1 -02} + {811904400 -10800 0 -03} + {828234000 -7200 1 -02} + {846378000 -10800 0 -03} + {859683600 -7200 1 -02} + {877827600 -10800 0 -03} + {891133200 -7200 1 -02} + {909277200 -10800 0 -03} + {922582800 -7200 1 -02} + {941331600 -10800 0 -03} + {954032400 -7200 1 -02} + {972781200 -10800 0 -03} + {985482000 -7200 1 -02} + {1004230800 -10800 0 -03} + {1017536400 -7200 1 -02} + {1035680400 -10800 0 -03} + {1048986000 -7200 1 -02} + {1067130000 -10800 0 -03} + {1080435600 -7200 1 -02} + {1099184400 -10800 0 -03} + {1111885200 -7200 1 -02} + {1130634000 -10800 0 -03} + {1143334800 -7200 1 -02} + {1162083600 -10800 0 -03} + {1174784400 -7200 1 -02} + {1193533200 -10800 0 -03} + {1206838800 -7200 1 -02} + {1224982800 -10800 0 -03} + {1238288400 -7200 1 -02} + {1256432400 -10800 0 -03} + {1269738000 -7200 1 -02} + {1288486800 -10800 0 -03} + {1301187600 -7200 1 -02} + {1319936400 -10800 0 -03} + {1332637200 -7200 1 -02} + {1351386000 -10800 0 -03} + {1364691600 -7200 1 -02} + {1382835600 -10800 0 -03} + {1396141200 -7200 1 -02} + {1414285200 -10800 0 -03} + {1427590800 -7200 1 -02} + {1445734800 -10800 0 -03} + {1459040400 -7200 1 -02} + {1477789200 -10800 0 -03} + {1490490000 -7200 1 -02} + {1509238800 -10800 0 -03} + {1521939600 -7200 1 -02} + {1540688400 -10800 0 -03} + {1553994000 -7200 1 -02} + {1572138000 -10800 0 -03} + {1585443600 -7200 1 -02} + {1603587600 -10800 0 -03} + {1616893200 -7200 1 -02} + {1635642000 -10800 0 -03} + {1648342800 -7200 1 -02} + {1667091600 -10800 0 -03} + {1679792400 -7200 1 -02} + {1698541200 -10800 0 -03} + {1711846800 -7200 1 -02} + {1729990800 -10800 0 -03} + {1743296400 -7200 1 -02} + {1761440400 -10800 0 -03} + {1774746000 -7200 1 -02} + {1792890000 -10800 0 -03} + {1806195600 -7200 1 -02} + {1824944400 -10800 0 -03} + {1837645200 -7200 1 -02} + {1856394000 -10800 0 -03} + {1869094800 -7200 1 -02} + {1887843600 -10800 0 -03} + {1901149200 -7200 1 -02} + {1919293200 -10800 0 -03} + {1932598800 -7200 1 -02} + {1950742800 -10800 0 -03} + {1964048400 -7200 1 -02} + {1982797200 -10800 0 -03} + {1995498000 -7200 1 -02} + {2014246800 -10800 0 -03} + {2026947600 -7200 1 -02} + {2045696400 -10800 0 -03} + {2058397200 -7200 1 -02} + {2077146000 -10800 0 -03} + {2090451600 -7200 1 -02} + {2108595600 -10800 0 -03} + {2121901200 -7200 1 -02} + {2140045200 -10800 0 -03} + {2153350800 -7200 1 -02} + {2172099600 -10800 0 -03} + {2184800400 -7200 1 -02} + {2203549200 -10800 0 -03} + {2216250000 -7200 1 -02} + {2234998800 -10800 0 -03} + {2248304400 -7200 1 -02} + {2266448400 -10800 0 -03} + {2279754000 -7200 1 -02} + {2297898000 -10800 0 -03} + {2311203600 -7200 1 -02} + {2329347600 -10800 0 -03} + {2342653200 -7200 1 -02} + {2361402000 -10800 0 -03} + {2374102800 -7200 1 -02} + {2392851600 -10800 0 -03} + {2405552400 -7200 1 -02} + {2424301200 -10800 0 -03} + {2437606800 -7200 1 -02} + {2455750800 -10800 0 -03} + {2469056400 -7200 1 -02} + {2487200400 -10800 0 -03} + {2500506000 -7200 1 -02} + {2519254800 -10800 0 -03} + {2531955600 -7200 1 -02} + {2550704400 -10800 0 -03} + {2563405200 -7200 1 -02} + {2582154000 -10800 0 -03} + {2595459600 -7200 1 -02} + {2613603600 -10800 0 -03} + {2626909200 -7200 1 -02} + {2645053200 -10800 0 -03} + {2658358800 -7200 1 -02} + {2676502800 -10800 0 -03} + {2689808400 -7200 1 -02} + {2708557200 -10800 0 -03} + {2721258000 -7200 1 -02} + {2740006800 -10800 0 -03} + {2752707600 -7200 1 -02} + {2771456400 -10800 0 -03} + {2784762000 -7200 1 -02} + {2802906000 -10800 0 -03} + {2816211600 -7200 1 -02} + {2834355600 -10800 0 -03} + {2847661200 -7200 1 -02} + {2866410000 -10800 0 -03} + {2879110800 -7200 1 -02} + {2897859600 -10800 0 -03} + {2910560400 -7200 1 -02} + {2929309200 -10800 0 -03} + {2942010000 -7200 1 -02} + {2960758800 -10800 0 -03} + {2974064400 -7200 1 -02} + {2992208400 -10800 0 -03} + {3005514000 -7200 1 -02} + {3023658000 -10800 0 -03} + {3036963600 -7200 1 -02} + {3055712400 -10800 0 -03} + {3068413200 -7200 1 -02} + {3087162000 -10800 0 -03} + {3099862800 -7200 1 -02} + {3118611600 -10800 0 -03} + {3131917200 -7200 1 -02} + {3150061200 -10800 0 -03} + {3163366800 -7200 1 -02} + {3181510800 -10800 0 -03} + {3194816400 -7200 1 -02} + {3212960400 -10800 0 -03} + {3226266000 -7200 1 -02} + {3245014800 -10800 0 -03} + {3257715600 -7200 1 -02} + {3276464400 -10800 0 -03} + {3289165200 -7200 1 -02} + {3307914000 -10800 0 -03} + {3321219600 -7200 1 -02} + {3339363600 -10800 0 -03} + {3352669200 -7200 1 -02} + {3370813200 -10800 0 -03} + {3384118800 -7200 1 -02} + {3402867600 -10800 0 -03} + {3415568400 -7200 1 -02} + {3434317200 -10800 0 -03} + {3447018000 -7200 1 -02} + {3465766800 -10800 0 -03} + {3479072400 -7200 1 -02} + {3497216400 -10800 0 -03} + {3510522000 -7200 1 -02} + {3528666000 -10800 0 -03} + {3541971600 -7200 1 -02} + {3560115600 -10800 0 -03} + {3573421200 -7200 1 -02} + {3592170000 -10800 0 -03} + {3604870800 -7200 1 -02} + {3623619600 -10800 0 -03} + {3636320400 -7200 1 -02} + {3655069200 -10800 0 -03} + {3668374800 -7200 1 -02} + {3686518800 -10800 0 -03} + {3699824400 -7200 1 -02} + {3717968400 -10800 0 -03} + {3731274000 -7200 1 -02} + {3750022800 -10800 0 -03} + {3762723600 -7200 1 -02} + {3781472400 -10800 0 -03} + {3794173200 -7200 1 -02} + {3812922000 -10800 0 -03} + {3825622800 -7200 1 -02} + {3844371600 -10800 0 -03} + {3857677200 -7200 1 -02} + {3875821200 -10800 0 -03} + {3889126800 -7200 1 -02} + {3907270800 -10800 0 -03} + {3920576400 -7200 1 -02} + {3939325200 -10800 0 -03} + {3952026000 -7200 1 -02} + {3970774800 -10800 0 -03} + {3983475600 -7200 1 -02} + {4002224400 -10800 0 -03} + {4015530000 -7200 1 -02} + {4033674000 -10800 0 -03} + {4046979600 -7200 1 -02} + {4065123600 -10800 0 -03} + {4078429200 -7200 1 -02} + {4096573200 -10800 0 -03} +} Index: library/tzdata/America/Sao_Paulo ================================================================== --- library/tzdata/America/Sao_Paulo +++ library/tzdata/America/Sao_Paulo @@ -92,167 +92,6 @@ {1487469600 -10800 0 -03} {1508036400 -7200 1 -03} {1518919200 -10800 0 -03} {1541300400 -7200 1 -03} {1550368800 -10800 0 -03} - {1572750000 -7200 1 -03} - {1581818400 -10800 0 -03} - {1604199600 -7200 1 -03} - {1613872800 -10800 0 -03} - {1636254000 -7200 1 -03} - {1645322400 -10800 0 -03} - {1667703600 -7200 1 -03} - {1677376800 -10800 0 -03} - {1699153200 -7200 1 -03} - {1708221600 -10800 0 -03} - {1730602800 -7200 1 -03} - {1739671200 -10800 0 -03} - {1762052400 -7200 1 -03} - {1771725600 -10800 0 -03} - {1793502000 -7200 1 -03} - {1803175200 -10800 0 -03} - {1825556400 -7200 1 -03} - {1834624800 -10800 0 -03} - {1857006000 -7200 1 -03} - {1866074400 -10800 0 -03} - {1888455600 -7200 1 -03} - {1897524000 -10800 0 -03} - {1919905200 -7200 1 -03} - {1928973600 -10800 0 -03} - {1951354800 -7200 1 -03} - {1960423200 -10800 0 -03} - {1983409200 -7200 1 -03} - {1992477600 -10800 0 -03} - {2014858800 -7200 1 -03} - {2024532000 -10800 0 -03} - {2046308400 -7200 1 -03} - {2055376800 -10800 0 -03} - {2077758000 -7200 1 -03} - {2086826400 -10800 0 -03} - {2109207600 -7200 1 -03} - {2118880800 -10800 0 -03} - {2140657200 -7200 1 -03} - {2150330400 -10800 0 -03} - {2172711600 -7200 1 -03} - {2181780000 -10800 0 -03} - {2204161200 -7200 1 -03} - {2213229600 -10800 0 -03} - {2235610800 -7200 1 -03} - {2244679200 -10800 0 -03} - {2267060400 -7200 1 -03} - {2276128800 -10800 0 -03} - {2298510000 -7200 1 -03} - {2307578400 -10800 0 -03} - {2329959600 -7200 1 -03} - {2339632800 -10800 0 -03} - {2362014000 -7200 1 -03} - {2371082400 -10800 0 -03} - {2393463600 -7200 1 -03} - {2402532000 -10800 0 -03} - {2424913200 -7200 1 -03} - {2433981600 -10800 0 -03} - {2456362800 -7200 1 -03} - {2465431200 -10800 0 -03} - {2487812400 -7200 1 -03} - {2497485600 -10800 0 -03} - {2519866800 -7200 1 -03} - {2528935200 -10800 0 -03} - {2551316400 -7200 1 -03} - {2560384800 -10800 0 -03} - {2582766000 -7200 1 -03} - {2591834400 -10800 0 -03} - {2614215600 -7200 1 -03} - {2623284000 -10800 0 -03} - {2645665200 -7200 1 -03} - {2654733600 -10800 0 -03} - {2677114800 -7200 1 -03} - {2686788000 -10800 0 -03} - {2709169200 -7200 1 -03} - {2718237600 -10800 0 -03} - {2740618800 -7200 1 -03} - {2749687200 -10800 0 -03} - {2772068400 -7200 1 -03} - {2781136800 -10800 0 -03} - {2803518000 -7200 1 -03} - {2812586400 -10800 0 -03} - {2834967600 -7200 1 -03} - {2844036000 -10800 0 -03} - {2867022000 -7200 1 -03} - {2876090400 -10800 0 -03} - {2898471600 -7200 1 -03} - {2907540000 -10800 0 -03} - {2929921200 -7200 1 -03} - {2938989600 -10800 0 -03} - {2961370800 -7200 1 -03} - {2970439200 -10800 0 -03} - {2992820400 -7200 1 -03} - {3001888800 -10800 0 -03} - {3024270000 -7200 1 -03} - {3033943200 -10800 0 -03} - {3056324400 -7200 1 -03} - {3065392800 -10800 0 -03} - {3087774000 -7200 1 -03} - {3096842400 -10800 0 -03} - {3119223600 -7200 1 -03} - {3128292000 -10800 0 -03} - {3150673200 -7200 1 -03} - {3159741600 -10800 0 -03} - {3182122800 -7200 1 -03} - {3191191200 -10800 0 -03} - {3213572400 -7200 1 -03} - {3223245600 -10800 0 -03} - {3245626800 -7200 1 -03} - {3254695200 -10800 0 -03} - {3277076400 -7200 1 -03} - {3286144800 -10800 0 -03} - {3308526000 -7200 1 -03} - {3317594400 -10800 0 -03} - {3339975600 -7200 1 -03} - {3349044000 -10800 0 -03} - {3371425200 -7200 1 -03} - {3381098400 -10800 0 -03} - {3403479600 -7200 1 -03} - {3412548000 -10800 0 -03} - {3434929200 -7200 1 -03} - {3443997600 -10800 0 -03} - {3466378800 -7200 1 -03} - {3475447200 -10800 0 -03} - {3497828400 -7200 1 -03} - {3506896800 -10800 0 -03} - {3529278000 -7200 1 -03} - {3538346400 -10800 0 -03} - {3560727600 -7200 1 -03} - {3570400800 -10800 0 -03} - {3592782000 -7200 1 -03} - {3601850400 -10800 0 -03} - {3624231600 -7200 1 -03} - {3633300000 -10800 0 -03} - {3655681200 -7200 1 -03} - {3664749600 -10800 0 -03} - {3687130800 -7200 1 -03} - {3696199200 -10800 0 -03} - {3718580400 -7200 1 -03} - {3727648800 -10800 0 -03} - {3750634800 -7200 1 -03} - {3759703200 -10800 0 -03} - {3782084400 -7200 1 -03} - {3791152800 -10800 0 -03} - {3813534000 -7200 1 -03} - {3822602400 -10800 0 -03} - {3844983600 -7200 1 -03} - {3854052000 -10800 0 -03} - {3876433200 -7200 1 -03} - {3885501600 -10800 0 -03} - {3907882800 -7200 1 -03} - {3917556000 -10800 0 -03} - {3939937200 -7200 1 -03} - {3949005600 -10800 0 -03} - {3971386800 -7200 1 -03} - {3980455200 -10800 0 -03} - {4002836400 -7200 1 -03} - {4011904800 -10800 0 -03} - {4034286000 -7200 1 -03} - {4043354400 -10800 0 -03} - {4065735600 -7200 1 -03} - {4074804000 -10800 0 -03} - {4097185200 -7200 1 -03} } Index: library/tzdata/America/Vancouver ================================================================== --- library/tzdata/America/Vancouver +++ library/tzdata/America/Vancouver @@ -7,11 +7,11 @@ {-1615129200 -28800 0 PST} {-880207200 -25200 1 PWT} {-769395600 -25200 1 PPT} {-765385200 -28800 0 PST} {-747237600 -25200 1 PDT} - {-732726000 -28800 0 PST} + {-733935600 -28800 0 PST} {-715788000 -25200 1 PDT} {-702486000 -28800 0 PST} {-684338400 -25200 1 PDT} {-671036400 -28800 0 PST} {-652888800 -25200 1 PDT} Index: library/tzdata/America/Whitehorse ================================================================== --- library/tzdata/America/Whitehorse +++ library/tzdata/America/Whitehorse @@ -91,166 +91,7 @@ {1509872400 -28800 0 PST} {1520762400 -25200 1 PDT} {1541322000 -28800 0 PST} {1552212000 -25200 1 PDT} {1572771600 -28800 0 PST} - {1583661600 -25200 1 PDT} - {1604221200 -28800 0 PST} - {1615716000 -25200 1 PDT} - {1636275600 -28800 0 PST} - {1647165600 -25200 1 PDT} - {1667725200 -28800 0 PST} - {1678615200 -25200 1 PDT} - {1699174800 -28800 0 PST} - {1710064800 -25200 1 PDT} - {1730624400 -28800 0 PST} - {1741514400 -25200 1 PDT} - {1762074000 -28800 0 PST} - {1772964000 -25200 1 PDT} - {1793523600 -28800 0 PST} - {1805018400 -25200 1 PDT} - {1825578000 -28800 0 PST} - {1836468000 -25200 1 PDT} - {1857027600 -28800 0 PST} - {1867917600 -25200 1 PDT} - {1888477200 -28800 0 PST} - {1899367200 -25200 1 PDT} - {1919926800 -28800 0 PST} - {1930816800 -25200 1 PDT} - {1951376400 -28800 0 PST} - {1962871200 -25200 1 PDT} - {1983430800 -28800 0 PST} - {1994320800 -25200 1 PDT} - {2014880400 -28800 0 PST} - {2025770400 -25200 1 PDT} - {2046330000 -28800 0 PST} - {2057220000 -25200 1 PDT} - {2077779600 -28800 0 PST} - {2088669600 -25200 1 PDT} - {2109229200 -28800 0 PST} - {2120119200 -25200 1 PDT} - {2140678800 -28800 0 PST} - {2152173600 -25200 1 PDT} - {2172733200 -28800 0 PST} - {2183623200 -25200 1 PDT} - {2204182800 -28800 0 PST} - {2215072800 -25200 1 PDT} - {2235632400 -28800 0 PST} - {2246522400 -25200 1 PDT} - {2267082000 -28800 0 PST} - {2277972000 -25200 1 PDT} - {2298531600 -28800 0 PST} - {2309421600 -25200 1 PDT} - {2329981200 -28800 0 PST} - {2341476000 -25200 1 PDT} - {2362035600 -28800 0 PST} - {2372925600 -25200 1 PDT} - {2393485200 -28800 0 PST} - {2404375200 -25200 1 PDT} - {2424934800 -28800 0 PST} - {2435824800 -25200 1 PDT} - {2456384400 -28800 0 PST} - {2467274400 -25200 1 PDT} - {2487834000 -28800 0 PST} - {2499328800 -25200 1 PDT} - {2519888400 -28800 0 PST} - {2530778400 -25200 1 PDT} - {2551338000 -28800 0 PST} - {2562228000 -25200 1 PDT} - {2582787600 -28800 0 PST} - {2593677600 -25200 1 PDT} - {2614237200 -28800 0 PST} - {2625127200 -25200 1 PDT} - {2645686800 -28800 0 PST} - {2656576800 -25200 1 PDT} - {2677136400 -28800 0 PST} - {2688631200 -25200 1 PDT} - {2709190800 -28800 0 PST} - {2720080800 -25200 1 PDT} - {2740640400 -28800 0 PST} - {2751530400 -25200 1 PDT} - {2772090000 -28800 0 PST} - {2782980000 -25200 1 PDT} - {2803539600 -28800 0 PST} - {2814429600 -25200 1 PDT} - {2834989200 -28800 0 PST} - {2846484000 -25200 1 PDT} - {2867043600 -28800 0 PST} - {2877933600 -25200 1 PDT} - {2898493200 -28800 0 PST} - {2909383200 -25200 1 PDT} - {2929942800 -28800 0 PST} - {2940832800 -25200 1 PDT} - {2961392400 -28800 0 PST} - {2972282400 -25200 1 PDT} - {2992842000 -28800 0 PST} - {3003732000 -25200 1 PDT} - {3024291600 -28800 0 PST} - {3035786400 -25200 1 PDT} - {3056346000 -28800 0 PST} - {3067236000 -25200 1 PDT} - {3087795600 -28800 0 PST} - {3098685600 -25200 1 PDT} - {3119245200 -28800 0 PST} - {3130135200 -25200 1 PDT} - {3150694800 -28800 0 PST} - {3161584800 -25200 1 PDT} - {3182144400 -28800 0 PST} - {3193034400 -25200 1 PDT} - {3213594000 -28800 0 PST} - {3225088800 -25200 1 PDT} - {3245648400 -28800 0 PST} - {3256538400 -25200 1 PDT} - {3277098000 -28800 0 PST} - {3287988000 -25200 1 PDT} - {3308547600 -28800 0 PST} - {3319437600 -25200 1 PDT} - {3339997200 -28800 0 PST} - {3350887200 -25200 1 PDT} - {3371446800 -28800 0 PST} - {3382941600 -25200 1 PDT} - {3403501200 -28800 0 PST} - {3414391200 -25200 1 PDT} - {3434950800 -28800 0 PST} - {3445840800 -25200 1 PDT} - {3466400400 -28800 0 PST} - {3477290400 -25200 1 PDT} - {3497850000 -28800 0 PST} - {3508740000 -25200 1 PDT} - {3529299600 -28800 0 PST} - {3540189600 -25200 1 PDT} - {3560749200 -28800 0 PST} - {3572244000 -25200 1 PDT} - {3592803600 -28800 0 PST} - {3603693600 -25200 1 PDT} - {3624253200 -28800 0 PST} - {3635143200 -25200 1 PDT} - {3655702800 -28800 0 PST} - {3666592800 -25200 1 PDT} - {3687152400 -28800 0 PST} - {3698042400 -25200 1 PDT} - {3718602000 -28800 0 PST} - {3730096800 -25200 1 PDT} - {3750656400 -28800 0 PST} - {3761546400 -25200 1 PDT} - {3782106000 -28800 0 PST} - {3792996000 -25200 1 PDT} - {3813555600 -28800 0 PST} - {3824445600 -25200 1 PDT} - {3845005200 -28800 0 PST} - {3855895200 -25200 1 PDT} - {3876454800 -28800 0 PST} - {3887344800 -25200 1 PDT} - {3907904400 -28800 0 PST} - {3919399200 -25200 1 PDT} - {3939958800 -28800 0 PST} - {3950848800 -25200 1 PDT} - {3971408400 -28800 0 PST} - {3982298400 -25200 1 PDT} - {4002858000 -28800 0 PST} - {4013748000 -25200 1 PDT} - {4034307600 -28800 0 PST} - {4045197600 -25200 1 PDT} - {4065757200 -28800 0 PST} - {4076647200 -25200 1 PDT} - {4097206800 -28800 0 PST} + {1583661600 -25200 0 MST} } Index: library/tzdata/Asia/Gaza ================================================================== --- library/tzdata/Asia/Gaza +++ library/tzdata/Asia/Gaza @@ -115,168 +115,168 @@ {1477692000 7200 0 EET} {1490396400 10800 1 EEST} {1509141600 7200 0 EET} {1521846000 10800 1 EEST} {1540591200 7200 0 EET} - {1553900400 10800 1 EEST} + {1553810400 10800 1 EEST} {1572040800 7200 0 EET} - {1585350000 10800 1 EEST} + {1585260000 10800 1 EEST} {1604095200 7200 0 EET} - {1616799600 10800 1 EEST} + {1616709600 10800 1 EEST} {1635544800 7200 0 EET} - {1648249200 10800 1 EEST} + {1648159200 10800 1 EEST} {1666994400 7200 0 EET} - {1679698800 10800 1 EEST} + {1680213600 10800 1 EEST} {1698444000 7200 0 EET} - {1711753200 10800 1 EEST} + {1711663200 10800 1 EEST} {1729893600 7200 0 EET} - {1743202800 10800 1 EEST} + {1743112800 10800 1 EEST} {1761343200 7200 0 EET} - {1774652400 10800 1 EEST} + {1774562400 10800 1 EEST} {1793397600 7200 0 EET} - {1806102000 10800 1 EEST} + {1806012000 10800 1 EEST} {1824847200 7200 0 EET} - {1837551600 10800 1 EEST} + {1838066400 10800 1 EEST} {1856296800 7200 0 EET} - {1869001200 10800 1 EEST} + {1869516000 10800 1 EEST} {1887746400 7200 0 EET} - {1901055600 10800 1 EEST} + {1900965600 10800 1 EEST} {1919196000 7200 0 EET} - {1932505200 10800 1 EEST} + {1932415200 10800 1 EEST} {1950645600 7200 0 EET} - {1963954800 10800 1 EEST} + {1963864800 10800 1 EEST} {1982700000 7200 0 EET} - {1995404400 10800 1 EEST} + {1995314400 10800 1 EEST} {2014149600 7200 0 EET} - {2026854000 10800 1 EEST} + {2027368800 10800 1 EEST} {2045599200 7200 0 EET} - {2058303600 10800 1 EEST} + {2058818400 10800 1 EEST} {2077048800 7200 0 EET} - {2090358000 10800 1 EEST} + {2090268000 10800 1 EEST} {2108498400 7200 0 EET} - {2121807600 10800 1 EEST} + {2121717600 10800 1 EEST} {2140552800 7200 0 EET} - {2153257200 10800 1 EEST} + {2153167200 10800 1 EEST} {2172002400 7200 0 EET} - {2184706800 10800 1 EEST} + {2184616800 10800 1 EEST} {2203452000 7200 0 EET} - {2216156400 10800 1 EEST} + {2216671200 10800 1 EEST} {2234901600 7200 0 EET} - {2248210800 10800 1 EEST} + {2248120800 10800 1 EEST} {2266351200 7200 0 EET} - {2279660400 10800 1 EEST} + {2279570400 10800 1 EEST} {2297800800 7200 0 EET} - {2311110000 10800 1 EEST} + {2311020000 10800 1 EEST} {2329855200 7200 0 EET} - {2342559600 10800 1 EEST} + {2342469600 10800 1 EEST} {2361304800 7200 0 EET} - {2374009200 10800 1 EEST} + {2374524000 10800 1 EEST} {2392754400 7200 0 EET} - {2405458800 10800 1 EEST} + {2405973600 10800 1 EEST} {2424204000 7200 0 EET} - {2437513200 10800 1 EEST} + {2437423200 10800 1 EEST} {2455653600 7200 0 EET} - {2468962800 10800 1 EEST} + {2468872800 10800 1 EEST} {2487708000 7200 0 EET} - {2500412400 10800 1 EEST} + {2500322400 10800 1 EEST} {2519157600 7200 0 EET} - {2531862000 10800 1 EEST} + {2531772000 10800 1 EEST} {2550607200 7200 0 EET} - {2563311600 10800 1 EEST} + {2563826400 10800 1 EEST} {2582056800 7200 0 EET} - {2595366000 10800 1 EEST} + {2595276000 10800 1 EEST} {2613506400 7200 0 EET} - {2626815600 10800 1 EEST} + {2626725600 10800 1 EEST} {2644956000 7200 0 EET} - {2658265200 10800 1 EEST} + {2658175200 10800 1 EEST} {2677010400 7200 0 EET} - {2689714800 10800 1 EEST} + {2689624800 10800 1 EEST} {2708460000 7200 0 EET} - {2721164400 10800 1 EEST} + {2721679200 10800 1 EEST} {2739909600 7200 0 EET} - {2752614000 10800 1 EEST} + {2753128800 10800 1 EEST} {2771359200 7200 0 EET} - {2784668400 10800 1 EEST} + {2784578400 10800 1 EEST} {2802808800 7200 0 EET} - {2816118000 10800 1 EEST} + {2816028000 10800 1 EEST} {2834258400 7200 0 EET} - {2847567600 10800 1 EEST} + {2847477600 10800 1 EEST} {2866312800 7200 0 EET} - {2879017200 10800 1 EEST} + {2878927200 10800 1 EEST} {2897762400 7200 0 EET} - {2910466800 10800 1 EEST} + {2910981600 10800 1 EEST} {2929212000 7200 0 EET} - {2941916400 10800 1 EEST} + {2942431200 10800 1 EEST} {2960661600 7200 0 EET} - {2973970800 10800 1 EEST} + {2973880800 10800 1 EEST} {2992111200 7200 0 EET} - {3005420400 10800 1 EEST} + {3005330400 10800 1 EEST} {3024165600 7200 0 EET} - {3036870000 10800 1 EEST} + {3036780000 10800 1 EEST} {3055615200 7200 0 EET} - {3068319600 10800 1 EEST} + {3068229600 10800 1 EEST} {3087064800 7200 0 EET} - {3099769200 10800 1 EEST} + {3100284000 10800 1 EEST} {3118514400 7200 0 EET} - {3131823600 10800 1 EEST} + {3131733600 10800 1 EEST} {3149964000 7200 0 EET} - {3163273200 10800 1 EEST} + {3163183200 10800 1 EEST} {3181413600 7200 0 EET} - {3194722800 10800 1 EEST} + {3194632800 10800 1 EEST} {3213468000 7200 0 EET} - {3226172400 10800 1 EEST} + {3226082400 10800 1 EEST} {3244917600 7200 0 EET} - {3257622000 10800 1 EEST} + {3258136800 10800 1 EEST} {3276367200 7200 0 EET} - {3289071600 10800 1 EEST} + {3289586400 10800 1 EEST} {3307816800 7200 0 EET} - {3321126000 10800 1 EEST} + {3321036000 10800 1 EEST} {3339266400 7200 0 EET} - {3352575600 10800 1 EEST} + {3352485600 10800 1 EEST} {3371320800 7200 0 EET} - {3384025200 10800 1 EEST} + {3383935200 10800 1 EEST} {3402770400 7200 0 EET} - {3415474800 10800 1 EEST} + {3415384800 10800 1 EEST} {3434220000 7200 0 EET} - {3446924400 10800 1 EEST} + {3447439200 10800 1 EEST} {3465669600 7200 0 EET} - {3478978800 10800 1 EEST} + {3478888800 10800 1 EEST} {3497119200 7200 0 EET} - {3510428400 10800 1 EEST} + {3510338400 10800 1 EEST} {3528568800 7200 0 EET} - {3541878000 10800 1 EEST} + {3541788000 10800 1 EEST} {3560623200 7200 0 EET} - {3573327600 10800 1 EEST} + {3573237600 10800 1 EEST} {3592072800 7200 0 EET} - {3604777200 10800 1 EEST} + {3605292000 10800 1 EEST} {3623522400 7200 0 EET} - {3636226800 10800 1 EEST} + {3636741600 10800 1 EEST} {3654972000 7200 0 EET} - {3668281200 10800 1 EEST} + {3668191200 10800 1 EEST} {3686421600 7200 0 EET} - {3699730800 10800 1 EEST} + {3699640800 10800 1 EEST} {3717871200 7200 0 EET} - {3731180400 10800 1 EEST} + {3731090400 10800 1 EEST} {3749925600 7200 0 EET} - {3762630000 10800 1 EEST} + {3762540000 10800 1 EEST} {3781375200 7200 0 EET} - {3794079600 10800 1 EEST} + {3794594400 10800 1 EEST} {3812824800 7200 0 EET} - {3825529200 10800 1 EEST} + {3826044000 10800 1 EEST} {3844274400 7200 0 EET} - {3857583600 10800 1 EEST} + {3857493600 10800 1 EEST} {3875724000 7200 0 EET} - {3889033200 10800 1 EEST} + {3888943200 10800 1 EEST} {3907778400 7200 0 EET} - {3920482800 10800 1 EEST} + {3920392800 10800 1 EEST} {3939228000 7200 0 EET} - {3951932400 10800 1 EEST} + {3951842400 10800 1 EEST} {3970677600 7200 0 EET} - {3983382000 10800 1 EEST} + {3983896800 10800 1 EEST} {4002127200 7200 0 EET} - {4015436400 10800 1 EEST} + {4015346400 10800 1 EEST} {4033576800 7200 0 EET} - {4046886000 10800 1 EEST} + {4046796000 10800 1 EEST} {4065026400 7200 0 EET} - {4078335600 10800 1 EEST} + {4078245600 10800 1 EEST} {4097080800 7200 0 EET} } Index: library/tzdata/Asia/Hebron ================================================================== --- library/tzdata/Asia/Hebron +++ library/tzdata/Asia/Hebron @@ -114,168 +114,168 @@ {1477692000 7200 0 EET} {1490396400 10800 1 EEST} {1509141600 7200 0 EET} {1521846000 10800 1 EEST} {1540591200 7200 0 EET} - {1553900400 10800 1 EEST} + {1553810400 10800 1 EEST} {1572040800 7200 0 EET} - {1585350000 10800 1 EEST} + {1585260000 10800 1 EEST} {1604095200 7200 0 EET} - {1616799600 10800 1 EEST} + {1616709600 10800 1 EEST} {1635544800 7200 0 EET} - {1648249200 10800 1 EEST} + {1648159200 10800 1 EEST} {1666994400 7200 0 EET} - {1679698800 10800 1 EEST} + {1680213600 10800 1 EEST} {1698444000 7200 0 EET} - {1711753200 10800 1 EEST} + {1711663200 10800 1 EEST} {1729893600 7200 0 EET} - {1743202800 10800 1 EEST} + {1743112800 10800 1 EEST} {1761343200 7200 0 EET} - {1774652400 10800 1 EEST} + {1774562400 10800 1 EEST} {1793397600 7200 0 EET} - {1806102000 10800 1 EEST} + {1806012000 10800 1 EEST} {1824847200 7200 0 EET} - {1837551600 10800 1 EEST} + {1838066400 10800 1 EEST} {1856296800 7200 0 EET} - {1869001200 10800 1 EEST} + {1869516000 10800 1 EEST} {1887746400 7200 0 EET} - {1901055600 10800 1 EEST} + {1900965600 10800 1 EEST} {1919196000 7200 0 EET} - {1932505200 10800 1 EEST} + {1932415200 10800 1 EEST} {1950645600 7200 0 EET} - {1963954800 10800 1 EEST} + {1963864800 10800 1 EEST} {1982700000 7200 0 EET} - {1995404400 10800 1 EEST} + {1995314400 10800 1 EEST} {2014149600 7200 0 EET} - {2026854000 10800 1 EEST} + {2027368800 10800 1 EEST} {2045599200 7200 0 EET} - {2058303600 10800 1 EEST} + {2058818400 10800 1 EEST} {2077048800 7200 0 EET} - {2090358000 10800 1 EEST} + {2090268000 10800 1 EEST} {2108498400 7200 0 EET} - {2121807600 10800 1 EEST} + {2121717600 10800 1 EEST} {2140552800 7200 0 EET} - {2153257200 10800 1 EEST} + {2153167200 10800 1 EEST} {2172002400 7200 0 EET} - {2184706800 10800 1 EEST} + {2184616800 10800 1 EEST} {2203452000 7200 0 EET} - {2216156400 10800 1 EEST} + {2216671200 10800 1 EEST} {2234901600 7200 0 EET} - {2248210800 10800 1 EEST} + {2248120800 10800 1 EEST} {2266351200 7200 0 EET} - {2279660400 10800 1 EEST} + {2279570400 10800 1 EEST} {2297800800 7200 0 EET} - {2311110000 10800 1 EEST} + {2311020000 10800 1 EEST} {2329855200 7200 0 EET} - {2342559600 10800 1 EEST} + {2342469600 10800 1 EEST} {2361304800 7200 0 EET} - {2374009200 10800 1 EEST} + {2374524000 10800 1 EEST} {2392754400 7200 0 EET} - {2405458800 10800 1 EEST} + {2405973600 10800 1 EEST} {2424204000 7200 0 EET} - {2437513200 10800 1 EEST} + {2437423200 10800 1 EEST} {2455653600 7200 0 EET} - {2468962800 10800 1 EEST} + {2468872800 10800 1 EEST} {2487708000 7200 0 EET} - {2500412400 10800 1 EEST} + {2500322400 10800 1 EEST} {2519157600 7200 0 EET} - {2531862000 10800 1 EEST} + {2531772000 10800 1 EEST} {2550607200 7200 0 EET} - {2563311600 10800 1 EEST} + {2563826400 10800 1 EEST} {2582056800 7200 0 EET} - {2595366000 10800 1 EEST} + {2595276000 10800 1 EEST} {2613506400 7200 0 EET} - {2626815600 10800 1 EEST} + {2626725600 10800 1 EEST} {2644956000 7200 0 EET} - {2658265200 10800 1 EEST} + {2658175200 10800 1 EEST} {2677010400 7200 0 EET} - {2689714800 10800 1 EEST} + {2689624800 10800 1 EEST} {2708460000 7200 0 EET} - {2721164400 10800 1 EEST} + {2721679200 10800 1 EEST} {2739909600 7200 0 EET} - {2752614000 10800 1 EEST} + {2753128800 10800 1 EEST} {2771359200 7200 0 EET} - {2784668400 10800 1 EEST} + {2784578400 10800 1 EEST} {2802808800 7200 0 EET} - {2816118000 10800 1 EEST} + {2816028000 10800 1 EEST} {2834258400 7200 0 EET} - {2847567600 10800 1 EEST} + {2847477600 10800 1 EEST} {2866312800 7200 0 EET} - {2879017200 10800 1 EEST} + {2878927200 10800 1 EEST} {2897762400 7200 0 EET} - {2910466800 10800 1 EEST} + {2910981600 10800 1 EEST} {2929212000 7200 0 EET} - {2941916400 10800 1 EEST} + {2942431200 10800 1 EEST} {2960661600 7200 0 EET} - {2973970800 10800 1 EEST} + {2973880800 10800 1 EEST} {2992111200 7200 0 EET} - {3005420400 10800 1 EEST} + {3005330400 10800 1 EEST} {3024165600 7200 0 EET} - {3036870000 10800 1 EEST} + {3036780000 10800 1 EEST} {3055615200 7200 0 EET} - {3068319600 10800 1 EEST} + {3068229600 10800 1 EEST} {3087064800 7200 0 EET} - {3099769200 10800 1 EEST} + {3100284000 10800 1 EEST} {3118514400 7200 0 EET} - {3131823600 10800 1 EEST} + {3131733600 10800 1 EEST} {3149964000 7200 0 EET} - {3163273200 10800 1 EEST} + {3163183200 10800 1 EEST} {3181413600 7200 0 EET} - {3194722800 10800 1 EEST} + {3194632800 10800 1 EEST} {3213468000 7200 0 EET} - {3226172400 10800 1 EEST} + {3226082400 10800 1 EEST} {3244917600 7200 0 EET} - {3257622000 10800 1 EEST} + {3258136800 10800 1 EEST} {3276367200 7200 0 EET} - {3289071600 10800 1 EEST} + {3289586400 10800 1 EEST} {3307816800 7200 0 EET} - {3321126000 10800 1 EEST} + {3321036000 10800 1 EEST} {3339266400 7200 0 EET} - {3352575600 10800 1 EEST} + {3352485600 10800 1 EEST} {3371320800 7200 0 EET} - {3384025200 10800 1 EEST} + {3383935200 10800 1 EEST} {3402770400 7200 0 EET} - {3415474800 10800 1 EEST} + {3415384800 10800 1 EEST} {3434220000 7200 0 EET} - {3446924400 10800 1 EEST} + {3447439200 10800 1 EEST} {3465669600 7200 0 EET} - {3478978800 10800 1 EEST} + {3478888800 10800 1 EEST} {3497119200 7200 0 EET} - {3510428400 10800 1 EEST} + {3510338400 10800 1 EEST} {3528568800 7200 0 EET} - {3541878000 10800 1 EEST} + {3541788000 10800 1 EEST} {3560623200 7200 0 EET} - {3573327600 10800 1 EEST} + {3573237600 10800 1 EEST} {3592072800 7200 0 EET} - {3604777200 10800 1 EEST} + {3605292000 10800 1 EEST} {3623522400 7200 0 EET} - {3636226800 10800 1 EEST} + {3636741600 10800 1 EEST} {3654972000 7200 0 EET} - {3668281200 10800 1 EEST} + {3668191200 10800 1 EEST} {3686421600 7200 0 EET} - {3699730800 10800 1 EEST} + {3699640800 10800 1 EEST} {3717871200 7200 0 EET} - {3731180400 10800 1 EEST} + {3731090400 10800 1 EEST} {3749925600 7200 0 EET} - {3762630000 10800 1 EEST} + {3762540000 10800 1 EEST} {3781375200 7200 0 EET} - {3794079600 10800 1 EEST} + {3794594400 10800 1 EEST} {3812824800 7200 0 EET} - {3825529200 10800 1 EEST} + {3826044000 10800 1 EEST} {3844274400 7200 0 EET} - {3857583600 10800 1 EEST} + {3857493600 10800 1 EEST} {3875724000 7200 0 EET} - {3889033200 10800 1 EEST} + {3888943200 10800 1 EEST} {3907778400 7200 0 EET} - {3920482800 10800 1 EEST} + {3920392800 10800 1 EEST} {3939228000 7200 0 EET} - {3951932400 10800 1 EEST} + {3951842400 10800 1 EEST} {3970677600 7200 0 EET} - {3983382000 10800 1 EEST} + {3983896800 10800 1 EEST} {4002127200 7200 0 EET} - {4015436400 10800 1 EEST} + {4015346400 10800 1 EEST} {4033576800 7200 0 EET} - {4046886000 10800 1 EEST} + {4046796000 10800 1 EEST} {4065026400 7200 0 EET} - {4078335600 10800 1 EEST} + {4078245600 10800 1 EEST} {4097080800 7200 0 EET} } Index: library/tzdata/Asia/Hong_Kong ================================================================== --- library/tzdata/Asia/Hong_Kong +++ library/tzdata/Asia/Hong_Kong @@ -1,28 +1,28 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056690800 28800 0 HKT} - {-900909000 32400 1 HKST} - {-891579600 30600 0 HKT} + {-900910800 32400 1 HKST} + {-891579600 30600 1 HKWT} {-884248200 32400 0 JST} - {-766659600 28800 0 HKT} - {-747981000 32400 1 HKST} - {-728544600 28800 0 HKT} + {-761209200 28800 0 HKT} + {-747907200 32400 1 HKST} + {-728541000 28800 0 HKT} {-717049800 32400 1 HKST} - {-694503000 28800 0 HKT} + {-697091400 28800 0 HKT} {-683785800 32400 1 HKST} - {-668064600 28800 0 HKT} + {-668061000 28800 0 HKT} {-654755400 32400 1 HKST} - {-636615000 28800 0 HKT} + {-636611400 28800 0 HKT} {-623305800 32400 1 HKST} - {-605165400 28800 0 HKT} + {-605161800 28800 0 HKT} {-591856200 32400 1 HKST} - {-573715800 28800 0 HKT} + {-573712200 28800 0 HKT} {-559801800 32400 1 HKST} - {-541661400 28800 0 HKT} + {-541657800 28800 0 HKT} {-528352200 32400 1 HKST} {-510211800 28800 0 HKT} {-498112200 32400 1 HKST} {-478762200 28800 0 HKT} {-466662600 32400 1 HKST} Index: library/tzdata/Asia/Seoul ================================================================== --- library/tzdata/Asia/Seoul +++ library/tzdata/Asia/Seoul @@ -3,10 +3,18 @@ set TZData(:Asia/Seoul) { {-9223372036854775808 30472 0 LMT} {-1948782472 30600 0 KST} {-1830414600 32400 0 JST} {-767350800 32400 0 KST} + {-681210000 36000 1 KDT} + {-672228000 32400 0 KST} + {-654771600 36000 1 KDT} + {-640864800 32400 0 KST} + {-623408400 36000 1 KDT} + {-609415200 32400 0 KST} + {-588848400 36000 1 KDT} + {-577965600 32400 0 KST} {-498128400 30600 0 KST} {-462702600 34200 1 KDT} {-451733400 30600 0 KST} {-429784200 34200 1 KDT} {-418296600 30600 0 KST} Index: library/tzdata/Asia/Shanghai ================================================================== --- library/tzdata/Asia/Shanghai +++ library/tzdata/Asia/Shanghai @@ -1,10 +1,12 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Shanghai) { {-9223372036854775808 29143 0 LMT} {-2177481943 28800 0 CST} + {-1600675200 32400 1 CDT} + {-1585904400 28800 0 CST} {-933667200 32400 1 CDT} {-922093200 28800 0 CST} {-908870400 32400 1 CDT} {-888829200 28800 0 CST} {-881049600 32400 1 CDT} Index: library/tzdata/Europe/Brussels ================================================================== --- library/tzdata/Europe/Brussels +++ library/tzdata/Europe/Brussels @@ -1,11 +1,11 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Brussels) { {-9223372036854775808 1050 0 LMT} {-2840141850 1050 0 BMT} - {-2450953050 0 0 WET} + {-2450995200 0 0 WET} {-1740355200 3600 0 CET} {-1693702800 7200 0 CEST} {-1680483600 3600 0 CET} {-1663455600 7200 1 CEST} {-1650150000 3600 0 CET} Index: library/tzdata/Europe/Istanbul ================================================================== --- library/tzdata/Europe/Istanbul +++ library/tzdata/Europe/Istanbul @@ -14,65 +14,50 @@ {-1490583600 7200 0 EET} {-1440208800 10800 1 EEST} {-1428030000 7200 0 EET} {-1409709600 10800 1 EEST} {-1396494000 7200 0 EET} - {-931140000 10800 1 EEST} - {-922762800 7200 0 EET} + {-931053600 10800 1 EEST} + {-922676400 7200 0 EET} {-917834400 10800 1 EEST} {-892436400 7200 0 EET} {-875844000 10800 1 EEST} - {-857358000 7200 0 EET} - {-781063200 10800 1 EEST} {-764737200 7200 0 EET} {-744343200 10800 1 EEST} {-733806000 7200 0 EET} {-716436000 10800 1 EEST} {-701924400 7200 0 EET} {-684986400 10800 1 EEST} {-670474800 7200 0 EET} {-654141600 10800 1 EEST} {-639025200 7200 0 EET} - {-621828000 10800 1 EEST} + {-622087200 10800 1 EEST} {-606970800 7200 0 EET} {-590032800 10800 1 EEST} - {-575434800 7200 0 EET} + {-575521200 7200 0 EET} {-235620000 10800 1 EEST} - {-228279600 7200 0 EET} + {-194842800 7200 0 EET} {-177732000 10800 1 EEST} {-165726000 7200 0 EET} - {10533600 10800 1 EEST} - {23835600 7200 0 EET} - {41983200 10800 1 EEST} - {55285200 7200 0 EET} - {74037600 10800 1 EEST} - {87339600 7200 0 EET} {107910000 10800 1 EEST} - {121219200 7200 0 EET} + {121215600 7200 0 EET} {133920000 10800 1 EEST} - {152676000 7200 0 EET} - {165362400 10800 1 EEST} - {183502800 7200 0 EET} - {202428000 10800 1 EEST} - {215557200 7200 0 EET} - {228866400 10800 1 EEST} - {245797200 7200 0 EET} - {260316000 10800 1 EEST} - {277246800 14400 0 +04} - {291769200 14400 1 +04} - {308779200 10800 0 +03} - {323827200 14400 1 +04} - {340228800 10800 0 +03} - {354672000 14400 1 +04} - {371678400 10800 0 +03} - {386121600 14400 1 +04} - {403128000 10800 0 +03} - {428446800 14400 1 +04} - {433886400 10800 0 +03} - {482792400 7200 0 EET} - {482796000 10800 1 EEST} - {496702800 7200 0 EET} + {152665200 7200 0 EET} + {164678400 10800 1 EEST} + {184114800 7200 0 EET} + {196214400 10800 1 EEST} + {215564400 7200 0 EET} + {228873600 10800 1 EEST} + {245804400 7200 0 EET} + {260323200 10800 1 EEST} + {267919200 10800 0 +03} + {277254000 10800 0 +03} + {428454000 14400 1 +04} + {433893600 10800 0 +03} + {468111600 7200 0 EET} + {482799600 10800 1 EEST} + {496710000 7200 0 EET} {512521200 10800 1 EEST} {528246000 7200 0 EET} {543970800 10800 1 EEST} {559695600 7200 0 EET} {575420400 10800 1 EEST} Index: library/tzdata/Europe/Kaliningrad ================================================================== --- library/tzdata/Europe/Kaliningrad +++ library/tzdata/Europe/Kaliningrad @@ -13,14 +13,15 @@ {-857257200 3600 0 CET} {-844556400 7200 1 CEST} {-828226800 3600 0 CET} {-812502000 7200 1 CEST} {-796777200 3600 0 CET} - {-788922000 7200 0 CET} - {-778730400 10800 1 CEST} - {-762663600 7200 0 CET} - {-757389600 10800 0 MSD} + {-781052400 7200 1 CEST} + {-780368400 7200 0 EET} + {-778730400 10800 1 EEST} + {-762663600 7200 0 EET} + {-749095200 10800 0 MSD} {354920400 14400 1 MSD} {370728000 10800 0 MSK} {386456400 14400 1 MSD} {402264000 10800 0 MSK} {417992400 14400 1 MSD} Index: library/tzdata/Europe/Rome ================================================================== --- library/tzdata/Europe/Rome +++ library/tzdata/Europe/Rome @@ -1,10 +1,10 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Rome) { {-9223372036854775808 2996 0 LMT} - {-3259097396 2996 0 RMT} + {-3252098996 2996 0 RMT} {-2403565200 3600 0 CET} {-1690765200 7200 1 CEST} {-1680487200 3600 0 CET} {-1664758800 7200 1 CEST} {-1648951200 3600 0 CET} Index: library/tzdata/Europe/Vienna ================================================================== --- library/tzdata/Europe/Vienna +++ library/tzdata/Europe/Vienna @@ -20,11 +20,11 @@ {-796777200 3600 0 CET} {-781052400 7200 1 CEST} {-780188400 3600 0 CET} {-757386000 3600 0 CET} {-748479600 7200 1 CEST} - {-733359600 3600 0 CET} + {-733273200 3600 0 CET} {-717634800 7200 1 CEST} {-701910000 3600 0 CET} {-684975600 7200 1 CEST} {-670460400 3600 0 CET} {323823600 7200 1 CEST} Index: library/tzdata/Pacific/Fiji ================================================================== --- library/tzdata/Pacific/Fiji +++ library/tzdata/Pacific/Fiji @@ -25,167 +25,167 @@ {1484402400 43200 0 +12} {1509804000 46800 1 +12} {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547301600 43200 0 +12} - {1572703200 46800 1 +12} - {1579356000 43200 0 +12} - {1604152800 46800 1 +12} + {1573308000 46800 1 +12} + {1578751200 43200 0 +12} + {1604757600 46800 1 +12} {1610805600 43200 0 +12} - {1636207200 46800 1 +12} + {1636812000 46800 1 +12} {1642255200 43200 0 +12} - {1667656800 46800 1 +12} + {1668261600 46800 1 +12} {1673704800 43200 0 +12} - {1699106400 46800 1 +12} + {1699711200 46800 1 +12} {1705154400 43200 0 +12} - {1730556000 46800 1 +12} - {1737208800 43200 0 +12} - {1762005600 46800 1 +12} + {1731160800 46800 1 +12} + {1736604000 43200 0 +12} + {1762610400 46800 1 +12} {1768658400 43200 0 +12} - {1793455200 46800 1 +12} + {1794060000 46800 1 +12} {1800108000 43200 0 +12} - {1825509600 46800 1 +12} + {1826114400 46800 1 +12} {1831557600 43200 0 +12} - {1856959200 46800 1 +12} + {1857564000 46800 1 +12} {1863007200 43200 0 +12} - {1888408800 46800 1 +12} + {1889013600 46800 1 +12} {1894456800 43200 0 +12} - {1919858400 46800 1 +12} - {1926511200 43200 0 +12} - {1951308000 46800 1 +12} + {1920463200 46800 1 +12} + {1925906400 43200 0 +12} + {1951912800 46800 1 +12} {1957960800 43200 0 +12} - {1983362400 46800 1 +12} + {1983967200 46800 1 +12} {1989410400 43200 0 +12} - {2014812000 46800 1 +12} + {2015416800 46800 1 +12} {2020860000 43200 0 +12} - {2046261600 46800 1 +12} + {2046866400 46800 1 +12} {2052309600 43200 0 +12} - {2077711200 46800 1 +12} + {2078316000 46800 1 +12} {2083759200 43200 0 +12} - {2109160800 46800 1 +12} + {2109765600 46800 1 +12} {2115813600 43200 0 +12} - {2140610400 46800 1 +12} + {2141215200 46800 1 +12} {2147263200 43200 0 +12} - {2172664800 46800 1 +12} + {2173269600 46800 1 +12} {2178712800 43200 0 +12} - {2204114400 46800 1 +12} + {2204719200 46800 1 +12} {2210162400 43200 0 +12} - {2235564000 46800 1 +12} + {2236168800 46800 1 +12} {2241612000 43200 0 +12} - {2267013600 46800 1 +12} - {2273666400 43200 0 +12} - {2298463200 46800 1 +12} + {2267618400 46800 1 +12} + {2273061600 43200 0 +12} + {2299068000 46800 1 +12} {2305116000 43200 0 +12} - {2329912800 46800 1 +12} + {2330517600 46800 1 +12} {2336565600 43200 0 +12} - {2361967200 46800 1 +12} + {2362572000 46800 1 +12} {2368015200 43200 0 +12} - {2393416800 46800 1 +12} + {2394021600 46800 1 +12} {2399464800 43200 0 +12} - {2424866400 46800 1 +12} + {2425471200 46800 1 +12} {2430914400 43200 0 +12} - {2456316000 46800 1 +12} - {2462968800 43200 0 +12} - {2487765600 46800 1 +12} + {2456920800 46800 1 +12} + {2462364000 43200 0 +12} + {2488370400 46800 1 +12} {2494418400 43200 0 +12} - {2519820000 46800 1 +12} + {2520424800 46800 1 +12} {2525868000 43200 0 +12} - {2551269600 46800 1 +12} + {2551874400 46800 1 +12} {2557317600 43200 0 +12} - {2582719200 46800 1 +12} + {2583324000 46800 1 +12} {2588767200 43200 0 +12} - {2614168800 46800 1 +12} - {2620821600 43200 0 +12} - {2645618400 46800 1 +12} + {2614773600 46800 1 +12} + {2620216800 43200 0 +12} + {2646223200 46800 1 +12} {2652271200 43200 0 +12} - {2677068000 46800 1 +12} + {2677672800 46800 1 +12} {2683720800 43200 0 +12} - {2709122400 46800 1 +12} + {2709727200 46800 1 +12} {2715170400 43200 0 +12} - {2740572000 46800 1 +12} + {2741176800 46800 1 +12} {2746620000 43200 0 +12} - {2772021600 46800 1 +12} + {2772626400 46800 1 +12} {2778069600 43200 0 +12} - {2803471200 46800 1 +12} - {2810124000 43200 0 +12} - {2834920800 46800 1 +12} + {2804076000 46800 1 +12} + {2809519200 43200 0 +12} + {2835525600 46800 1 +12} {2841573600 43200 0 +12} - {2866975200 46800 1 +12} + {2867580000 46800 1 +12} {2873023200 43200 0 +12} - {2898424800 46800 1 +12} + {2899029600 46800 1 +12} {2904472800 43200 0 +12} - {2929874400 46800 1 +12} + {2930479200 46800 1 +12} {2935922400 43200 0 +12} - {2961324000 46800 1 +12} + {2961928800 46800 1 +12} {2967372000 43200 0 +12} - {2992773600 46800 1 +12} + {2993378400 46800 1 +12} {2999426400 43200 0 +12} - {3024223200 46800 1 +12} + {3024828000 46800 1 +12} {3030876000 43200 0 +12} - {3056277600 46800 1 +12} + {3056882400 46800 1 +12} {3062325600 43200 0 +12} - {3087727200 46800 1 +12} + {3088332000 46800 1 +12} {3093775200 43200 0 +12} - {3119176800 46800 1 +12} + {3119781600 46800 1 +12} {3125224800 43200 0 +12} - {3150626400 46800 1 +12} - {3157279200 43200 0 +12} - {3182076000 46800 1 +12} + {3151231200 46800 1 +12} + {3156674400 43200 0 +12} + {3182680800 46800 1 +12} {3188728800 43200 0 +12} - {3213525600 46800 1 +12} + {3214130400 46800 1 +12} {3220178400 43200 0 +12} - {3245580000 46800 1 +12} + {3246184800 46800 1 +12} {3251628000 43200 0 +12} - {3277029600 46800 1 +12} + {3277634400 46800 1 +12} {3283077600 43200 0 +12} - {3308479200 46800 1 +12} + {3309084000 46800 1 +12} {3314527200 43200 0 +12} - {3339928800 46800 1 +12} - {3346581600 43200 0 +12} - {3371378400 46800 1 +12} + {3340533600 46800 1 +12} + {3345976800 43200 0 +12} + {3371983200 46800 1 +12} {3378031200 43200 0 +12} - {3403432800 46800 1 +12} + {3404037600 46800 1 +12} {3409480800 43200 0 +12} - {3434882400 46800 1 +12} + {3435487200 46800 1 +12} {3440930400 43200 0 +12} - {3466332000 46800 1 +12} + {3466936800 46800 1 +12} {3472380000 43200 0 +12} - {3497781600 46800 1 +12} - {3504434400 43200 0 +12} - {3529231200 46800 1 +12} + {3498386400 46800 1 +12} + {3503829600 43200 0 +12} + {3529836000 46800 1 +12} {3535884000 43200 0 +12} - {3560680800 46800 1 +12} + {3561285600 46800 1 +12} {3567333600 43200 0 +12} - {3592735200 46800 1 +12} + {3593340000 46800 1 +12} {3598783200 43200 0 +12} - {3624184800 46800 1 +12} + {3624789600 46800 1 +12} {3630232800 43200 0 +12} - {3655634400 46800 1 +12} + {3656239200 46800 1 +12} {3661682400 43200 0 +12} - {3687084000 46800 1 +12} - {3693736800 43200 0 +12} - {3718533600 46800 1 +12} + {3687688800 46800 1 +12} + {3693132000 43200 0 +12} + {3719138400 46800 1 +12} {3725186400 43200 0 +12} - {3750588000 46800 1 +12} + {3751192800 46800 1 +12} {3756636000 43200 0 +12} - {3782037600 46800 1 +12} + {3782642400 46800 1 +12} {3788085600 43200 0 +12} - {3813487200 46800 1 +12} + {3814092000 46800 1 +12} {3819535200 43200 0 +12} - {3844936800 46800 1 +12} + {3845541600 46800 1 +12} {3850984800 43200 0 +12} - {3876386400 46800 1 +12} + {3876991200 46800 1 +12} {3883039200 43200 0 +12} - {3907836000 46800 1 +12} + {3908440800 46800 1 +12} {3914488800 43200 0 +12} - {3939890400 46800 1 +12} + {3940495200 46800 1 +12} {3945938400 43200 0 +12} - {3971340000 46800 1 +12} + {3971944800 46800 1 +12} {3977388000 43200 0 +12} - {4002789600 46800 1 +12} + {4003394400 46800 1 +12} {4008837600 43200 0 +12} - {4034239200 46800 1 +12} - {4040892000 43200 0 +12} - {4065688800 46800 1 +12} + {4034844000 46800 1 +12} + {4040287200 43200 0 +12} + {4066293600 46800 1 +12} {4072341600 43200 0 +12} - {4097138400 46800 1 +12} + {4097743200 46800 1 +12} } Index: library/tzdata/Pacific/Norfolk ================================================================== --- library/tzdata/Pacific/Norfolk +++ library/tzdata/Pacific/Norfolk @@ -3,8 +3,170 @@ set TZData(:Pacific/Norfolk) { {-9223372036854775808 40312 0 LMT} {-2177493112 40320 0 +1112} {-599656320 41400 0 +1130} {152029800 45000 1 +1230} - {162912600 41400 0 +1130} + {162916200 41400 0 +1130} {1443882600 39600 0 +11} + {1561899600 39600 0 +12} + {1570287600 43200 1 +12} + {1586012400 39600 0 +12} + {1601737200 43200 1 +12} + {1617462000 39600 0 +12} + {1633186800 43200 1 +12} + {1648911600 39600 0 +12} + {1664636400 43200 1 +12} + {1680361200 39600 0 +12} + {1696086000 43200 1 +12} + {1712415600 39600 0 +12} + {1728140400 43200 1 +12} + {1743865200 39600 0 +12} + {1759590000 43200 1 +12} + {1775314800 39600 0 +12} + {1791039600 43200 1 +12} + {1806764400 39600 0 +12} + {1822489200 43200 1 +12} + {1838214000 39600 0 +12} + {1853938800 43200 1 +12} + {1869663600 39600 0 +12} + {1885993200 43200 1 +12} + {1901718000 39600 0 +12} + {1917442800 43200 1 +12} + {1933167600 39600 0 +12} + {1948892400 43200 1 +12} + {1964617200 39600 0 +12} + {1980342000 43200 1 +12} + {1996066800 39600 0 +12} + {2011791600 43200 1 +12} + {2027516400 39600 0 +12} + {2043241200 43200 1 +12} + {2058966000 39600 0 +12} + {2075295600 43200 1 +12} + {2091020400 39600 0 +12} + {2106745200 43200 1 +12} + {2122470000 39600 0 +12} + {2138194800 43200 1 +12} + {2153919600 39600 0 +12} + {2169644400 43200 1 +12} + {2185369200 39600 0 +12} + {2201094000 43200 1 +12} + {2216818800 39600 0 +12} + {2233148400 43200 1 +12} + {2248873200 39600 0 +12} + {2264598000 43200 1 +12} + {2280322800 39600 0 +12} + {2296047600 43200 1 +12} + {2311772400 39600 0 +12} + {2327497200 43200 1 +12} + {2343222000 39600 0 +12} + {2358946800 43200 1 +12} + {2374671600 39600 0 +12} + {2390396400 43200 1 +12} + {2406121200 39600 0 +12} + {2422450800 43200 1 +12} + {2438175600 39600 0 +12} + {2453900400 43200 1 +12} + {2469625200 39600 0 +12} + {2485350000 43200 1 +12} + {2501074800 39600 0 +12} + {2516799600 43200 1 +12} + {2532524400 39600 0 +12} + {2548249200 43200 1 +12} + {2563974000 39600 0 +12} + {2579698800 43200 1 +12} + {2596028400 39600 0 +12} + {2611753200 43200 1 +12} + {2627478000 39600 0 +12} + {2643202800 43200 1 +12} + {2658927600 39600 0 +12} + {2674652400 43200 1 +12} + {2690377200 39600 0 +12} + {2706102000 43200 1 +12} + {2721826800 39600 0 +12} + {2737551600 43200 1 +12} + {2753276400 39600 0 +12} + {2769606000 43200 1 +12} + {2785330800 39600 0 +12} + {2801055600 43200 1 +12} + {2816780400 39600 0 +12} + {2832505200 43200 1 +12} + {2848230000 39600 0 +12} + {2863954800 43200 1 +12} + {2879679600 39600 0 +12} + {2895404400 43200 1 +12} + {2911129200 39600 0 +12} + {2926854000 43200 1 +12} + {2942578800 39600 0 +12} + {2958908400 43200 1 +12} + {2974633200 39600 0 +12} + {2990358000 43200 1 +12} + {3006082800 39600 0 +12} + {3021807600 43200 1 +12} + {3037532400 39600 0 +12} + {3053257200 43200 1 +12} + {3068982000 39600 0 +12} + {3084706800 43200 1 +12} + {3100431600 39600 0 +12} + {3116761200 43200 1 +12} + {3132486000 39600 0 +12} + {3148210800 43200 1 +12} + {3163935600 39600 0 +12} + {3179660400 43200 1 +12} + {3195385200 39600 0 +12} + {3211110000 43200 1 +12} + {3226834800 39600 0 +12} + {3242559600 43200 1 +12} + {3258284400 39600 0 +12} + {3274009200 43200 1 +12} + {3289734000 39600 0 +12} + {3306063600 43200 1 +12} + {3321788400 39600 0 +12} + {3337513200 43200 1 +12} + {3353238000 39600 0 +12} + {3368962800 43200 1 +12} + {3384687600 39600 0 +12} + {3400412400 43200 1 +12} + {3416137200 39600 0 +12} + {3431862000 43200 1 +12} + {3447586800 39600 0 +12} + {3463311600 43200 1 +12} + {3479641200 39600 0 +12} + {3495366000 43200 1 +12} + {3511090800 39600 0 +12} + {3526815600 43200 1 +12} + {3542540400 39600 0 +12} + {3558265200 43200 1 +12} + {3573990000 39600 0 +12} + {3589714800 43200 1 +12} + {3605439600 39600 0 +12} + {3621164400 43200 1 +12} + {3636889200 39600 0 +12} + {3653218800 43200 1 +12} + {3668943600 39600 0 +12} + {3684668400 43200 1 +12} + {3700393200 39600 0 +12} + {3716118000 43200 1 +12} + {3731842800 39600 0 +12} + {3747567600 43200 1 +12} + {3763292400 39600 0 +12} + {3779017200 43200 1 +12} + {3794742000 39600 0 +12} + {3810466800 43200 1 +12} + {3826191600 39600 0 +12} + {3842521200 43200 1 +12} + {3858246000 39600 0 +12} + {3873970800 43200 1 +12} + {3889695600 39600 0 +12} + {3905420400 43200 1 +12} + {3921145200 39600 0 +12} + {3936870000 43200 1 +12} + {3952594800 39600 0 +12} + {3968319600 43200 1 +12} + {3984044400 39600 0 +12} + {4000374000 43200 1 +12} + {4016098800 39600 0 +12} + {4031823600 43200 1 +12} + {4047548400 39600 0 +12} + {4063273200 43200 1 +12} + {4078998000 39600 0 +12} + {4094722800 43200 1 +12} } ADDED library/tzdata/SystemV/AST4 Index: library/tzdata/SystemV/AST4 ================================================================== --- /dev/null +++ library/tzdata/SystemV/AST4 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Puerto_Rico)]} { + LoadTimeZoneFile America/Puerto_Rico +} +set TZData(:SystemV/AST4) $TZData(:America/Puerto_Rico) ADDED library/tzdata/SystemV/AST4ADT Index: library/tzdata/SystemV/AST4ADT ================================================================== --- /dev/null +++ library/tzdata/SystemV/AST4ADT @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Halifax)]} { + LoadTimeZoneFile America/Halifax +} +set TZData(:SystemV/AST4ADT) $TZData(:America/Halifax) ADDED library/tzdata/SystemV/CST6 Index: library/tzdata/SystemV/CST6 ================================================================== --- /dev/null +++ library/tzdata/SystemV/CST6 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Regina)]} { + LoadTimeZoneFile America/Regina +} +set TZData(:SystemV/CST6) $TZData(:America/Regina) ADDED library/tzdata/SystemV/CST6CDT Index: library/tzdata/SystemV/CST6CDT ================================================================== --- /dev/null +++ library/tzdata/SystemV/CST6CDT @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Chicago)]} { + LoadTimeZoneFile America/Chicago +} +set TZData(:SystemV/CST6CDT) $TZData(:America/Chicago) ADDED library/tzdata/SystemV/EST5 Index: library/tzdata/SystemV/EST5 ================================================================== --- /dev/null +++ library/tzdata/SystemV/EST5 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Indianapolis)]} { + LoadTimeZoneFile America/Indianapolis +} +set TZData(:SystemV/EST5) $TZData(:America/Indianapolis) ADDED library/tzdata/SystemV/EST5EDT Index: library/tzdata/SystemV/EST5EDT ================================================================== --- /dev/null +++ library/tzdata/SystemV/EST5EDT @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/New_York)]} { + LoadTimeZoneFile America/New_York +} +set TZData(:SystemV/EST5EDT) $TZData(:America/New_York) ADDED library/tzdata/SystemV/HST10 Index: library/tzdata/SystemV/HST10 ================================================================== --- /dev/null +++ library/tzdata/SystemV/HST10 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(Pacific/Honolulu)]} { + LoadTimeZoneFile Pacific/Honolulu +} +set TZData(:SystemV/HST10) $TZData(:Pacific/Honolulu) ADDED library/tzdata/SystemV/MST7 Index: library/tzdata/SystemV/MST7 ================================================================== --- /dev/null +++ library/tzdata/SystemV/MST7 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Phoenix)]} { + LoadTimeZoneFile America/Phoenix +} +set TZData(:SystemV/MST7) $TZData(:America/Phoenix) ADDED library/tzdata/SystemV/MST7MDT Index: library/tzdata/SystemV/MST7MDT ================================================================== --- /dev/null +++ library/tzdata/SystemV/MST7MDT @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Denver)]} { + LoadTimeZoneFile America/Denver +} +set TZData(:SystemV/MST7MDT) $TZData(:America/Denver) ADDED library/tzdata/SystemV/PST8 Index: library/tzdata/SystemV/PST8 ================================================================== --- /dev/null +++ library/tzdata/SystemV/PST8 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(Pacific/Pitcairn)]} { + LoadTimeZoneFile Pacific/Pitcairn +} +set TZData(:SystemV/PST8) $TZData(:Pacific/Pitcairn) ADDED library/tzdata/SystemV/PST8PDT Index: library/tzdata/SystemV/PST8PDT ================================================================== --- /dev/null +++ library/tzdata/SystemV/PST8PDT @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Los_Angeles)]} { + LoadTimeZoneFile America/Los_Angeles +} +set TZData(:SystemV/PST8PDT) $TZData(:America/Los_Angeles) ADDED library/tzdata/SystemV/YST9 Index: library/tzdata/SystemV/YST9 ================================================================== --- /dev/null +++ library/tzdata/SystemV/YST9 @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(Pacific/Gambier)]} { + LoadTimeZoneFile Pacific/Gambier +} +set TZData(:SystemV/YST9) $TZData(:Pacific/Gambier) ADDED library/tzdata/SystemV/YST9YDT Index: library/tzdata/SystemV/YST9YDT ================================================================== --- /dev/null +++ library/tzdata/SystemV/YST9YDT @@ -0,0 +1,5 @@ +# created by ../tools/tclZIC.tcl - do not edit +if {![info exists TZData(America/Anchorage)]} { + LoadTimeZoneFile America/Anchorage +} +set TZData(:SystemV/YST9YDT) $TZData(:America/Anchorage) Index: libtommath/README.md ================================================================== --- libtommath/README.md +++ libtommath/README.md @@ -1,25 +1,44 @@ # libtommath This is the git repository for [LibTomMath](http://www.libtom.net/LibTomMath/), a free open source portable number theoretic multiple-precision integer (MPI) library written entirely in C. ## Build Status + +### Travis CI master: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=master)](https://travis-ci.org/libtom/libtommath) develop: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=develop)](https://travis-ci.org/libtom/libtommath) +### AppVeyor + +master: [![Build status](https://ci.appveyor.com/api/projects/status/b80lpolw3i8m6hsh/branch/master?svg=true)](https://ci.appveyor.com/project/libtom/libtommath/branch/master) + +develop: [![Build status](https://ci.appveyor.com/api/projects/status/b80lpolw3i8m6hsh/branch/develop?svg=true)](https://ci.appveyor.com/project/libtom/libtommath/branch/develop) + +### ABI Laboratory + API/ABI changes: [check here](https://abi-laboratory.pro/tracker/timeline/libtommath/) ## Summary The `develop` branch contains the in-development version. Stable releases are tagged. -Documentation is built from the LaTeX file `bn.tex`. There is also limited documentation in `tommath.h`. There is also a document, `tommath.pdf`, which describes the goals of the project and many of the algorithms used. +Documentation is built from the LaTeX file `bn.tex`. There is also limited documentation in `tommath.h`. +There is also a document, `tommath.pdf`, which describes the goals of the project and many of the algorithms used. -The project can be build by using `make`. Along with the usual `make`, `make clean` and `make install`, there are several other build targets, see the makefile for details. There are also makefiles for certain specific platforms. +The project can be build by using `make`. Along with the usual `make`, `make clean` and `make install`, +there are several other build targets, see the makefile for details. +There are also makefiles for certain specific platforms. ## Testing Tests are located in `demo/` and can be built in two flavors. -* `make test` creates a test binary that is intended to be run against `mtest`. `mtest` can be built with `make mtest` and test execution is done like `./mtest/mtest | ./test`. `mtest` is creating test vectors using an alternative MPI library and `test` is consuming these vectors to verify correct behavior of ltm -* `make test_standalone` creates a stand-alone test binary that executes several test routines. +* `make test` creates a stand-alone test binary that executes several test routines. +* `make mtest_opponent` creates a test binary that is intended to be run against `mtest`. + `mtest` can be built with `make mtest` and test execution is done like `./mtest/mtest | ./mtest_opponent`. + `mtest` is creating test vectors using an alternative MPI library and `test` is consuming these vectors to verify correct behavior of ltm + +## Building and Installing + +Building is straightforward for GNU Linux only, the section "Building LibTomMath" in the documentation in `doc/bn.pdf` has the details. ADDED libtommath/appveyor.yml Index: libtommath/appveyor.yml ================================================================== --- /dev/null +++ libtommath/appveyor.yml @@ -0,0 +1,21 @@ +version: 1.2.0-{build} +branches: + only: + - master + - develop + - /^release/ + - /^support/ + - /^travis/ +image: +- Visual Studio 2019 +- Visual Studio 2017 +- Visual Studio 2015 +build_script: +- cmd: >- + if "Visual Studio 2019"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars64.bat" + if "Visual Studio 2017"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat" + if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64 + if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64 + nmake -f makefile.msvc all +test_script: +- cmd: test.exe Index: libtommath/astylerc ================================================================== --- libtommath/astylerc +++ libtommath/astylerc @@ -1,10 +1,13 @@ # Artistic Style, see http://astyle.sourceforge.net/ # full documentation, see: http://astyle.sourceforge.net/astyle.html # # usage: # astyle --options=astylerc *.[ch] + +# Do not create backup, annonying in the times of git +suffix=none ## Bracket Style Options style=kr ## Tab Options ADDED libtommath/bn_cutoffs.c Index: libtommath/bn_cutoffs.c ================================================================== --- /dev/null +++ libtommath/bn_cutoffs.c @@ -0,0 +1,14 @@ +#include "tommath_private.h" +#ifdef BN_CUTOFFS_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#ifndef MP_FIXED_CUTOFFS +#include "tommath_cutoffs.h" +int KARATSUBA_MUL_CUTOFF = MP_DEFAULT_KARATSUBA_MUL_CUTOFF, + KARATSUBA_SQR_CUTOFF = MP_DEFAULT_KARATSUBA_SQR_CUTOFF, + TOOM_MUL_CUTOFF = MP_DEFAULT_TOOM_MUL_CUTOFF, + TOOM_SQR_CUTOFF = MP_DEFAULT_TOOM_SQR_CUTOFF; +#endif + +#endif ADDED libtommath/bn_deprecated.c Index: libtommath/bn_deprecated.c ================================================================== --- /dev/null +++ libtommath/bn_deprecated.c @@ -0,0 +1,321 @@ +#include "tommath_private.h" +#ifdef BN_DEPRECATED_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#ifdef BN_MP_GET_BIT_C +int mp_get_bit(const mp_int *a, int b) +{ + if (b < 0) { + return MP_VAL; + } + return (s_mp_get_bit(a, (unsigned int)b) == MP_YES) ? MP_YES : MP_NO; +} +#endif +#ifdef BN_MP_JACOBI_C +mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) +{ + if (a->sign == MP_NEG) { + return MP_VAL; + } + if (mp_cmp_d(n, 0uL) != MP_GT) { + return MP_VAL; + } + return mp_kronecker(a, n, c); +} +#endif +#ifdef BN_MP_PRIME_RANDOM_EX_C +mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat) +{ + return s_mp_prime_random_ex(a, t, size, flags, cb, dat); +} +#endif +#ifdef BN_MP_RAND_DIGIT_C +mp_err mp_rand_digit(mp_digit *r) +{ + mp_err err = s_mp_rand_source(r, sizeof(mp_digit)); + *r &= MP_MASK; + return err; +} +#endif +#ifdef BN_FAST_MP_INVMOD_C +mp_err fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) +{ + return s_mp_invmod_fast(a, b, c); +} +#endif +#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C +mp_err fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) +{ + return s_mp_montgomery_reduce_fast(x, n, rho); +} +#endif +#ifdef BN_FAST_S_MP_MUL_DIGS_C +mp_err fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) +{ + return s_mp_mul_digs_fast(a, b, c, digs); +} +#endif +#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C +mp_err fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) +{ + return s_mp_mul_high_digs_fast(a, b, c, digs); +} +#endif +#ifdef BN_FAST_S_MP_SQR_C +mp_err fast_s_mp_sqr(const mp_int *a, mp_int *b) +{ + return s_mp_sqr_fast(a, b); +} +#endif +#ifdef BN_MP_BALANCE_MUL_C +mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + return s_mp_balance_mul(a, b, c); +} +#endif +#ifdef BN_MP_EXPTMOD_FAST_C +mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) +{ + return s_mp_exptmod_fast(G, X, P, Y, redmode); +} +#endif +#ifdef BN_MP_INVMOD_SLOW_C +mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) +{ + return s_mp_invmod_slow(a, b, c); +} +#endif +#ifdef BN_MP_KARATSUBA_MUL_C +mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + return s_mp_karatsuba_mul(a, b, c); +} +#endif +#ifdef BN_MP_KARATSUBA_SQR_C +mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b) +{ + return s_mp_karatsuba_sqr(a, b); +} +#endif +#ifdef BN_MP_TOOM_MUL_C +mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + return s_mp_toom_mul(a, b, c); +} +#endif +#ifdef BN_MP_TOOM_SQR_C +mp_err mp_toom_sqr(const mp_int *a, mp_int *b) +{ + return s_mp_toom_sqr(a, b); +} +#endif +#ifdef S_MP_REVERSE_C +void bn_reverse(unsigned char *s, int len) +{ + if (len > 0) { + s_mp_reverse(s, (size_t)len); + } +} +#endif +#ifdef BN_MP_TC_AND_C +mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) +{ + return mp_and(a, b, c); +} +#endif +#ifdef BN_MP_TC_OR_C +mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) +{ + return mp_or(a, b, c); +} +#endif +#ifdef BN_MP_TC_XOR_C +mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) +{ + return mp_xor(a, b, c); +} +#endif +#ifdef BN_MP_TC_DIV_2D_C +mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) +{ + return mp_signed_rsh(a, b, c); +} +#endif +#ifdef BN_MP_INIT_SET_INT_C +mp_err mp_init_set_int(mp_int *a, unsigned long b) +{ + return mp_init_u32(a, (uint32_t)b); +} +#endif +#ifdef BN_MP_SET_INT_C +mp_err mp_set_int(mp_int *a, unsigned long b) +{ + mp_set_u32(a, (uint32_t)b); + return MP_OKAY; +} +#endif +#ifdef BN_MP_SET_LONG_C +mp_err mp_set_long(mp_int *a, unsigned long b) +{ + mp_set_u64(a, b); + return MP_OKAY; +} +#endif +#ifdef BN_MP_SET_LONG_LONG_C +mp_err mp_set_long_long(mp_int *a, unsigned long long b) +{ + mp_set_u64(a, b); + return MP_OKAY; +} +#endif +#ifdef BN_MP_GET_INT_C +unsigned long mp_get_int(const mp_int *a) +{ + return (unsigned long)mp_get_mag_u32(a); +} +#endif +#ifdef BN_MP_GET_LONG_C +unsigned long mp_get_long(const mp_int *a) +{ + return (unsigned long)mp_get_mag_ul(a); +} +#endif +#ifdef BN_MP_GET_LONG_LONG_C +unsigned long long mp_get_long_long(const mp_int *a) +{ + return mp_get_mag_ull(a); +} +#endif +#ifdef BN_MP_PRIME_IS_DIVISIBLE_C +mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) +{ + return s_mp_prime_is_divisible(a, result); +} +#endif +#ifdef BN_MP_EXPT_D_EX_C +mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) +{ + (void)fast; + if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + return MP_VAL; + } + return mp_expt_u32(a, (uint32_t)b, c); +} +#endif +#ifdef BN_MP_EXPT_D_C +mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) +{ + if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + return MP_VAL; + } + return mp_expt_u32(a, (uint32_t)b, c); +} +#endif +#ifdef BN_MP_N_ROOT_EX_C +mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) +{ + (void)fast; + if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + return MP_VAL; + } + return mp_root_u32(a, (uint32_t)b, c); +} +#endif +#ifdef BN_MP_N_ROOT_C +mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) +{ + if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + return MP_VAL; + } + return mp_root_u32(a, (uint32_t)b, c); +} +#endif +#ifdef BN_MP_UNSIGNED_BIN_SIZE_C +int mp_unsigned_bin_size(const mp_int *a) +{ + return (int)mp_ubin_size(a); +} +#endif +#ifdef BN_MP_READ_UNSIGNED_BIN_C +mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) +{ + return mp_from_ubin(a, b, (size_t) c); +} +#endif +#ifdef BN_MP_TO_UNSIGNED_BIN_C +mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) +{ + return mp_to_ubin(a, b, SIZE_MAX, NULL); +} +#endif +#ifdef BN_MP_TO_UNSIGNED_BIN_N_C +mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) +{ + size_t n = mp_ubin_size(a); + if (*outlen < (unsigned long)n) { + return MP_VAL; + } + *outlen = (unsigned long)n; + return mp_to_ubin(a, b, n, NULL); +} +#endif +#ifdef BN_MP_SIGNED_BIN_SIZE_C +int mp_signed_bin_size(const mp_int *a) +{ + return (int)mp_sbin_size(a); +} +#endif +#ifdef BN_MP_READ_SIGNED_BIN_C +mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) +{ + return mp_from_sbin(a, b, (size_t) c); +} +#endif +#ifdef BN_MP_TO_SIGNED_BIN_C +mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b) +{ + return mp_to_sbin(a, b, SIZE_MAX, NULL); +} +#endif +#ifdef BN_MP_TO_SIGNED_BIN_N_C +mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) +{ + size_t n = mp_sbin_size(a); + if (*outlen < (unsigned long)n) { + return MP_VAL; + } + *outlen = (unsigned long)n; + return mp_to_sbin(a, b, n, NULL); +} +#endif +#ifdef BN_MP_TORADIX_N_C +mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) +{ + if (maxlen < 0) { + return MP_VAL; + } + return mp_to_radix(a, str, (size_t)maxlen, NULL, radix); +} +#endif +#ifdef BN_MP_TORADIX_C +mp_err mp_toradix(const mp_int *a, char *str, int radix) +{ + return mp_to_radix(a, str, SIZE_MAX, NULL, radix); +} +#endif +#ifdef BN_MP_IMPORT_C +mp_err mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, + const void *op) +{ + return mp_unpack(rop, count, order, size, endian, nails, op); +} +#endif +#ifdef BN_MP_EXPORT_C +mp_err mp_export(void *rop, size_t *countp, int order, size_t size, + int endian, size_t nails, const mp_int *op) +{ + return mp_pack(rop, SIZE_MAX, countp, order, size, endian, nails, op); +} +#endif +#endif DELETED libtommath/bn_error.c Index: libtommath/bn_error.c ================================================================== --- libtommath/bn_error.c +++ /dev/null @@ -1,44 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_ERROR_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -static const struct { - int code; - const char *msg; -} msgs[] = { - { MP_OKAY, "Successful" }, - { MP_MEM, "Out of heap" }, - { MP_VAL, "Value out of range" } -}; - -/* return a char * string for a given code */ -const char *mp_error_to_string(int code) -{ - size_t x; - - /* scan the lookup table for the given message */ - for (x = 0; x < (sizeof(msgs) / sizeof(msgs[0])); x++) { - if (msgs[x].code == code) { - return msgs[x].msg; - } - } - - /* generic reply for invalid code */ - return "Invalid error code"; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_fast_mp_invmod.c Index: libtommath/bn_fast_mp_invmod.c ================================================================== --- libtommath/bn_fast_mp_invmod.c +++ /dev/null @@ -1,160 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_FAST_MP_INVMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* computes the modular inverse via binary extended euclidean algorithm, - * that is c = 1/a mod b - * - * Based on slow invmod except this is optimized for the case where b is - * odd as per HAC Note 14.64 on pp. 610 - */ -int fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) -{ - mp_int x, y, u, v, B, D; - int res, neg; - - /* 2. [modified] b must be odd */ - if (mp_iseven(b) == MP_YES) { - return MP_VAL; - } - - /* init all our temps */ - if ((res = mp_init_multi(&x, &y, &u, &v, &B, &D, NULL)) != MP_OKAY) { - return res; - } - - /* x == modulus, y == value to invert */ - if ((res = mp_copy(b, &x)) != MP_OKAY) { - goto LBL_ERR; - } - - /* we need y = |a| */ - if ((res = mp_mod(a, b, &y)) != MP_OKAY) { - goto LBL_ERR; - } - - /* if one of x,y is zero return an error! */ - if ((mp_iszero(&x) == MP_YES) || (mp_iszero(&y) == MP_YES)) { - res = MP_VAL; - goto LBL_ERR; - } - - /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */ - if ((res = mp_copy(&x, &u)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_copy(&y, &v)) != MP_OKAY) { - goto LBL_ERR; - } - mp_set(&D, 1uL); - -top: - /* 4. while u is even do */ - while (mp_iseven(&u) == MP_YES) { - /* 4.1 u = u/2 */ - if ((res = mp_div_2(&u, &u)) != MP_OKAY) { - goto LBL_ERR; - } - /* 4.2 if B is odd then */ - if (mp_isodd(&B) == MP_YES) { - if ((res = mp_sub(&B, &x, &B)) != MP_OKAY) { - goto LBL_ERR; - } - } - /* B = B/2 */ - if ((res = mp_div_2(&B, &B)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* 5. while v is even do */ - while (mp_iseven(&v) == MP_YES) { - /* 5.1 v = v/2 */ - if ((res = mp_div_2(&v, &v)) != MP_OKAY) { - goto LBL_ERR; - } - /* 5.2 if D is odd then */ - if (mp_isodd(&D) == MP_YES) { - /* D = (D-x)/2 */ - if ((res = mp_sub(&D, &x, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - /* D = D/2 */ - if ((res = mp_div_2(&D, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* 6. if u >= v then */ - if (mp_cmp(&u, &v) != MP_LT) { - /* u = u - v, B = B - D */ - if ((res = mp_sub(&u, &v, &u)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sub(&B, &D, &B)) != MP_OKAY) { - goto LBL_ERR; - } - } else { - /* v - v - u, D = D - B */ - if ((res = mp_sub(&v, &u, &v)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sub(&D, &B, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* if not zero goto step 4 */ - if (mp_iszero(&u) == MP_NO) { - goto top; - } - - /* now a = C, b = D, gcd == g*v */ - - /* if v != 1 then there is no inverse */ - if (mp_cmp_d(&v, 1uL) != MP_EQ) { - res = MP_VAL; - goto LBL_ERR; - } - - /* b is now the inverse */ - neg = a->sign; - while (D.sign == MP_NEG) { - if ((res = mp_add(&D, b, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* too big */ - while (mp_cmp_mag(&D, b) != MP_LT) { - if ((res = mp_sub(&D, b, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - - mp_exch(&D, c); - c->sign = neg; - res = MP_OKAY; - -LBL_ERR: - mp_clear_multi(&x, &y, &u, &v, &B, &D, NULL); - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_fast_mp_montgomery_reduce.c Index: libtommath/bn_fast_mp_montgomery_reduce.c ================================================================== --- libtommath/bn_fast_mp_montgomery_reduce.c +++ /dev/null @@ -1,173 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* computes xR**-1 == x (mod N) via Montgomery Reduction - * - * This is an optimized implementation of montgomery_reduce - * which uses the comba method to quickly calculate the columns of the - * reduction. - * - * Based on Algorithm 14.32 on pp.601 of HAC. -*/ -int fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) -{ - int ix, res, olduse; - mp_word W[MP_WARRAY]; - - if (x->used > (int)MP_WARRAY) { - return MP_VAL; - } - - /* get old used count */ - olduse = x->used; - - /* grow a as required */ - if (x->alloc < (n->used + 1)) { - if ((res = mp_grow(x, n->used + 1)) != MP_OKAY) { - return res; - } - } - - /* first we have to get the digits of the input into - * an array of double precision words W[...] - */ - { - mp_word *_W; - mp_digit *tmpx; - - /* alias for the W[] array */ - _W = W; - - /* alias for the digits of x*/ - tmpx = x->dp; - - /* copy the digits of a into W[0..a->used-1] */ - for (ix = 0; ix < x->used; ix++) { - *_W++ = *tmpx++; - } - - /* zero the high words of W[a->used..m->used*2] */ - for (; ix < ((n->used * 2) + 1); ix++) { - *_W++ = 0; - } - } - - /* now we proceed to zero successive digits - * from the least significant upwards - */ - for (ix = 0; ix < n->used; ix++) { - /* mu = ai * m' mod b - * - * We avoid a double precision multiplication (which isn't required) - * by casting the value down to a mp_digit. Note this requires - * that W[ix-1] have the carry cleared (see after the inner loop) - */ - mp_digit mu; - mu = ((W[ix] & MP_MASK) * rho) & MP_MASK; - - /* a = a + mu * m * b**i - * - * This is computed in place and on the fly. The multiplication - * by b**i is handled by offseting which columns the results - * are added to. - * - * Note the comba method normally doesn't handle carries in the - * inner loop In this case we fix the carry from the previous - * column since the Montgomery reduction requires digits of the - * result (so far) [see above] to work. This is - * handled by fixing up one carry after the inner loop. The - * carry fixups are done in order so after these loops the - * first m->used words of W[] have the carries fixed - */ - { - int iy; - mp_digit *tmpn; - mp_word *_W; - - /* alias for the digits of the modulus */ - tmpn = n->dp; - - /* Alias for the columns set by an offset of ix */ - _W = W + ix; - - /* inner loop */ - for (iy = 0; iy < n->used; iy++) { - *_W++ += (mp_word)mu * (mp_word)*tmpn++; - } - } - - /* now fix carry for next digit, W[ix+1] */ - W[ix + 1] += W[ix] >> (mp_word)DIGIT_BIT; - } - - /* now we have to propagate the carries and - * shift the words downward [all those least - * significant digits we zeroed]. - */ - { - mp_digit *tmpx; - mp_word *_W, *_W1; - - /* nox fix rest of carries */ - - /* alias for current word */ - _W1 = W + ix; - - /* alias for next word, where the carry goes */ - _W = W + ++ix; - - for (; ix <= ((n->used * 2) + 1); ix++) { - *_W++ += *_W1++ >> (mp_word)DIGIT_BIT; - } - - /* copy out, A = A/b**n - * - * The result is A/b**n but instead of converting from an - * array of mp_word to mp_digit than calling mp_rshd - * we just copy them in the right order - */ - - /* alias for destination word */ - tmpx = x->dp; - - /* alias for shifted double precision result */ - _W = W + n->used; - - for (ix = 0; ix < (n->used + 1); ix++) { - *tmpx++ = *_W++ & (mp_word)MP_MASK; - } - - /* zero oldused digits, if the input a was larger than - * m->used+1 we'll have to clear the digits - */ - for (; ix < olduse; ix++) { - *tmpx++ = 0; - } - } - - /* set the max used and clamp */ - x->used = n->used + 1; - mp_clamp(x); - - /* if A >= m then A = A - m */ - if (mp_cmp_mag(x, n) != MP_LT) { - return s_mp_sub(x, n, x); - } - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_fast_s_mp_mul_digs.c Index: libtommath/bn_fast_s_mp_mul_digs.c ================================================================== --- libtommath/bn_fast_s_mp_mul_digs.c +++ /dev/null @@ -1,104 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_FAST_S_MP_MUL_DIGS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* Fast (comba) multiplier - * - * This is the fast column-array [comba] multiplier. It is - * designed to compute the columns of the product first - * then handle the carries afterwards. This has the effect - * of making the nested loops that compute the columns very - * simple and schedulable on super-scalar processors. - * - * This has been modified to produce a variable number of - * digits of output so if say only a half-product is required - * you don't have to compute the upper half (a feature - * required for fast Barrett reduction). - * - * Based on Algorithm 14.12 on pp.595 of HAC. - * - */ -int fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) -{ - int olduse, res, pa, ix, iz; - mp_digit W[MP_WARRAY]; - mp_word _W; - - /* grow the destination as required */ - if (c->alloc < digs) { - if ((res = mp_grow(c, digs)) != MP_OKAY) { - return res; - } - } - - /* number of output digits to produce */ - pa = MIN(digs, a->used + b->used); - - /* clear the carry */ - _W = 0; - for (ix = 0; ix < pa; ix++) { - int tx, ty; - int iy; - mp_digit *tmpx, *tmpy; - - /* get offsets into the two bignums */ - ty = MIN(b->used-1, ix); - tx = ix - ty; - - /* setup temp aliases */ - tmpx = a->dp + tx; - tmpy = b->dp + ty; - - /* this is the number of times the loop will iterrate, essentially - while (tx++ < a->used && ty-- >= 0) { ... } - */ - iy = MIN(a->used-tx, ty+1); - - /* execute loop */ - for (iz = 0; iz < iy; ++iz) { - _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; - - } - - /* store term */ - W[ix] = (mp_digit)_W & MP_MASK; - - /* make next carry */ - _W = _W >> (mp_word)DIGIT_BIT; - } - - /* setup dest */ - olduse = c->used; - c->used = pa; - - { - mp_digit *tmpc; - tmpc = c->dp; - for (ix = 0; ix < pa; ix++) { - /* now extract the previous digit [below the carry] */ - *tmpc++ = W[ix]; - } - - /* clear unused digits [that existed in the old copy of c] */ - for (; ix < olduse; ix++) { - *tmpc++ = 0; - } - } - mp_clamp(c); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_fast_s_mp_mul_high_digs.c Index: libtommath/bn_fast_s_mp_mul_high_digs.c ================================================================== --- libtommath/bn_fast_s_mp_mul_high_digs.c +++ /dev/null @@ -1,95 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* this is a modified version of fast_s_mul_digs that only produces - * output digits *above* digs. See the comments for fast_s_mul_digs - * to see how it works. - * - * This is used in the Barrett reduction since for one of the multiplications - * only the higher digits were needed. This essentially halves the work. - * - * Based on Algorithm 14.12 on pp.595 of HAC. - */ -int fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) -{ - int olduse, res, pa, ix, iz; - mp_digit W[MP_WARRAY]; - mp_word _W; - - /* grow the destination as required */ - pa = a->used + b->used; - if (c->alloc < pa) { - if ((res = mp_grow(c, pa)) != MP_OKAY) { - return res; - } - } - - /* number of output digits to produce */ - pa = a->used + b->used; - _W = 0; - for (ix = digs; ix < pa; ix++) { - int tx, ty, iy; - mp_digit *tmpx, *tmpy; - - /* get offsets into the two bignums */ - ty = MIN(b->used-1, ix); - tx = ix - ty; - - /* setup temp aliases */ - tmpx = a->dp + tx; - tmpy = b->dp + ty; - - /* this is the number of times the loop will iterrate, essentially its - while (tx++ < a->used && ty-- >= 0) { ... } - */ - iy = MIN(a->used-tx, ty+1); - - /* execute loop */ - for (iz = 0; iz < iy; iz++) { - _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; - } - - /* store term */ - W[ix] = (mp_digit)_W & MP_MASK; - - /* make next carry */ - _W = _W >> (mp_word)DIGIT_BIT; - } - - /* setup dest */ - olduse = c->used; - c->used = pa; - - { - mp_digit *tmpc; - - tmpc = c->dp + digs; - for (ix = digs; ix < pa; ix++) { - /* now extract the previous digit [below the carry] */ - *tmpc++ = W[ix]; - } - - /* clear unused digits [that existed in the old copy of c] */ - for (; ix < olduse; ix++) { - *tmpc++ = 0; - } - } - mp_clamp(c); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_fast_s_mp_sqr.c Index: libtommath/bn_fast_s_mp_sqr.c ================================================================== --- libtommath/bn_fast_s_mp_sqr.c +++ /dev/null @@ -1,111 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_FAST_S_MP_SQR_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* the jist of squaring... - * you do like mult except the offset of the tmpx [one that - * starts closer to zero] can't equal the offset of tmpy. - * So basically you set up iy like before then you min it with - * (ty-tx) so that it never happens. You double all those - * you add in the inner loop - -After that loop you do the squares and add them in. -*/ - -int fast_s_mp_sqr(const mp_int *a, mp_int *b) -{ - int olduse, res, pa, ix, iz; - mp_digit W[MP_WARRAY], *tmpx; - mp_word W1; - - /* grow the destination as required */ - pa = a->used + a->used; - if (b->alloc < pa) { - if ((res = mp_grow(b, pa)) != MP_OKAY) { - return res; - } - } - - /* number of output digits to produce */ - W1 = 0; - for (ix = 0; ix < pa; ix++) { - int tx, ty, iy; - mp_word _W; - mp_digit *tmpy; - - /* clear counter */ - _W = 0; - - /* get offsets into the two bignums */ - ty = MIN(a->used-1, ix); - tx = ix - ty; - - /* setup temp aliases */ - tmpx = a->dp + tx; - tmpy = a->dp + ty; - - /* this is the number of times the loop will iterrate, essentially - while (tx++ < a->used && ty-- >= 0) { ... } - */ - iy = MIN(a->used-tx, ty+1); - - /* now for squaring tx can never equal ty - * we halve the distance since they approach at a rate of 2x - * and we have to round because odd cases need to be executed - */ - iy = MIN(iy, ((ty-tx)+1)>>1); - - /* execute loop */ - for (iz = 0; iz < iy; iz++) { - _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; - } - - /* double the inner product and add carry */ - _W = _W + _W + W1; - - /* even columns have the square term in them */ - if (((unsigned)ix & 1u) == 0u) { - _W += (mp_word)a->dp[ix>>1] * (mp_word)a->dp[ix>>1]; - } - - /* store it */ - W[ix] = _W & MP_MASK; - - /* make next carry */ - W1 = _W >> (mp_word)DIGIT_BIT; - } - - /* setup dest */ - olduse = b->used; - b->used = a->used+a->used; - - { - mp_digit *tmpb; - tmpb = b->dp; - for (ix = 0; ix < pa; ix++) { - *tmpb++ = W[ix] & MP_MASK; - } - - /* clear unused digits [that existed in the old copy of c] */ - for (; ix < olduse; ix++) { - *tmpb++ = 0; - } - } - mp_clamp(b); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_2expt.c ================================================================== --- libtommath/bn_mp_2expt.c +++ libtommath/bn_mp_2expt.c @@ -1,44 +1,31 @@ #include "tommath_private.h" #ifdef BN_MP_2EXPT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* computes a = 2**b * * Simple algorithm which zeroes the int, grows it then just sets one bit * as required. */ -int mp_2expt(mp_int *a, int b) +mp_err mp_2expt(mp_int *a, int b) { - int res; + mp_err err; /* zero a as per default */ mp_zero(a); /* grow a to accomodate the single bit */ - if ((res = mp_grow(a, (b / DIGIT_BIT) + 1)) != MP_OKAY) { - return res; + if ((err = mp_grow(a, (b / MP_DIGIT_BIT) + 1)) != MP_OKAY) { + return err; } /* set the used count of where the bit will go */ - a->used = (b / DIGIT_BIT) + 1; + a->used = (b / MP_DIGIT_BIT) + 1; /* put the single bit in its place */ - a->dp[b / DIGIT_BIT] = (mp_digit)1 << (mp_digit)(b % DIGIT_BIT); + a->dp[b / MP_DIGIT_BIT] = (mp_digit)1 << (mp_digit)(b % MP_DIGIT_BIT); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_abs.c ================================================================== --- libtommath/bn_mp_abs.c +++ libtommath/bn_mp_abs.c @@ -1,39 +1,26 @@ #include "tommath_private.h" #ifdef BN_MP_ABS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* b = |a| * * Simple function copies the input and fixes the sign to positive */ -int mp_abs(const mp_int *a, mp_int *b) +mp_err mp_abs(const mp_int *a, mp_int *b) { - int res; + mp_err err; /* copy a to b */ if (a != b) { - if ((res = mp_copy(a, b)) != MP_OKAY) { - return res; + if ((err = mp_copy(a, b)) != MP_OKAY) { + return err; } } /* force the sign of b to positive */ b->sign = MP_ZPOS; return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_add.c ================================================================== --- libtommath/bn_mp_add.c +++ libtommath/bn_mp_add.c @@ -1,23 +1,15 @@ #include "tommath_private.h" #ifdef BN_MP_ADD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* high level addition (handles signs) */ -int mp_add(const mp_int *a, const mp_int *b, mp_int *c) +mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) { - int sa, sb, res; + mp_sign sa, sb; + mp_err err; /* get sign of both inputs */ sa = a->sign; sb = b->sign; @@ -24,27 +16,23 @@ /* handle two cases, not four */ if (sa == sb) { /* both positive or both negative */ /* add their magnitudes, copy the sign */ c->sign = sa; - res = s_mp_add(a, b, c); + err = s_mp_add(a, b, c); } else { /* one positive, the other negative */ /* subtract the one with the greater magnitude from */ /* the one of the lesser magnitude. The result gets */ /* the sign of the one with the greater magnitude. */ if (mp_cmp_mag(a, b) == MP_LT) { c->sign = sb; - res = s_mp_sub(b, a, c); + err = s_mp_sub(b, a, c); } else { c->sign = sa; - res = s_mp_sub(a, b, c); + err = s_mp_sub(a, b, c); } } - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_add_d.c ================================================================== --- libtommath/bn_mp_add_d.c +++ libtommath/bn_mp_add_d.c @@ -1,29 +1,21 @@ #include "tommath_private.h" #ifdef BN_MP_ADD_D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* single digit addition */ -int mp_add_d(const mp_int *a, mp_digit b, mp_int *c) +mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) { - int res, ix, oldused; - mp_digit *tmpa, *tmpc, mu; + mp_err err; + int ix, oldused; + mp_digit *tmpa, *tmpc; /* grow c as required */ if (c->alloc < (a->used + 1)) { - if ((res = mp_grow(c, a->used + 1)) != MP_OKAY) { - return res; + if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) { + return err; } } /* if a is negative and |a| >= b, call c = |a| - b */ if ((a->sign == MP_NEG) && ((a->used > 1) || (a->dp[0] >= b))) { @@ -30,19 +22,19 @@ mp_int a_ = *a; /* temporarily fix sign of a */ a_.sign = MP_ZPOS; /* c = |a| - b */ - res = mp_sub_d(&a_, b, c); + err = mp_sub_d(&a_, b, c); /* fix sign */ c->sign = MP_NEG; /* clamp */ mp_clamp(c); - return res; + return err; } /* old number of used digits in c */ oldused = c->used; @@ -52,21 +44,15 @@ /* destination alias */ tmpc = c->dp; /* if a is positive */ if (a->sign == MP_ZPOS) { - /* add digit, after this we're propagating - * the carry. - */ - *tmpc = *tmpa++ + b; - mu = *tmpc >> DIGIT_BIT; - *tmpc++ &= MP_MASK; - - /* now handle rest of the digits */ - for (ix = 1; ix < a->used; ix++) { + /* add digits, mu is carry */ + mp_digit mu = b; + for (ix = 0; ix < a->used; ix++) { *tmpc = *tmpa++ + mu; - mu = *tmpc >> DIGIT_BIT; + mu = *tmpc >> MP_DIGIT_BIT; *tmpc++ &= MP_MASK; } /* set final carry */ ix++; *tmpc++ = mu; @@ -92,18 +78,12 @@ /* sign always positive */ c->sign = MP_ZPOS; /* now zero to oldused */ - while (ix++ < oldused) { - *tmpc++ = 0; - } + MP_ZERO_DIGITS(tmpc, oldused - ix); mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_addmod.c ================================================================== --- libtommath/bn_mp_addmod.c +++ libtommath/bn_mp_addmod.c @@ -1,37 +1,25 @@ #include "tommath_private.h" #ifdef BN_MP_ADDMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* d = a + b (mod c) */ -int mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) +mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) { - int res; + mp_err err; mp_int t; - if ((res = mp_init(&t)) != MP_OKAY) { - return res; - } - - if ((res = mp_add(a, b, &t)) != MP_OKAY) { - mp_clear(&t); - return res; - } - res = mp_mod(&t, c, d); - mp_clear(&t); - return res; + if ((err = mp_init(&t)) != MP_OKAY) { + return err; + } + + if ((err = mp_add(a, b, &t)) != MP_OKAY) { + goto LBL_ERR; + } + err = mp_mod(&t, c, d); + +LBL_ERR: + mp_clear(&t); + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_and.c ================================================================== --- libtommath/bn_mp_and.c +++ libtommath/bn_mp_and.c @@ -4,11 +4,11 @@ /* SPDX-License-Identifier: Unlicense */ /* two complement and */ mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) { - int used = MAX(a->used, b->used) + 1, i; + int used = MP_MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = ((a->sign == MP_NEG) && (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { Index: libtommath/bn_mp_clamp.c ================================================================== --- libtommath/bn_mp_clamp.c +++ libtommath/bn_mp_clamp.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_CLAMP_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* trim unused digits * * This is used to ensure that leading zero digits are * trimed and the leading "used" digit will be non-zero @@ -32,9 +23,5 @@ if (a->used == 0) { a->sign = MP_ZPOS; } } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_clear.c ================================================================== --- libtommath/bn_mp_clear.c +++ libtommath/bn_mp_clear.c @@ -1,40 +1,20 @@ #include "tommath_private.h" #ifdef BN_MP_CLEAR_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* clear one (frees) */ void mp_clear(mp_int *a) { - int i; - /* only do anything if a hasn't been freed previously */ if (a->dp != NULL) { - /* first zero the digits */ - for (i = 0; i < a->used; i++) { - a->dp[i] = 0; - } - /* free ram */ - XFREE(a->dp, sizeof (mp_digit) * (size_t)a->alloc); + MP_FREE_DIGITS(a->dp, a->alloc); /* reset members to make debugging easier */ a->dp = NULL; a->alloc = a->used = 0; a->sign = MP_ZPOS; } } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_clear_multi.c ================================================================== --- libtommath/bn_mp_clear_multi.c +++ libtommath/bn_mp_clear_multi.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_CLEAR_MULTI_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #include void mp_clear_multi(mp_int *mp, ...) { @@ -24,9 +15,5 @@ next_mp = va_arg(args, mp_int *); } va_end(args); } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_cnt_lsb.c ================================================================== --- libtommath/bn_mp_cnt_lsb.c +++ libtommath/bn_mp_cnt_lsb.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_CNT_LSB_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ static const int lnz[16] = { 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0 }; @@ -21,18 +12,18 @@ { int x; mp_digit q, qq; /* easy out */ - if (mp_iszero(a) == MP_YES) { + if (MP_IS_ZERO(a)) { return 0; } /* scan lower digits until non-zero */ for (x = 0; (x < a->used) && (a->dp[x] == 0u); x++) {} q = a->dp[x]; - x *= DIGIT_BIT; + x *= MP_DIGIT_BIT; /* now scan this digit until a 1 is found */ if ((q & 1u) == 0u) { do { qq = q & 15u; @@ -42,9 +33,5 @@ } return x; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_complement.c ================================================================== --- libtommath/bn_mp_complement.c +++ libtommath/bn_mp_complement.c @@ -1,25 +1,12 @@ #include "tommath_private.h" #ifdef BN_MP_COMPLEMENT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* b = ~a */ -int mp_complement(const mp_int *a, mp_int *b) +mp_err mp_complement(const mp_int *a, mp_int *b) { - int res = mp_neg(a, b); - return (res == MP_OKAY) ? mp_sub_d(b, 1uL, b) : res; + mp_err err = mp_neg(a, b); + return (err == MP_OKAY) ? mp_sub_d(b, 1uL, b) : err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_copy.c ================================================================== --- libtommath/bn_mp_copy.c +++ libtommath/bn_mp_copy.c @@ -1,64 +1,47 @@ #include "tommath_private.h" #ifdef BN_MP_COPY_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* copy, b = a */ -int mp_copy(const mp_int *a, mp_int *b) +mp_err mp_copy(const mp_int *a, mp_int *b) { - int res, n; + int n; + mp_digit *tmpa, *tmpb; + mp_err err; /* if dst == src do nothing */ if (a == b) { return MP_OKAY; } /* grow dest */ if (b->alloc < a->used) { - if ((res = mp_grow(b, a->used)) != MP_OKAY) { - return res; + if ((err = mp_grow(b, a->used)) != MP_OKAY) { + return err; } } /* zero b and copy the parameters over */ - { - mp_digit *tmpa, *tmpb; - - /* pointer aliases */ - - /* source */ - tmpa = a->dp; - - /* destination */ - tmpb = b->dp; - - /* copy all the digits */ - for (n = 0; n < a->used; n++) { - *tmpb++ = *tmpa++; - } - - /* clear high digits */ - for (; n < b->used; n++) { - *tmpb++ = 0; - } - } + /* pointer aliases */ + + /* source */ + tmpa = a->dp; + + /* destination */ + tmpb = b->dp; + + /* copy all the digits */ + for (n = 0; n < a->used; n++) { + *tmpb++ = *tmpa++; + } + + /* clear high digits */ + MP_ZERO_DIGITS(tmpb, b->used - n); /* copy used count and sign */ b->used = a->used; b->sign = a->sign; return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_count_bits.c ================================================================== --- libtommath/bn_mp_count_bits.c +++ libtommath/bn_mp_count_bits.c @@ -1,41 +1,28 @@ #include "tommath_private.h" #ifdef BN_MP_COUNT_BITS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* returns the number of bits in an int */ int mp_count_bits(const mp_int *a) { int r; mp_digit q; /* shortcut */ - if (a->used == 0) { + if (MP_IS_ZERO(a)) { return 0; } /* get number of digits and add that */ - r = (a->used - 1) * DIGIT_BIT; + r = (a->used - 1) * MP_DIGIT_BIT; /* take the last digit and count the bits in it */ q = a->dp[a->used - 1]; - while (q > (mp_digit)0) { + while (q > 0u) { ++r; - q >>= (mp_digit)1; + q >>= 1u; } return r; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_decr.c Index: libtommath/bn_mp_decr.c ================================================================== --- /dev/null +++ libtommath/bn_mp_decr.c @@ -0,0 +1,34 @@ +#include "tommath_private.h" +#ifdef BN_MP_DECR_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* Decrement "a" by one like "a--". Changes input! */ +mp_err mp_decr(mp_int *a) +{ + if (MP_IS_ZERO(a)) { + mp_set(a,1uL); + a->sign = MP_NEG; + return MP_OKAY; + } else if (a->sign == MP_NEG) { + mp_err err; + a->sign = MP_ZPOS; + if ((err = mp_incr(a)) != MP_OKAY) { + return err; + } + /* There is no -0 in LTM */ + if (!MP_IS_ZERO(a)) { + a->sign = MP_NEG; + } + return MP_OKAY; + } else if (a->dp[0] > 1uL) { + a->dp[0]--; + if (a->dp[0] == 0u) { + mp_zero(a); + } + return MP_OKAY; + } else { + return mp_sub_d(a, 1uL,a); + } +} +#endif Index: libtommath/bn_mp_div.c ================================================================== --- libtommath/bn_mp_div.c +++ libtommath/bn_mp_div.c @@ -1,87 +1,73 @@ #include "tommath_private.h" #ifdef BN_MP_DIV_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #ifdef BN_MP_DIV_SMALL /* slower bit-bang division... also smaller */ -int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) +mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) { mp_int ta, tb, tq, q; - int res, n, n2; + int n, n2; + mp_err err; /* is divisor zero ? */ - if (mp_iszero(b) == MP_YES) { + if (MP_IS_ZERO(b)) { return MP_VAL; } /* if a < b then q=0, r = a */ if (mp_cmp_mag(a, b) == MP_LT) { if (d != NULL) { - res = mp_copy(a, d); + err = mp_copy(a, d); } else { - res = MP_OKAY; + err = MP_OKAY; } if (c != NULL) { mp_zero(c); } - return res; + return err; } /* init our temps */ - if ((res = mp_init_multi(&ta, &tb, &tq, &q, NULL)) != MP_OKAY) { - return res; + if ((err = mp_init_multi(&ta, &tb, &tq, &q, NULL)) != MP_OKAY) { + return err; } mp_set(&tq, 1uL); n = mp_count_bits(a) - mp_count_bits(b); - if (((res = mp_abs(a, &ta)) != MP_OKAY) || - ((res = mp_abs(b, &tb)) != MP_OKAY) || - ((res = mp_mul_2d(&tb, n, &tb)) != MP_OKAY) || - ((res = mp_mul_2d(&tq, n, &tq)) != MP_OKAY)) { - goto LBL_ERR; - } + if ((err = mp_abs(a, &ta)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_abs(b, &tb)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_mul_2d(&tb, n, &tb)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_mul_2d(&tq, n, &tq)) != MP_OKAY) goto LBL_ERR; while (n-- >= 0) { if (mp_cmp(&tb, &ta) != MP_GT) { - if (((res = mp_sub(&ta, &tb, &ta)) != MP_OKAY) || - ((res = mp_add(&q, &tq, &q)) != MP_OKAY)) { - goto LBL_ERR; - } - } - if (((res = mp_div_2d(&tb, 1, &tb, NULL)) != MP_OKAY) || - ((res = mp_div_2d(&tq, 1, &tq, NULL)) != MP_OKAY)) { - goto LBL_ERR; - } + if ((err = mp_sub(&ta, &tb, &ta)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&q, &tq, &q)) != MP_OKAY) goto LBL_ERR; + } + if ((err = mp_div_2d(&tb, 1, &tb, NULL)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_div_2d(&tq, 1, &tq, NULL)) != MP_OKAY) goto LBL_ERR; } /* now q == quotient and ta == remainder */ n = a->sign; n2 = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; if (c != NULL) { mp_exch(c, &q); - c->sign = (mp_iszero(c) == MP_YES) ? MP_ZPOS : n2; + c->sign = MP_IS_ZERO(c) ? MP_ZPOS : n2; } if (d != NULL) { mp_exch(d, &ta); - d->sign = (mp_iszero(d) == MP_YES) ? MP_ZPOS : n; + d->sign = MP_IS_ZERO(d) ? MP_ZPOS : n; } LBL_ERR: mp_clear_multi(&ta, &tb, &tq, &q, NULL); - return res; + return err; } #else /* integer signed division. @@ -95,86 +81,73 @@ * case that y has fewer than three digits, etc.. * * The overall algorithm is as described as * 14.20 from HAC but fixed to treat these cases. */ -int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) +mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) { mp_int q, x, y, t1, t2; - int res, n, t, i, norm, neg; + int n, t, i, norm; + mp_sign neg; + mp_err err; /* is divisor zero ? */ - if (mp_iszero(b) == MP_YES) { + if (MP_IS_ZERO(b)) { return MP_VAL; } /* if a < b then q=0, r = a */ if (mp_cmp_mag(a, b) == MP_LT) { if (d != NULL) { - res = mp_copy(a, d); + err = mp_copy(a, d); } else { - res = MP_OKAY; + err = MP_OKAY; } if (c != NULL) { mp_zero(c); } - return res; + return err; } - if ((res = mp_init_size(&q, a->used + 2)) != MP_OKAY) { - return res; + if ((err = mp_init_size(&q, a->used + 2)) != MP_OKAY) { + return err; } q.used = a->used + 2; - if ((res = mp_init(&t1)) != MP_OKAY) { - goto LBL_Q; - } - - if ((res = mp_init(&t2)) != MP_OKAY) { - goto LBL_T1; - } - - if ((res = mp_init_copy(&x, a)) != MP_OKAY) { - goto LBL_T2; - } - - if ((res = mp_init_copy(&y, b)) != MP_OKAY) { - goto LBL_X; - } + if ((err = mp_init(&t1)) != MP_OKAY) goto LBL_Q; + + if ((err = mp_init(&t2)) != MP_OKAY) goto LBL_T1; + + if ((err = mp_init_copy(&x, a)) != MP_OKAY) goto LBL_T2; + + if ((err = mp_init_copy(&y, b)) != MP_OKAY) goto LBL_X; /* fix the sign */ neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; x.sign = y.sign = MP_ZPOS; - /* normalize both x and y, ensure that y >= b/2, [b == 2**DIGIT_BIT] */ - norm = mp_count_bits(&y) % DIGIT_BIT; - if (norm < (DIGIT_BIT - 1)) { - norm = (DIGIT_BIT - 1) - norm; - if ((res = mp_mul_2d(&x, norm, &x)) != MP_OKAY) { - goto LBL_Y; - } - if ((res = mp_mul_2d(&y, norm, &y)) != MP_OKAY) { - goto LBL_Y; - } + /* normalize both x and y, ensure that y >= b/2, [b == 2**MP_DIGIT_BIT] */ + norm = mp_count_bits(&y) % MP_DIGIT_BIT; + if (norm < (MP_DIGIT_BIT - 1)) { + norm = (MP_DIGIT_BIT - 1) - norm; + if ((err = mp_mul_2d(&x, norm, &x)) != MP_OKAY) goto LBL_Y; + if ((err = mp_mul_2d(&y, norm, &y)) != MP_OKAY) goto LBL_Y; } else { norm = 0; } /* note hac does 0 based, so if used==5 then its 0,1,2,3,4, e.g. use 4 */ n = x.used - 1; t = y.used - 1; /* while (x >= y*b**n-t) do { q[n-t] += 1; x -= y*b**{n-t} } */ - if ((res = mp_lshd(&y, n - t)) != MP_OKAY) { /* y = y*b**{n-t} */ - goto LBL_Y; - } + /* y = y*b**{n-t} */ + if ((err = mp_lshd(&y, n - t)) != MP_OKAY) goto LBL_Y; while (mp_cmp(&x, &y) != MP_LT) { ++(q.dp[n - t]); - if ((res = mp_sub(&x, &y, &x)) != MP_OKAY) { - goto LBL_Y; - } + if ((err = mp_sub(&x, &y, &x)) != MP_OKAY) goto LBL_Y; } /* reset y by shifting it back down */ mp_rshd(&y, n - t); @@ -185,14 +158,14 @@ } /* step 3.1 if xi == yt then set q{i-t-1} to b-1, * otherwise set q{i-t-1} to (xi*b + x{i-1})/yt */ if (x.dp[i] == y.dp[t]) { - q.dp[(i - t) - 1] = ((mp_digit)1 << (mp_digit)DIGIT_BIT) - (mp_digit)1; + q.dp[(i - t) - 1] = ((mp_digit)1 << (mp_digit)MP_DIGIT_BIT) - (mp_digit)1; } else { mp_word tmp; - tmp = (mp_word)x.dp[i] << (mp_word)DIGIT_BIT; + tmp = (mp_word)x.dp[i] << (mp_word)MP_DIGIT_BIT; tmp |= (mp_word)x.dp[i - 1]; tmp /= (mp_word)y.dp[t]; if (tmp > (mp_word)MP_MASK) { tmp = MP_MASK; } @@ -211,45 +184,31 @@ /* find left hand */ mp_zero(&t1); t1.dp[0] = ((t - 1) < 0) ? 0u : y.dp[t - 1]; t1.dp[1] = y.dp[t]; t1.used = 2; - if ((res = mp_mul_d(&t1, q.dp[(i - t) - 1], &t1)) != MP_OKAY) { - goto LBL_Y; - } + if ((err = mp_mul_d(&t1, q.dp[(i - t) - 1], &t1)) != MP_OKAY) goto LBL_Y; /* find right hand */ t2.dp[0] = ((i - 2) < 0) ? 0u : x.dp[i - 2]; - t2.dp[1] = ((i - 1) < 0) ? 0u : x.dp[i - 1]; + t2.dp[1] = x.dp[i - 1]; /* i >= 1 always holds */ t2.dp[2] = x.dp[i]; t2.used = 3; } while (mp_cmp_mag(&t1, &t2) == MP_GT); /* step 3.3 x = x - q{i-t-1} * y * b**{i-t-1} */ - if ((res = mp_mul_d(&y, q.dp[(i - t) - 1], &t1)) != MP_OKAY) { - goto LBL_Y; - } - - if ((res = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) { - goto LBL_Y; - } - - if ((res = mp_sub(&x, &t1, &x)) != MP_OKAY) { - goto LBL_Y; - } + if ((err = mp_mul_d(&y, q.dp[(i - t) - 1], &t1)) != MP_OKAY) goto LBL_Y; + + if ((err = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) goto LBL_Y; + + if ((err = mp_sub(&x, &t1, &x)) != MP_OKAY) goto LBL_Y; /* if x < 0 then { x = x + y*b**{i-t-1}; q{i-t-1} -= 1; } */ if (x.sign == MP_NEG) { - if ((res = mp_copy(&y, &t1)) != MP_OKAY) { - goto LBL_Y; - } - if ((res = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) { - goto LBL_Y; - } - if ((res = mp_add(&x, &t1, &x)) != MP_OKAY) { - goto LBL_Y; - } + if ((err = mp_copy(&y, &t1)) != MP_OKAY) goto LBL_Y; + if ((err = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY) goto LBL_Y; + if ((err = mp_add(&x, &t1, &x)) != MP_OKAY) goto LBL_Y; q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & MP_MASK; } } @@ -265,17 +224,15 @@ mp_exch(&q, c); c->sign = neg; } if (d != NULL) { - if ((res = mp_div_2d(&x, norm, &x, NULL)) != MP_OKAY) { - goto LBL_Y; - } + if ((err = mp_div_2d(&x, norm, &x, NULL)) != MP_OKAY) goto LBL_Y; mp_exch(&x, d); } - res = MP_OKAY; + err = MP_OKAY; LBL_Y: mp_clear(&y); LBL_X: mp_clear(&x); @@ -283,15 +240,11 @@ mp_clear(&t2); LBL_T1: mp_clear(&t1); LBL_Q: mp_clear(&q); - return res; + return err; } #endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_div_2.c ================================================================== --- libtommath/bn_mp_div_2.c +++ libtommath/bn_mp_div_2.c @@ -1,65 +1,49 @@ #include "tommath_private.h" #ifdef BN_MP_DIV_2_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* b = a/2 */ -int mp_div_2(const mp_int *a, mp_int *b) +mp_err mp_div_2(const mp_int *a, mp_int *b) { - int x, res, oldused; + int x, oldused; + mp_digit r, rr, *tmpa, *tmpb; + mp_err err; /* copy */ if (b->alloc < a->used) { - if ((res = mp_grow(b, a->used)) != MP_OKAY) { - return res; + if ((err = mp_grow(b, a->used)) != MP_OKAY) { + return err; } } oldused = b->used; b->used = a->used; - { - mp_digit r, rr, *tmpa, *tmpb; - - /* source alias */ - tmpa = a->dp + b->used - 1; - - /* dest alias */ - tmpb = b->dp + b->used - 1; - - /* carry */ - r = 0; - for (x = b->used - 1; x >= 0; x--) { - /* get the carry for the next iteration */ - rr = *tmpa & 1u; - - /* shift the current digit, add in carry and store */ - *tmpb-- = (*tmpa-- >> 1) | (r << (DIGIT_BIT - 1)); - - /* forward carry to next iteration */ - r = rr; - } - - /* zero excess digits */ - tmpb = b->dp + b->used; - for (x = b->used; x < oldused; x++) { - *tmpb++ = 0; - } - } + + /* source alias */ + tmpa = a->dp + b->used - 1; + + /* dest alias */ + tmpb = b->dp + b->used - 1; + + /* carry */ + r = 0; + for (x = b->used - 1; x >= 0; x--) { + /* get the carry for the next iteration */ + rr = *tmpa & 1u; + + /* shift the current digit, add in carry and store */ + *tmpb-- = (*tmpa-- >> 1) | (r << (MP_DIGIT_BIT - 1)); + + /* forward carry to next iteration */ + r = rr; + } + + /* zero excess digits */ + MP_ZERO_DIGITS(b->dp + b->used, oldused - b->used); + b->sign = a->sign; mp_clamp(b); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_div_2d.c ================================================================== --- libtommath/bn_mp_div_2d.c +++ libtommath/bn_mp_div_2d.c @@ -1,62 +1,54 @@ #include "tommath_private.h" #ifdef BN_MP_DIV_2D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* shift right by a certain bit count (store quotient in c, optional remainder in d) */ -int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) +mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) { mp_digit D, r, rr; - int x, res; + int x; + mp_err err; /* if the shift count is <= 0 then we do no work */ if (b <= 0) { - res = mp_copy(a, c); + err = mp_copy(a, c); if (d != NULL) { mp_zero(d); } - return res; + return err; } /* copy */ - if ((res = mp_copy(a, c)) != MP_OKAY) { - return res; + if ((err = mp_copy(a, c)) != MP_OKAY) { + return err; } /* 'a' should not be used after here - it might be the same as d */ /* get the remainder */ if (d != NULL) { - if ((res = mp_mod_2d(a, b, d)) != MP_OKAY) { - return res; + if ((err = mp_mod_2d(a, b, d)) != MP_OKAY) { + return err; } } /* shift by as many digits in the bit count */ - if (b >= DIGIT_BIT) { - mp_rshd(c, b / DIGIT_BIT); + if (b >= MP_DIGIT_BIT) { + mp_rshd(c, b / MP_DIGIT_BIT); } - /* shift any bit count < DIGIT_BIT */ - D = (mp_digit)(b % DIGIT_BIT); + /* shift any bit count < MP_DIGIT_BIT */ + D = (mp_digit)(b % MP_DIGIT_BIT); if (D != 0u) { mp_digit *tmpc, mask, shift; /* mask */ mask = ((mp_digit)1 << D) - 1uL; /* shift for lsb */ - shift = (mp_digit)DIGIT_BIT - D; + shift = (mp_digit)MP_DIGIT_BIT - D; /* alias */ tmpc = c->dp + (c->used - 1); /* carry */ @@ -75,9 +67,5 @@ } mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_div_3.c ================================================================== --- libtommath/bn_mp_div_3.c +++ libtommath/bn_mp_div_3.c @@ -1,43 +1,35 @@ #include "tommath_private.h" #ifdef BN_MP_DIV_3_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* divide by three (based on routine from MPI and the GMP manual) */ -int mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) +mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) { mp_int q; mp_word w, t; mp_digit b; - int res, ix; + mp_err err; + int ix; - /* b = 2**DIGIT_BIT / 3 */ - b = ((mp_word)1 << (mp_word)DIGIT_BIT) / (mp_word)3; + /* b = 2**MP_DIGIT_BIT / 3 */ + b = ((mp_word)1 << (mp_word)MP_DIGIT_BIT) / (mp_word)3; - if ((res = mp_init_size(&q, a->used)) != MP_OKAY) { - return res; + if ((err = mp_init_size(&q, a->used)) != MP_OKAY) { + return err; } q.used = a->used; q.sign = a->sign; w = 0; for (ix = a->used - 1; ix >= 0; ix--) { - w = (w << (mp_word)DIGIT_BIT) | (mp_word)a->dp[ix]; + w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix]; if (w >= 3u) { /* multiply w by [1/3] */ - t = (w * (mp_word)b) >> (mp_word)DIGIT_BIT; + t = (w * (mp_word)b) >> (mp_word)MP_DIGIT_BIT; /* now subtract 3 * [w/3] from w, to get the remainder */ w -= t+t+t; /* fixup the remainder as required since @@ -63,13 +55,9 @@ mp_clamp(&q); mp_exch(&q, c); } mp_clear(&q); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_div_d.c ================================================================== --- libtommath/bn_mp_div_d.c +++ libtommath/bn_mp_div_d.c @@ -1,34 +1,26 @@ #include "tommath_private.h" #ifdef BN_MP_DIV_D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* single digit division (based on routine from MPI) */ -int mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) +mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) { mp_int q; mp_word w; mp_digit t; - int res, ix; + mp_err err; + int ix; /* cannot divide by zero */ if (b == 0u) { return MP_VAL; } /* quick outs */ - if ((b == 1u) || (mp_iszero(a) == MP_YES)) { + if ((b == 1u) || MP_IS_ZERO(a)) { if (d != NULL) { *d = 0; } if (c != NULL) { return mp_copy(a, c); @@ -35,15 +27,14 @@ } return MP_OKAY; } /* power of two ? */ - if (((b & (b-1)) == 0)) { - for (ix = 1; ix < DIGIT_BIT; ix++) { - if (b == (((mp_digit)1)<dp[0] & (((mp_digit)1<<(mp_digit)ix) - 1uL); } if (c != NULL) { @@ -50,27 +41,25 @@ return mp_div_2d(a, ix, c, NULL); } return MP_OKAY; } -#ifdef BN_MP_DIV_3_C /* three? */ - if (b == 3u) { + if (MP_HAS(MP_DIV_3) && (b == 3u)) { return mp_div_3(a, c, d); } -#endif /* no easy answer [c'est la vie]. Just division */ - if ((res = mp_init_size(&q, a->used)) != MP_OKAY) { - return res; + if ((err = mp_init_size(&q, a->used)) != MP_OKAY) { + return err; } q.used = a->used; q.sign = a->sign; w = 0; for (ix = a->used - 1; ix >= 0; ix--) { - w = (w << (mp_word)DIGIT_BIT) | (mp_word)a->dp[ix]; + w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix]; if (w >= b) { t = (mp_digit)(w / b); w -= (mp_word)t * (mp_word)b; } else { @@ -87,13 +76,9 @@ mp_clamp(&q); mp_exch(&q, c); } mp_clear(&q); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_dr_is_modulus.c ================================================================== --- libtommath/bn_mp_dr_is_modulus.c +++ libtommath/bn_mp_dr_is_modulus.c @@ -1,40 +1,27 @@ #include "tommath_private.h" #ifdef BN_MP_DR_IS_MODULUS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* determines if a number is a valid DR modulus */ -int mp_dr_is_modulus(const mp_int *a) +mp_bool mp_dr_is_modulus(const mp_int *a) { int ix; /* must be at least two digits */ if (a->used < 2) { - return 0; + return MP_NO; } /* must be of the form b**k - a [a <= b] so all * but the first digit must be equal to -1 (mod b). */ for (ix = 1; ix < a->used; ix++) { if (a->dp[ix] != MP_MASK) { - return 0; + return MP_NO; } } - return 1; + return MP_YES; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_dr_reduce.c ================================================================== --- libtommath/bn_mp_dr_reduce.c +++ libtommath/bn_mp_dr_reduce.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_DR_REDUCE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* reduce "x" in place modulo "n" using the Diminished Radix algorithm. * * Based on algorithm from the paper * @@ -24,13 +15,14 @@ * * Has been modified to use algorithm 7.10 from the LTM book instead * * Input x must be in the range 0 <= x <= (n-1)**2 */ -int mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) +mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) { - int err, i, m; + mp_err err; + int i, m; mp_word r; mp_digit mu, *tmpx1, *tmpx2; /* m = digits in modulus */ m = n->used; @@ -58,20 +50,18 @@ /* compute (x mod B**m) + k * [x/B**m] inline and inplace */ for (i = 0; i < m; i++) { r = ((mp_word)*tmpx2++ * (mp_word)k) + *tmpx1 + mu; *tmpx1++ = (mp_digit)(r & MP_MASK); - mu = (mp_digit)(r >> ((mp_word)DIGIT_BIT)); + mu = (mp_digit)(r >> ((mp_word)MP_DIGIT_BIT)); } /* set final carry */ *tmpx1++ = mu; /* zero words above m */ - for (i = m + 1; i < x->used; i++) { - *tmpx1++ = 0; - } + MP_ZERO_DIGITS(tmpx1, (x->used - m) - 1); /* clamp, sub and return */ mp_clamp(x); /* if x >= n then subtract and reduce again @@ -84,9 +74,5 @@ goto top; } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_dr_setup.c ================================================================== --- libtommath/bn_mp_dr_setup.c +++ libtommath/bn_mp_dr_setup.c @@ -1,28 +1,15 @@ #include "tommath_private.h" #ifdef BN_MP_DR_SETUP_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* determines the setup value */ void mp_dr_setup(const mp_int *a, mp_digit *d) { - /* the casts are required if DIGIT_BIT is one less than - * the number of bits in a mp_digit [e.g. DIGIT_BIT==31] + /* the casts are required if MP_DIGIT_BIT is one less than + * the number of bits in a mp_digit [e.g. MP_DIGIT_BIT==31] */ - *d = (mp_digit)(((mp_word)1 << (mp_word)DIGIT_BIT) - (mp_word)a->dp[0]); + *d = (mp_digit)(((mp_word)1 << (mp_word)MP_DIGIT_BIT) - (mp_word)a->dp[0]); } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_error_to_string.c Index: libtommath/bn_mp_error_to_string.c ================================================================== --- /dev/null +++ libtommath/bn_mp_error_to_string.c @@ -0,0 +1,27 @@ +#include "tommath_private.h" +#ifdef BN_MP_ERROR_TO_STRING_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* return a char * string for a given code */ +const char *mp_error_to_string(mp_err code) +{ + switch (code) { + case MP_OKAY: + return "Successful"; + case MP_ERR: + return "Unknown error"; + case MP_MEM: + return "Out of heap"; + case MP_VAL: + return "Value out of range"; + case MP_ITER: + return "Max. iterations reached"; + case MP_BUF: + return "Buffer overflow"; + default: + return "Invalid error code"; + } +} + +#endif Index: libtommath/bn_mp_exch.c ================================================================== --- libtommath/bn_mp_exch.c +++ libtommath/bn_mp_exch.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_EXCH_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* swap the elements of two integers, for cases where you can't simply swap the * mp_int pointers around */ void mp_exch(mp_int *a, mp_int *b) @@ -22,9 +13,5 @@ t = *a; *a = *b; *b = t; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_export.c Index: libtommath/bn_mp_export.c ================================================================== --- libtommath/bn_mp_export.c +++ /dev/null @@ -1,84 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_EXPORT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* based on gmp's mpz_export. - * see http://gmplib.org/manual/Integer-Import-and-Export.html - */ -int mp_export(void *rop, size_t *countp, int order, size_t size, - int endian, size_t nails, const mp_int *op) -{ - int result; - size_t odd_nails, nail_bytes, i, j, bits, count; - unsigned char odd_nail_mask; - - mp_int t; - - if ((result = mp_init_copy(&t, op)) != MP_OKAY) { - return result; - } - - if (endian == 0) { - union { - unsigned int i; - char c[4]; - } lint; - lint.i = 0x01020304; - - endian = (lint.c[0] == '\x04') ? -1 : 1; - } - - odd_nails = (nails % 8u); - odd_nail_mask = 0xff; - for (i = 0; i < odd_nails; ++i) { - odd_nail_mask ^= (unsigned char)(1u << (7u - i)); - } - nail_bytes = nails / 8u; - - bits = (size_t)mp_count_bits(&t); - count = (bits / ((size * 8u) - nails)) + (((bits % ((size * 8u) - nails)) != 0u) ? 1u : 0u); - - for (i = 0; i < count; ++i) { - for (j = 0; j < size; ++j) { - unsigned char *byte = (unsigned char *)rop + - (((order == -1) ? i : ((count - 1u) - i)) * size) + - ((endian == -1) ? j : ((size - 1u) - j)); - - if (j >= (size - nail_bytes)) { - *byte = 0; - continue; - } - - *byte = (unsigned char)((j == ((size - nail_bytes) - 1u)) ? (t.dp[0] & odd_nail_mask) : (t.dp[0] & 0xFFuL)); - - if ((result = mp_div_2d(&t, (j == ((size - nail_bytes) - 1u)) ? (int)(8u - odd_nails) : 8, &t, NULL)) != MP_OKAY) { - mp_clear(&t); - return result; - } - } - } - - mp_clear(&t); - - if (countp != NULL) { - *countp = count; - } - - return MP_OKAY; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_expt_d.c Index: libtommath/bn_mp_expt_d.c ================================================================== --- libtommath/bn_mp_expt_d.c +++ /dev/null @@ -1,25 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_EXPT_D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* wrapper function for mp_expt_d_ex() */ -int mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) -{ - return mp_expt_d_ex(a, b, c, 0); -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_expt_d_ex.c Index: libtommath/bn_mp_expt_d_ex.c ================================================================== --- libtommath/bn_mp_expt_d_ex.c +++ /dev/null @@ -1,79 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_EXPT_D_EX_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* calculate c = a**b using a square-multiply algorithm */ -int mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) -{ - int res; - unsigned int x; - - mp_int g; - - if ((res = mp_init_copy(&g, a)) != MP_OKAY) { - return res; - } - - /* set initial result */ - mp_set(c, 1uL); - - if (fast != 0) { - while (b > 0u) { - /* if the bit is set multiply */ - if ((b & 1u) != 0u) { - if ((res = mp_mul(c, &g, c)) != MP_OKAY) { - mp_clear(&g); - return res; - } - } - - /* square */ - if (b > 1u) { - if ((res = mp_sqr(&g, &g)) != MP_OKAY) { - mp_clear(&g); - return res; - } - } - - /* shift to next bit */ - b >>= 1; - } - } else { - for (x = 0; x < (unsigned)DIGIT_BIT; x++) { - /* square */ - if ((res = mp_sqr(c, c)) != MP_OKAY) { - mp_clear(&g); - return res; - } - - /* if the bit is set multiply */ - if ((b & ((mp_digit)1 << (DIGIT_BIT - 1))) != 0u) { - if ((res = mp_mul(c, &g, c)) != MP_OKAY) { - mp_clear(&g); - return res; - } - } - - /* shift to next bit */ - b <<= 1; - } - } /* if ... else */ - - mp_clear(&g); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_expt_u32.c Index: libtommath/bn_mp_expt_u32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_expt_u32.c @@ -0,0 +1,46 @@ +#include "tommath_private.h" +#ifdef BN_MP_EXPT_U32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* calculate c = a**b using a square-multiply algorithm */ +mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) +{ + mp_err err; + + mp_int g; + + if ((err = mp_init_copy(&g, a)) != MP_OKAY) { + return err; + } + + /* set initial result */ + mp_set(c, 1uL); + + while (b > 0u) { + /* if the bit is set multiply */ + if ((b & 1u) != 0u) { + if ((err = mp_mul(c, &g, c)) != MP_OKAY) { + goto LBL_ERR; + } + } + + /* square */ + if (b > 1u) { + if ((err = mp_sqr(&g, &g)) != MP_OKAY) { + goto LBL_ERR; + } + } + + /* shift to next bit */ + b >>= 1; + } + + err = MP_OKAY; + +LBL_ERR: + mp_clear(&g); + return err; +} + +#endif Index: libtommath/bn_mp_exptmod.c ================================================================== --- libtommath/bn_mp_exptmod.c +++ libtommath/bn_mp_exptmod.c @@ -1,26 +1,16 @@ #include "tommath_private.h" #ifdef BN_MP_EXPTMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* this is a shell function that calls either the normal or Montgomery * exptmod functions. Originally the call to the montgomery code was * embedded in the normal function but that wasted alot of stack space * for nothing (since 99% of the time the Montgomery code would be called) */ -int mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) +mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) { int dr; /* modulus P must be positive */ if (P->sign == MP_NEG) { @@ -27,83 +17,60 @@ return MP_VAL; } /* if exponent X is negative we have to recurse */ if (X->sign == MP_NEG) { -#ifdef BN_MP_INVMOD_C - mp_int tmpG, tmpX; - int err; - - /* first compute 1/G mod P */ - if ((err = mp_init(&tmpG)) != MP_OKAY) { - return err; - } - if ((err = mp_invmod(G, P, &tmpG)) != MP_OKAY) { - mp_clear(&tmpG); + mp_int tmpG, tmpX; + mp_err err; + + if (!MP_HAS(MP_INVMOD)) { + return MP_VAL; + } + + if ((err = mp_init_multi(&tmpG, &tmpX, NULL)) != MP_OKAY) { return err; } - /* now get |X| */ - if ((err = mp_init(&tmpX)) != MP_OKAY) { - mp_clear(&tmpG); - return err; - } - if ((err = mp_abs(X, &tmpX)) != MP_OKAY) { - mp_clear_multi(&tmpG, &tmpX, NULL); - return err; + /* first compute 1/G mod P */ + if ((err = mp_invmod(G, P, &tmpG)) != MP_OKAY) { + goto LBL_ERR; + } + + /* now get |X| */ + if ((err = mp_abs(X, &tmpX)) != MP_OKAY) { + goto LBL_ERR; } /* and now compute (1/G)**|X| instead of G**X [X < 0] */ err = mp_exptmod(&tmpG, &tmpX, P, Y); +LBL_ERR: mp_clear_multi(&tmpG, &tmpX, NULL); return err; -#else - /* no invmod */ - return MP_VAL; -#endif } /* modified diminished radix reduction */ -#if defined(BN_MP_REDUCE_IS_2K_L_C) && defined(BN_MP_REDUCE_2K_L_C) && defined(BN_S_MP_EXPTMOD_C) - if (mp_reduce_is_2k_l(P) == MP_YES) { - return s_mp_exptmod(G, X, P, Y, 1); - } -#endif - -#ifdef BN_MP_DR_IS_MODULUS_C - /* is it a DR modulus? */ - dr = mp_dr_is_modulus(P); -#else - /* default to no */ - dr = 0; -#endif - -#ifdef BN_MP_REDUCE_IS_2K_C - /* if not, is it a unrestricted DR modulus? */ - if (dr == 0) { - dr = mp_reduce_is_2k(P) << 1; - } -#endif - - /* if the modulus is odd or dr != 0 use the montgomery method */ -#ifdef BN_MP_EXPTMOD_FAST_C - if ((mp_isodd(P) == MP_YES) || (dr != 0)) { - return mp_exptmod_fast(G, X, P, Y, dr); - } else { -#endif -#ifdef BN_S_MP_EXPTMOD_C - /* otherwise use the generic Barrett reduction technique */ - return s_mp_exptmod(G, X, P, Y, 0); -#else - /* no exptmod for evens */ - return MP_VAL; -#endif -#ifdef BN_MP_EXPTMOD_FAST_C - } -#endif -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ + if (MP_HAS(MP_REDUCE_IS_2K_L) && MP_HAS(MP_REDUCE_2K_L) && MP_HAS(S_MP_EXPTMOD) && + (mp_reduce_is_2k_l(P) == MP_YES)) { + return s_mp_exptmod(G, X, P, Y, 1); + } + + /* is it a DR modulus? default to no */ + dr = (MP_HAS(MP_DR_IS_MODULUS) && (mp_dr_is_modulus(P) == MP_YES)) ? 1 : 0; + + /* if not, is it a unrestricted DR modulus? */ + if (MP_HAS(MP_REDUCE_IS_2K) && (dr == 0)) { + dr = (mp_reduce_is_2k(P) == MP_YES) ? 2 : 0; + } + + /* if the modulus is odd or dr != 0 use the montgomery method */ + if (MP_HAS(S_MP_EXPTMOD_FAST) && (MP_IS_ODD(P) || (dr != 0))) { + return s_mp_exptmod_fast(G, X, P, Y, dr); + } else if (MP_HAS(S_MP_EXPTMOD)) { + /* otherwise use the generic Barrett reduction technique */ + return s_mp_exptmod(G, X, P, Y, 0); + } else { + /* no exptmod for evens */ + return MP_VAL; + } +} + +#endif DELETED libtommath/bn_mp_exptmod_fast.c Index: libtommath/bn_mp_exptmod_fast.c ================================================================== --- libtommath/bn_mp_exptmod_fast.c +++ /dev/null @@ -1,319 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_EXPTMOD_FAST_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85 - * - * Uses a left-to-right k-ary sliding window to compute the modular exponentiation. - * The value of k changes based on the size of the exponent. - * - * Uses Montgomery or Diminished Radix reduction [whichever appropriate] - */ - -#ifdef MP_LOW_MEM -# define TAB_SIZE 32 -#else -# define TAB_SIZE 256 -#endif - -int mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) -{ - mp_int M[TAB_SIZE], res; - mp_digit buf, mp; - int err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize; - - /* use a pointer to the reduction algorithm. This allows us to use - * one of many reduction algorithms without modding the guts of - * the code with if statements everywhere. - */ - int (*redux)(mp_int *x, const mp_int *n, mp_digit rho); - - /* find window size */ - x = mp_count_bits(X); - if (x <= 7) { - winsize = 2; - } else if (x <= 36) { - winsize = 3; - } else if (x <= 140) { - winsize = 4; - } else if (x <= 450) { - winsize = 5; - } else if (x <= 1303) { - winsize = 6; - } else if (x <= 3529) { - winsize = 7; - } else { - winsize = 8; - } - -#ifdef MP_LOW_MEM - if (winsize > 5) { - winsize = 5; - } -#endif - - /* init M array */ - /* init first cell */ - if ((err = mp_init_size(&M[1], P->alloc)) != MP_OKAY) { - return err; - } - - /* now init the second half of the array */ - for (x = 1<<(winsize-1); x < (1 << winsize); x++) { - if ((err = mp_init_size(&M[x], P->alloc)) != MP_OKAY) { - for (y = 1<<(winsize-1); y < x; y++) { - mp_clear(&M[y]); - } - mp_clear(&M[1]); - return err; - } - } - - /* determine and setup reduction code */ - if (redmode == 0) { -#ifdef BN_MP_MONTGOMERY_SETUP_C - /* now setup montgomery */ - if ((err = mp_montgomery_setup(P, &mp)) != MP_OKAY) { - goto LBL_M; - } -#else - err = MP_VAL; - goto LBL_M; -#endif - - /* automatically pick the comba one if available (saves quite a few calls/ifs) */ -#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C - if ((((P->used * 2) + 1) < (int)MP_WARRAY) && - (P->used < (1 << ((CHAR_BIT * sizeof(mp_word)) - (2 * DIGIT_BIT))))) { - redux = fast_mp_montgomery_reduce; - } else -#endif - { -#ifdef BN_MP_MONTGOMERY_REDUCE_C - /* use slower baseline Montgomery method */ - redux = mp_montgomery_reduce; -#else - err = MP_VAL; - goto LBL_M; -#endif - } - } else if (redmode == 1) { -#if defined(BN_MP_DR_SETUP_C) && defined(BN_MP_DR_REDUCE_C) - /* setup DR reduction for moduli of the form B**k - b */ - mp_dr_setup(P, &mp); - redux = mp_dr_reduce; -#else - err = MP_VAL; - goto LBL_M; -#endif - } else { -#if defined(BN_MP_REDUCE_2K_SETUP_C) && defined(BN_MP_REDUCE_2K_C) - /* setup DR reduction for moduli of the form 2**k - b */ - if ((err = mp_reduce_2k_setup(P, &mp)) != MP_OKAY) { - goto LBL_M; - } - redux = mp_reduce_2k; -#else - err = MP_VAL; - goto LBL_M; -#endif - } - - /* setup result */ - if ((err = mp_init_size(&res, P->alloc)) != MP_OKAY) { - goto LBL_M; - } - - /* create M table - * - - * - * The first half of the table is not computed though accept for M[0] and M[1] - */ - - if (redmode == 0) { -#ifdef BN_MP_MONTGOMERY_CALC_NORMALIZATION_C - /* now we need R mod m */ - if ((err = mp_montgomery_calc_normalization(&res, P)) != MP_OKAY) { - goto LBL_RES; - } - - /* now set M[1] to G * R mod m */ - if ((err = mp_mulmod(G, &res, P, &M[1])) != MP_OKAY) { - goto LBL_RES; - } -#else - err = MP_VAL; - goto LBL_RES; -#endif - } else { - mp_set(&res, 1uL); - if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) { - goto LBL_RES; - } - } - - /* compute the value at M[1<<(winsize-1)] by squaring M[1] (winsize-1) times */ - if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) { - goto LBL_RES; - } - - for (x = 0; x < (winsize - 1); x++) { - if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, mp)) != MP_OKAY) { - goto LBL_RES; - } - } - - /* create upper table */ - for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) { - if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&M[x], P, mp)) != MP_OKAY) { - goto LBL_RES; - } - } - - /* set initial mode and bit cnt */ - mode = 0; - bitcnt = 1; - buf = 0; - digidx = X->used - 1; - bitcpy = 0; - bitbuf = 0; - - for (;;) { - /* grab next digit as required */ - if (--bitcnt == 0) { - /* if digidx == -1 we are out of digits so break */ - if (digidx == -1) { - break; - } - /* read next digit and reset bitcnt */ - buf = X->dp[digidx--]; - bitcnt = (int)DIGIT_BIT; - } - - /* grab the next msb from the exponent */ - y = (mp_digit)(buf >> (DIGIT_BIT - 1)) & 1; - buf <<= (mp_digit)1; - - /* if the bit is zero and mode == 0 then we ignore it - * These represent the leading zero bits before the first 1 bit - * in the exponent. Technically this opt is not required but it - * does lower the # of trivial squaring/reductions used - */ - if ((mode == 0) && (y == 0)) { - continue; - } - - /* if the bit is zero and mode == 1 then we square */ - if ((mode == 1) && (y == 0)) { - if ((err = mp_sqr(&res, &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, mp)) != MP_OKAY) { - goto LBL_RES; - } - continue; - } - - /* else we add it to the window */ - bitbuf |= (y << (winsize - ++bitcpy)); - mode = 2; - - if (bitcpy == winsize) { - /* ok window is filled so square as required and multiply */ - /* square first */ - for (x = 0; x < winsize; x++) { - if ((err = mp_sqr(&res, &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, mp)) != MP_OKAY) { - goto LBL_RES; - } - } - - /* then multiply */ - if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, mp)) != MP_OKAY) { - goto LBL_RES; - } - - /* empty window and reset */ - bitcpy = 0; - bitbuf = 0; - mode = 1; - } - } - - /* if bits remain then square/multiply */ - if ((mode == 2) && (bitcpy > 0)) { - /* square then multiply if the bit is set */ - for (x = 0; x < bitcpy; x++) { - if ((err = mp_sqr(&res, &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, mp)) != MP_OKAY) { - goto LBL_RES; - } - - /* get next bit of the window */ - bitbuf <<= 1; - if ((bitbuf & (1 << winsize)) != 0) { - /* then multiply */ - if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, mp)) != MP_OKAY) { - goto LBL_RES; - } - } - } - } - - if (redmode == 0) { - /* fixup result if Montgomery reduction is used - * recall that any value in a Montgomery system is - * actually multiplied by R mod n. So we have - * to reduce one more time to cancel out the factor - * of R. - */ - if ((err = redux(&res, P, mp)) != MP_OKAY) { - goto LBL_RES; - } - } - - /* swap res with Y */ - mp_exch(&res, Y); - err = MP_OKAY; -LBL_RES: - mp_clear(&res); -LBL_M: - mp_clear(&M[1]); - for (x = 1<<(winsize-1); x < (1 << winsize); x++) { - mp_clear(&M[x]); - } - return err; -} -#endif - - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_exteuclid.c ================================================================== --- libtommath/bn_mp_exteuclid.c +++ libtommath/bn_mp_exteuclid.c @@ -1,104 +1,59 @@ #include "tommath_private.h" #ifdef BN_MP_EXTEUCLID_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* Extended euclidean algorithm of (a, b) produces a*u1 + b*u2 = u3 */ -int mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) +mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) { mp_int u1, u2, u3, v1, v2, v3, t1, t2, t3, q, tmp; - int err; + mp_err err; if ((err = mp_init_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL)) != MP_OKAY) { return err; } /* initialize, (u1,u2,u3) = (1,0,a) */ mp_set(&u1, 1uL); - if ((err = mp_copy(a, &u3)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_copy(a, &u3)) != MP_OKAY) goto LBL_ERR; /* initialize, (v1,v2,v3) = (0,1,b) */ mp_set(&v2, 1uL); - if ((err = mp_copy(b, &v3)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_copy(b, &v3)) != MP_OKAY) goto LBL_ERR; /* loop while v3 != 0 */ - while (mp_iszero(&v3) == MP_NO) { + while (!MP_IS_ZERO(&v3)) { /* q = u3/v3 */ - if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY) goto LBL_ERR; /* (t1,t2,t3) = (u1,u2,u3) - (v1,v2,v3)q */ - if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY) goto LBL_ERR; /* (u1,u2,u3) = (v1,v2,v3) */ - if ((err = mp_copy(&v1, &u1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_copy(&v2, &u2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_copy(&v3, &u3)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_copy(&v1, &u1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(&v2, &u2)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(&v3, &u3)) != MP_OKAY) goto LBL_ERR; /* (v1,v2,v3) = (t1,t2,t3) */ - if ((err = mp_copy(&t1, &v1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_copy(&t2, &v2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_copy(&t3, &v3)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_copy(&t1, &v1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(&t2, &v2)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(&t3, &v3)) != MP_OKAY) goto LBL_ERR; } /* make sure U3 >= 0 */ if (u3.sign == MP_NEG) { - if ((err = mp_neg(&u1, &u1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_neg(&u2, &u2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_neg(&u3, &u3)) != MP_OKAY) { - goto LBL_ERR; - } + if ((err = mp_neg(&u1, &u1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_neg(&u2, &u2)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_neg(&u3, &u3)) != MP_OKAY) goto LBL_ERR; } /* copy result out */ if (U1 != NULL) { mp_exch(U1, &u1); @@ -114,9 +69,5 @@ LBL_ERR: mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL); return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_fread.c ================================================================== --- libtommath/bn_mp_fread.c +++ libtommath/bn_mp_fread.c @@ -1,40 +1,37 @@ #include "tommath_private.h" #ifdef BN_MP_FREAD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -#ifndef LTM_NO_FILE +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#ifndef MP_NO_FILE /* read a bigint from a file stream in ASCII */ -int mp_fread(mp_int *a, int radix, FILE *stream) +mp_err mp_fread(mp_int *a, int radix, FILE *stream) { - int err, ch, neg, y; - unsigned pos; - - /* clear a */ - mp_zero(a); + mp_err err; + mp_sign neg; /* if first digit is - then set negative */ - ch = fgetc(stream); + int ch = fgetc(stream); if (ch == (int)'-') { neg = MP_NEG; ch = fgetc(stream); } else { neg = MP_ZPOS; } - for (;;) { - pos = (unsigned)(ch - (int)'('); + /* no digits, return error */ + if (ch == EOF) { + return MP_ERR; + } + + /* clear a */ + mp_zero(a); + + do { + int y; + unsigned pos = (unsigned)(ch - (int)'('); if (mp_s_rmap_reverse_sz < pos) { break; } y = (int)mp_s_rmap_reverse[pos]; @@ -48,21 +45,16 @@ return err; } if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) { return err; } + } while ((ch = fgetc(stream)) != EOF); - ch = fgetc(stream); - } - if (mp_cmp_d(a, 0uL) != MP_EQ) { + if (a->used != 0) { a->sign = neg; } return MP_OKAY; } #endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_from_sbin.c Index: libtommath/bn_mp_from_sbin.c ================================================================== --- /dev/null +++ libtommath/bn_mp_from_sbin.c @@ -0,0 +1,25 @@ +#include "tommath_private.h" +#ifdef BN_MP_FROM_SBIN_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* read signed bin, big endian, first byte is 0==positive or 1==negative */ +mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) +{ + mp_err err; + + /* read magnitude */ + if ((err = mp_from_ubin(a, buf + 1, size - 1u)) != MP_OKAY) { + return err; + } + + /* first byte is 0 for positive, non-zero for negative */ + if (buf[0] == (unsigned char)0) { + a->sign = MP_ZPOS; + } else { + a->sign = MP_NEG; + } + + return MP_OKAY; +} +#endif ADDED libtommath/bn_mp_from_ubin.c Index: libtommath/bn_mp_from_ubin.c ================================================================== --- /dev/null +++ libtommath/bn_mp_from_ubin.c @@ -0,0 +1,39 @@ +#include "tommath_private.h" +#ifdef BN_MP_FROM_UBIN_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* reads a unsigned char array, assumes the msb is stored first [big endian] */ +mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) +{ + mp_err err; + + /* make sure there are at least two digits */ + if (a->alloc < 2) { + if ((err = mp_grow(a, 2)) != MP_OKAY) { + return err; + } + } + + /* zero the int */ + mp_zero(a); + + /* read the bytes in */ + while (size-- > 0u) { + if ((err = mp_mul_2d(a, 8, a)) != MP_OKAY) { + return err; + } + +#ifndef MP_8BIT + a->dp[0] |= *buf++; + a->used += 1; +#else + a->dp[0] = (*buf & MP_MASK); + a->dp[1] |= ((*buf++ >> 7) & 1u); + a->used += 2; +#endif + } + mp_clamp(a); + return MP_OKAY; +} +#endif Index: libtommath/bn_mp_fwrite.c ================================================================== --- libtommath/bn_mp_fwrite.c +++ libtommath/bn_mp_fwrite.c @@ -1,51 +1,45 @@ #include "tommath_private.h" #ifdef BN_MP_FWRITE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -#ifndef LTM_NO_FILE -int mp_fwrite(const mp_int *a, int radix, FILE *stream) -{ - char *buf; - int err, len, x; - - if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) { - return err; - } - - buf = (char *) XMALLOC((size_t)len); +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#ifndef MP_NO_FILE +mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) +{ + char *buf; + mp_err err; + int len; + size_t written; + + /* TODO: this function is not in this PR */ + if (MP_HAS(MP_RADIX_SIZE_OVERESTIMATE)) { + /* if ((err = mp_radix_size_overestimate(&t, base, &len)) != MP_OKAY) goto LBL_ERR; */ + } else { + if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) { + return err; + } + } + + buf = (char *) MP_MALLOC((size_t)len); if (buf == NULL) { return MP_MEM; } - if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) { - XFREE(buf, len); - return err; - } - - for (x = 0; x < len; x++) { - if (fputc((int)buf[x], stream) == EOF) { - XFREE(buf, len); - return MP_VAL; - } - } - - XFREE(buf, len); - return MP_OKAY; + if ((err = mp_to_radix(a, buf, (size_t)len, &written, radix)) != MP_OKAY) { + goto LBL_ERR; + } + + if (fwrite(buf, written, 1uL, stream) != 1uL) { + err = MP_ERR; + goto LBL_ERR; + } + err = MP_OKAY; + + +LBL_ERR: + MP_FREE_BUFFER(buf, (size_t)len); + return err; } #endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_gcd.c ================================================================== --- libtommath/bn_mp_gcd.c +++ libtommath/bn_mp_gcd.c @@ -1,104 +1,92 @@ #include "tommath_private.h" #ifdef BN_MP_GCD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* Greatest Common Divisor using the binary method */ -int mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) +mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) { mp_int u, v; - int k, u_lsb, v_lsb, res; + int k, u_lsb, v_lsb; + mp_err err; /* either zero than gcd is the largest */ - if (mp_iszero(a) == MP_YES) { + if (MP_IS_ZERO(a)) { return mp_abs(b, c); } - if (mp_iszero(b) == MP_YES) { + if (MP_IS_ZERO(b)) { return mp_abs(a, c); } /* get copies of a and b we can modify */ - if ((res = mp_init_copy(&u, a)) != MP_OKAY) { - return res; + if ((err = mp_init_copy(&u, a)) != MP_OKAY) { + return err; } - if ((res = mp_init_copy(&v, b)) != MP_OKAY) { + if ((err = mp_init_copy(&v, b)) != MP_OKAY) { goto LBL_U; } /* must be positive for the remainder of the algorithm */ u.sign = v.sign = MP_ZPOS; /* B1. Find the common power of two for u and v */ u_lsb = mp_cnt_lsb(&u); v_lsb = mp_cnt_lsb(&v); - k = MIN(u_lsb, v_lsb); + k = MP_MIN(u_lsb, v_lsb); if (k > 0) { /* divide the power of two out */ - if ((res = mp_div_2d(&u, k, &u, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&u, k, &u, NULL)) != MP_OKAY) { goto LBL_V; } - if ((res = mp_div_2d(&v, k, &v, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&v, k, &v, NULL)) != MP_OKAY) { goto LBL_V; } } /* divide any remaining factors of two out */ if (u_lsb != k) { - if ((res = mp_div_2d(&u, u_lsb - k, &u, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&u, u_lsb - k, &u, NULL)) != MP_OKAY) { goto LBL_V; } } if (v_lsb != k) { - if ((res = mp_div_2d(&v, v_lsb - k, &v, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&v, v_lsb - k, &v, NULL)) != MP_OKAY) { goto LBL_V; } } - while (mp_iszero(&v) == MP_NO) { + while (!MP_IS_ZERO(&v)) { /* make sure v is the largest */ if (mp_cmp_mag(&u, &v) == MP_GT) { /* swap u and v to make sure v is >= u */ mp_exch(&u, &v); } /* subtract smallest from largest */ - if ((res = s_mp_sub(&v, &u, &v)) != MP_OKAY) { + if ((err = s_mp_sub(&v, &u, &v)) != MP_OKAY) { goto LBL_V; } /* Divide out all factors of two */ - if ((res = mp_div_2d(&v, mp_cnt_lsb(&v), &v, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&v, mp_cnt_lsb(&v), &v, NULL)) != MP_OKAY) { goto LBL_V; } } /* multiply by 2**k which we divided out at the beginning */ - if ((res = mp_mul_2d(&u, k, c)) != MP_OKAY) { + if ((err = mp_mul_2d(&u, k, c)) != MP_OKAY) { goto LBL_V; } c->sign = MP_ZPOS; - res = MP_OKAY; + err = MP_OKAY; LBL_V: mp_clear(&u); LBL_U: mp_clear(&v); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_get_double.c ================================================================== --- libtommath/bn_mp_get_double.c +++ libtommath/bn_mp_get_double.c @@ -1,31 +1,18 @@ #include "tommath_private.h" #ifdef BN_MP_GET_DOUBLE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ double mp_get_double(const mp_int *a) { int i; double d = 0.0, fac = 1.0; - for (i = 0; i < DIGIT_BIT; ++i) { + for (i = 0; i < MP_DIGIT_BIT; ++i) { fac *= 2.0; } for (i = a->used; i --> 0;) { d = (d * fac) + (double)a->dp[i]; } return (a->sign == MP_NEG) ? -d : d; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_get_i32.c Index: libtommath/bn_mp_get_i32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_i32.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_I32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_SIGNED(mp_get_i32, mp_get_mag_u32, int32_t, uint32_t) +#endif ADDED libtommath/bn_mp_get_i64.c Index: libtommath/bn_mp_get_i64.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_i64.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_I64_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_SIGNED(mp_get_i64, mp_get_mag_u64, int64_t, uint64_t) +#endif DELETED libtommath/bn_mp_get_int.c Index: libtommath/bn_mp_get_int.c ================================================================== --- libtommath/bn_mp_get_int.c +++ /dev/null @@ -1,25 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_GET_INT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* get the lower 32-bits of an mp_int */ -unsigned long mp_get_int(const mp_int *a) -{ - /* force result to 32-bits always so it is consistent on non 32-bit platforms */ - return mp_get_long(a) & 0xFFFFFFFFUL; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_get_l.c Index: libtommath/bn_mp_get_l.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_l.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_L_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_SIGNED(mp_get_l, mp_get_mag_ul, long, unsigned long) +#endif ADDED libtommath/bn_mp_get_ll.c Index: libtommath/bn_mp_get_ll.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_ll.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_LL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_SIGNED(mp_get_ll, mp_get_mag_ull, long long, unsigned long long) +#endif DELETED libtommath/bn_mp_get_long.c Index: libtommath/bn_mp_get_long.c ================================================================== --- libtommath/bn_mp_get_long.c +++ /dev/null @@ -1,42 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_GET_LONG_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* get the lower unsigned long of an mp_int, platform dependent */ -unsigned long mp_get_long(const mp_int *a) -{ - int i; - unsigned long res; - - if (IS_ZERO(a)) { - return 0; - } - - /* get number of digits of the lsb we have to read */ - i = MIN(a->used, (((CHAR_BIT * (int)sizeof(unsigned long)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1; - - /* get most significant digit of result */ - res = (unsigned long)a->dp[i]; - -#if (ULONG_MAX != 0xFFFFFFFFUL) || (DIGIT_BIT < 32) - while (--i >= 0) { - res = (res << DIGIT_BIT) | (unsigned long)a->dp[i]; - } -#endif - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_get_long_long.c Index: libtommath/bn_mp_get_long_long.c ================================================================== --- libtommath/bn_mp_get_long_long.c +++ /dev/null @@ -1,42 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_GET_LONG_LONG_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* get the lower unsigned long long of an mp_int, platform dependent */ -Tcl_WideUInt mp_get_long_long(const mp_int *a) -{ - int i; - Tcl_WideUInt res; - - if (IS_ZERO(a)) { - return 0; - } - - /* get number of digits of the lsb we have to read */ - i = MIN(a->used, (((CHAR_BIT * (int)sizeof(Tcl_WideUInt)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1; - - /* get most significant digit of result */ - res = (Tcl_WideUInt)a->dp[i]; - -#if DIGIT_BIT < 64 - while (--i >= 0) { - res = (res << DIGIT_BIT) | (Tcl_WideUInt)a->dp[i]; - } -#endif - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_get_mag_u32.c Index: libtommath/bn_mp_get_mag_u32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_mag_u32.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_MAG_U32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_MAG(mp_get_mag_u32, uint32_t) +#endif ADDED libtommath/bn_mp_get_mag_u64.c Index: libtommath/bn_mp_get_mag_u64.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_mag_u64.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_MAG_U64_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_MAG(mp_get_mag_u64, uint64_t) +#endif ADDED libtommath/bn_mp_get_mag_ul.c Index: libtommath/bn_mp_get_mag_ul.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_mag_ul.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_MAG_UL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_MAG(mp_get_mag_ul, unsigned long) +#endif ADDED libtommath/bn_mp_get_mag_ull.c Index: libtommath/bn_mp_get_mag_ull.c ================================================================== --- /dev/null +++ libtommath/bn_mp_get_mag_ull.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_GET_MAG_ULL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_GET_MAG(mp_get_mag_ull, unsigned long long) +#endif Index: libtommath/bn_mp_grow.c ================================================================== --- libtommath/bn_mp_grow.c +++ libtommath/bn_mp_grow.c @@ -1,39 +1,27 @@ #include "tommath_private.h" #ifdef BN_MP_GROW_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* grow as required */ -int mp_grow(mp_int *a, int size) +mp_err mp_grow(mp_int *a, int size) { int i; mp_digit *tmp; /* if the alloc size is smaller alloc more ram */ if (a->alloc < size) { - /* ensure there are always at least MP_PREC digits extra on top */ - size += (MP_PREC * 2) - (size % MP_PREC); - /* reallocate the array a->dp * * We store the return in a temporary variable * in case the operation failed we don't want * to overwrite the dp member of a. */ - tmp = (mp_digit *) XREALLOC(a->dp, - (size_t)a->alloc * sizeof (mp_digit), - (size_t)size * sizeof(mp_digit)); + tmp = (mp_digit *) MP_REALLOC(a->dp, + (size_t)a->alloc * sizeof(mp_digit), + (size_t)size * sizeof(mp_digit)); if (tmp == NULL) { /* reallocation failed but "a" is still valid [can be freed] */ return MP_MEM; } @@ -41,16 +29,10 @@ a->dp = tmp; /* zero excess digits */ i = a->alloc; a->alloc = size; - for (; i < a->alloc; i++) { - a->dp[i] = 0; - } + MP_ZERO_DIGITS(a->dp + i, a->alloc - i); } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_import.c Index: libtommath/bn_mp_import.c ================================================================== --- libtommath/bn_mp_import.c +++ /dev/null @@ -1,68 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_IMPORT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* based on gmp's mpz_import. - * see http://gmplib.org/manual/Integer-Import-and-Export.html - */ -int mp_import(mp_int *rop, size_t count, int order, size_t size, - int endian, size_t nails, const void *op) -{ - int result; - size_t odd_nails, nail_bytes, i, j; - unsigned char odd_nail_mask; - - mp_zero(rop); - - if (endian == 0) { - union { - unsigned int i; - char c[4]; - } lint; - lint.i = 0x01020304; - - endian = (lint.c[0] == '\x04') ? -1 : 1; - } - - odd_nails = (nails % 8u); - odd_nail_mask = 0xff; - for (i = 0; i < odd_nails; ++i) { - odd_nail_mask ^= (unsigned char)(1u << (7u - i)); - } - nail_bytes = nails / 8u; - - for (i = 0; i < count; ++i) { - for (j = 0; j < (size - nail_bytes); ++j) { - unsigned char byte = *((unsigned char *)op + - (((order == 1) ? i : ((count - 1u) - i)) * size) + - ((endian == 1) ? (j + nail_bytes) : (((size - 1u) - j) - nail_bytes))); - - if ((result = mp_mul_2d(rop, (j == 0u) ? (int)(8u - odd_nails) : 8, rop)) != MP_OKAY) { - return result; - } - - rop->dp[0] |= (j == 0u) ? (mp_digit)(byte & odd_nail_mask) : (mp_digit)byte; - rop->used += 1; - } - } - - mp_clamp(rop); - - return MP_OKAY; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_incr.c Index: libtommath/bn_mp_incr.c ================================================================== --- /dev/null +++ libtommath/bn_mp_incr.c @@ -0,0 +1,30 @@ +#include "tommath_private.h" +#ifdef BN_MP_INCR_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* Increment "a" by one like "a++". Changes input! */ +mp_err mp_incr(mp_int *a) +{ + if (MP_IS_ZERO(a)) { + mp_set(a,1uL); + return MP_OKAY; + } else if (a->sign == MP_NEG) { + mp_err err; + a->sign = MP_ZPOS; + if ((err = mp_decr(a)) != MP_OKAY) { + return err; + } + /* There is no -0 in LTM */ + if (!MP_IS_ZERO(a)) { + a->sign = MP_NEG; + } + return MP_OKAY; + } else if (a->dp[0] < MP_DIGIT_MAX) { + a->dp[0]++; + return MP_OKAY; + } else { + return mp_add_d(a, 1uL,a); + } +} +#endif Index: libtommath/bn_mp_init.c ================================================================== --- libtommath/bn_mp_init.c +++ libtommath/bn_mp_init.c @@ -1,43 +1,23 @@ #include "tommath_private.h" #ifdef BN_MP_INIT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* init a new mp_int */ -int mp_init(mp_int *a) +mp_err mp_init(mp_int *a) { - int i; - /* allocate memory required and clear it */ - a->dp = (mp_digit *) XMALLOC(MP_PREC * sizeof(mp_digit)); + a->dp = (mp_digit *) MP_CALLOC((size_t)MP_PREC, sizeof(mp_digit)); if (a->dp == NULL) { return MP_MEM; } - /* set the digits to zero */ - for (i = 0; i < MP_PREC; i++) { - a->dp[i] = 0; - } - /* set the used to zero, allocated digits to the default precision * and sign to positive */ a->used = 0; a->alloc = MP_PREC; a->sign = MP_ZPOS; return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_init_copy.c ================================================================== --- libtommath/bn_mp_init_copy.c +++ libtommath/bn_mp_init_copy.c @@ -1,34 +1,21 @@ #include "tommath_private.h" #ifdef BN_MP_INIT_COPY_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* creates "a" then copies b into it */ -int mp_init_copy(mp_int *a, const mp_int *b) +mp_err mp_init_copy(mp_int *a, const mp_int *b) { - int res; + mp_err err; - if ((res = mp_init_size(a, b->used)) != MP_OKAY) { - return res; + if ((err = mp_init_size(a, b->used)) != MP_OKAY) { + return err; } - if ((res = mp_copy(b, a)) != MP_OKAY) { + if ((err = mp_copy(b, a)) != MP_OKAY) { mp_clear(a); } - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_init_i32.c Index: libtommath/bn_mp_init_i32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_i32.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_I32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_i32, mp_set_i32, int32_t) +#endif ADDED libtommath/bn_mp_init_i64.c Index: libtommath/bn_mp_init_i64.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_i64.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_I64_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_i64, mp_set_i64, int64_t) +#endif ADDED libtommath/bn_mp_init_l.c Index: libtommath/bn_mp_init_l.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_l.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_L_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_l, mp_set_l, long) +#endif ADDED libtommath/bn_mp_init_ll.c Index: libtommath/bn_mp_init_ll.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_ll.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_LL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_ll, mp_set_ll, long long) +#endif Index: libtommath/bn_mp_init_multi.c ================================================================== --- libtommath/bn_mp_init_multi.c +++ libtommath/bn_mp_init_multi.c @@ -1,24 +1,15 @@ #include "tommath_private.h" #ifdef BN_MP_INIT_MULTI_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #include -int mp_init_multi(mp_int *mp, ...) +mp_err mp_init_multi(mp_int *mp, ...) { - mp_err res = MP_OKAY; /* Assume ok until proven otherwise */ + mp_err err = MP_OKAY; /* Assume ok until proven otherwise */ int n = 0; /* Number of ok inits */ mp_int *cur_arg = mp; va_list args; va_start(args, mp); /* init args to next argument from caller */ @@ -35,20 +26,16 @@ while (n-- != 0) { mp_clear(cur_arg); cur_arg = va_arg(clean_args, mp_int *); } va_end(clean_args); - res = MP_MEM; + err = MP_MEM; break; } n++; cur_arg = va_arg(args, mp_int *); } va_end(args); - return res; /* Assumed ok, if error flagged above. */ + return err; /* Assumed ok, if error flagged above. */ } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_init_set.c ================================================================== --- libtommath/bn_mp_init_set.c +++ libtommath/bn_mp_init_set.c @@ -1,29 +1,16 @@ #include "tommath_private.h" #ifdef BN_MP_INIT_SET_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* initialize and set a digit */ -int mp_init_set(mp_int *a, mp_digit b) +mp_err mp_init_set(mp_int *a, mp_digit b) { - int err; + mp_err err; if ((err = mp_init(a)) != MP_OKAY) { return err; } mp_set(a, b); return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_init_set_int.c Index: libtommath/bn_mp_init_set_int.c ================================================================== --- libtommath/bn_mp_init_set_int.c +++ /dev/null @@ -1,28 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_INIT_SET_INT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* initialize and set a digit */ -int mp_init_set_int(mp_int *a, unsigned long b) -{ - int err; - if ((err = mp_init(a)) != MP_OKAY) { - return err; - } - return mp_set_int(a, b); -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_init_size.c ================================================================== --- libtommath/bn_mp_init_size.c +++ libtommath/bn_mp_init_size.c @@ -1,45 +1,24 @@ #include "tommath_private.h" #ifdef BN_MP_INIT_SIZE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* init an mp_init for a given size */ -int mp_init_size(mp_int *a, int size) +mp_err mp_init_size(mp_int *a, int size) { - int x; - - /* pad size so there are always extra digits */ - size += (MP_PREC * 2) - (size % MP_PREC); + size = MP_MAX(MP_MIN_PREC, size); /* alloc mem */ - a->dp = (mp_digit *) XMALLOC((size_t)size * sizeof(mp_digit)); + a->dp = (mp_digit *) MP_CALLOC((size_t)size, sizeof(mp_digit)); if (a->dp == NULL) { return MP_MEM; } /* set the members */ a->used = 0; a->alloc = size; a->sign = MP_ZPOS; - /* zero the digits */ - for (x = 0; x < size; x++) { - a->dp[x] = 0; - } - return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_init_u32.c Index: libtommath/bn_mp_init_u32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_u32.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_U32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_u32, mp_set_u32, uint32_t) +#endif ADDED libtommath/bn_mp_init_u64.c Index: libtommath/bn_mp_init_u64.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_u64.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_U64_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_u64, mp_set_u64, uint64_t) +#endif ADDED libtommath/bn_mp_init_ul.c Index: libtommath/bn_mp_init_ul.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_ul.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_UL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_ul, mp_set_ul, unsigned long) +#endif ADDED libtommath/bn_mp_init_ull.c Index: libtommath/bn_mp_init_ull.c ================================================================== --- /dev/null +++ libtommath/bn_mp_init_ull.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_INIT_ULL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_INIT_INT(mp_init_ull, mp_set_ull, unsigned long long) +#endif Index: libtommath/bn_mp_invmod.c ================================================================== --- libtommath/bn_mp_invmod.c +++ libtommath/bn_mp_invmod.c @@ -1,40 +1,23 @@ #include "tommath_private.h" #ifdef BN_MP_INVMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* hac 14.61, pp608 */ -int mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) +mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) { /* b cannot be negative and has to be >1 */ if ((b->sign == MP_NEG) || (mp_cmp_d(b, 1uL) != MP_GT)) { return MP_VAL; } -#ifdef BN_FAST_MP_INVMOD_C - /* if the modulus is odd we can use a faster routine instead */ - if ((mp_isodd(b) == MP_YES)) { - return fast_mp_invmod(a, b, c); - } -#endif - -#ifdef BN_MP_INVMOD_SLOW_C - return mp_invmod_slow(a, b, c); -#else - return MP_VAL; -#endif -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ + /* if the modulus is odd we can use a faster routine instead */ + if (MP_HAS(S_MP_INVMOD_FAST) && MP_IS_ODD(b)) { + return s_mp_invmod_fast(a, b, c); + } + + return MP_HAS(S_MP_INVMOD_SLOW) + ? s_mp_invmod_slow(a, b, c) + : MP_VAL; +} +#endif DELETED libtommath/bn_mp_invmod_slow.c Index: libtommath/bn_mp_invmod_slow.c ================================================================== --- libtommath/bn_mp_invmod_slow.c +++ /dev/null @@ -1,173 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_INVMOD_SLOW_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* hac 14.61, pp608 */ -int mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) -{ - mp_int x, y, u, v, A, B, C, D; - int res; - - /* b cannot be negative */ - if ((b->sign == MP_NEG) || (mp_iszero(b) == MP_YES)) { - return MP_VAL; - } - - /* init temps */ - if ((res = mp_init_multi(&x, &y, &u, &v, - &A, &B, &C, &D, NULL)) != MP_OKAY) { - return res; - } - - /* x = a, y = b */ - if ((res = mp_mod(a, b, &x)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_copy(b, &y)) != MP_OKAY) { - goto LBL_ERR; - } - - /* 2. [modified] if x,y are both even then return an error! */ - if ((mp_iseven(&x) == MP_YES) && (mp_iseven(&y) == MP_YES)) { - res = MP_VAL; - goto LBL_ERR; - } - - /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */ - if ((res = mp_copy(&x, &u)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_copy(&y, &v)) != MP_OKAY) { - goto LBL_ERR; - } - mp_set(&A, 1uL); - mp_set(&D, 1uL); - -top: - /* 4. while u is even do */ - while (mp_iseven(&u) == MP_YES) { - /* 4.1 u = u/2 */ - if ((res = mp_div_2(&u, &u)) != MP_OKAY) { - goto LBL_ERR; - } - /* 4.2 if A or B is odd then */ - if ((mp_isodd(&A) == MP_YES) || (mp_isodd(&B) == MP_YES)) { - /* A = (A+y)/2, B = (B-x)/2 */ - if ((res = mp_add(&A, &y, &A)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&B, &x, &B)) != MP_OKAY) { - goto LBL_ERR; - } - } - /* A = A/2, B = B/2 */ - if ((res = mp_div_2(&A, &A)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_div_2(&B, &B)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* 5. while v is even do */ - while (mp_iseven(&v) == MP_YES) { - /* 5.1 v = v/2 */ - if ((res = mp_div_2(&v, &v)) != MP_OKAY) { - goto LBL_ERR; - } - /* 5.2 if C or D is odd then */ - if ((mp_isodd(&C) == MP_YES) || (mp_isodd(&D) == MP_YES)) { - /* C = (C+y)/2, D = (D-x)/2 */ - if ((res = mp_add(&C, &y, &C)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&D, &x, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - /* C = C/2, D = D/2 */ - if ((res = mp_div_2(&C, &C)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_div_2(&D, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* 6. if u >= v then */ - if (mp_cmp(&u, &v) != MP_LT) { - /* u = u - v, A = A - C, B = B - D */ - if ((res = mp_sub(&u, &v, &u)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sub(&A, &C, &A)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sub(&B, &D, &B)) != MP_OKAY) { - goto LBL_ERR; - } - } else { - /* v - v - u, C = C - A, D = D - B */ - if ((res = mp_sub(&v, &u, &v)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sub(&C, &A, &C)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sub(&D, &B, &D)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* if not zero goto step 4 */ - if (mp_iszero(&u) == MP_NO) - goto top; - - /* now a = C, b = D, gcd == g*v */ - - /* if v != 1 then there is no inverse */ - if (mp_cmp_d(&v, 1uL) != MP_EQ) { - res = MP_VAL; - goto LBL_ERR; - } - - /* if its too low */ - while (mp_cmp_d(&C, 0uL) == MP_LT) { - if ((res = mp_add(&C, b, &C)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* too big */ - while (mp_cmp_mag(&C, b) != MP_LT) { - if ((res = mp_sub(&C, b, &C)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* C is now the inverse */ - mp_exch(&C, c); - res = MP_OKAY; -LBL_ERR: - mp_clear_multi(&x, &y, &u, &v, &A, &B, &C, &D, NULL); - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_is_square.c ================================================================== --- libtommath/bn_mp_is_square.c +++ libtommath/bn_mp_is_square.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_IS_SQUARE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* Check if remainders are possible squares - fast exclude non-squares */ static const char rem_128[128] = { 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, @@ -33,13 +24,13 @@ 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1 }; /* Store non-zero to ret if arg is square, and zero if not */ -int mp_is_square(const mp_int *arg, int *ret) +mp_err mp_is_square(const mp_int *arg, mp_bool *ret) { - int res; + mp_err err; mp_digit c; mp_int t; unsigned long r; /* Default to Non-square :) */ @@ -47,37 +38,37 @@ if (arg->sign == MP_NEG) { return MP_VAL; } - if (IS_ZERO(arg)) { + if (MP_IS_ZERO(arg)) { return MP_OKAY; } - /* First check mod 128 (suppose that DIGIT_BIT is at least 7) */ + /* First check mod 128 (suppose that MP_DIGIT_BIT is at least 7) */ if (rem_128[127u & arg->dp[0]] == (char)1) { return MP_OKAY; } /* Next check mod 105 (3*5*7) */ - if ((res = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) { - return res; + if ((err = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) { + return err; } if (rem_105[c] == (char)1) { return MP_OKAY; } - if ((res = mp_init_set_int(&t, 11L*13L*17L*19L*23L*29L*31L)) != MP_OKAY) { - return res; + if ((err = mp_init_u32(&t, 11u*13u*17u*19u*23u*29u*31u)) != MP_OKAY) { + return err; } - if ((res = mp_mod(arg, &t, &t)) != MP_OKAY) { + if ((err = mp_mod(arg, &t, &t)) != MP_OKAY) { goto LBL_ERR; } - r = mp_get_int(&t); + r = mp_get_u32(&t); /* Check for other prime modules, note it's not an ERROR but we must - * free "t" so the easiest way is to goto LBL_ERR. We know that res + * free "t" so the easiest way is to goto LBL_ERR. We know that err * is already equal to MP_OKAY from the mp_mod call */ if (((1uL<<(r%11uL)) & 0x5C4uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%13uL)) & 0x9E4uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%17uL)) & 0x5CE8uL) != 0uL) goto LBL_ERR; @@ -85,22 +76,18 @@ if (((1uL<<(r%23uL)) & 0x7ACCA0uL) != 0uL) goto LBL_ERR; if (((1uL<<(r%29uL)) & 0xC2EDD0CuL) != 0uL) goto LBL_ERR; if (((1uL<<(r%31uL)) & 0x6DE2B848uL) != 0uL) goto LBL_ERR; /* Final check - is sqr(sqrt(arg)) == arg ? */ - if ((res = mp_sqrt(arg, &t)) != MP_OKAY) { + if ((err = mp_sqrt(arg, &t)) != MP_OKAY) { goto LBL_ERR; } - if ((res = mp_sqr(&t, &t)) != MP_OKAY) { + if ((err = mp_sqr(&t, &t)) != MP_OKAY) { goto LBL_ERR; } *ret = (mp_cmp_mag(&t, arg) == MP_EQ) ? MP_YES : MP_NO; LBL_ERR: mp_clear(&t); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_iseven.c Index: libtommath/bn_mp_iseven.c ================================================================== --- /dev/null +++ libtommath/bn_mp_iseven.c @@ -0,0 +1,10 @@ +#include "tommath_private.h" +#ifdef BN_MP_ISEVEN_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +mp_bool mp_iseven(const mp_int *a) +{ + return MP_IS_EVEN(a) ? MP_YES : MP_NO; +} +#endif ADDED libtommath/bn_mp_isodd.c Index: libtommath/bn_mp_isodd.c ================================================================== --- /dev/null +++ libtommath/bn_mp_isodd.c @@ -0,0 +1,10 @@ +#include "tommath_private.h" +#ifdef BN_MP_ISODD_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +mp_bool mp_isodd(const mp_int *a) +{ + return MP_IS_ODD(a) ? MP_YES : MP_NO; +} +#endif DELETED libtommath/bn_mp_jacobi.c Index: libtommath/bn_mp_jacobi.c ================================================================== --- libtommath/bn_mp_jacobi.c +++ /dev/null @@ -1,36 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_JACOBI_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* computes the jacobi c = (a | n) (or Legendre if n is prime) - * Kept for legacy reasons, please use mp_kronecker() instead - */ -int mp_jacobi(const mp_int *a, const mp_int *n, int *c) -{ - /* if a < 0 return MP_VAL */ - if (mp_isneg(a) == MP_YES) { - return MP_VAL; - } - - /* if n <= 0 return MP_VAL */ - if (mp_cmp_d(n, 0uL) != MP_GT) { - return MP_VAL; - } - - return mp_kronecker(a, n, c); -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_karatsuba_mul.c Index: libtommath/bn_mp_karatsuba_mul.c ================================================================== --- libtommath/bn_mp_karatsuba_mul.c +++ /dev/null @@ -1,171 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_KARATSUBA_MUL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* c = |a| * |b| using Karatsuba Multiplication using - * three half size multiplications - * - * Let B represent the radix [e.g. 2**DIGIT_BIT] and - * let n represent half of the number of digits in - * the min(a,b) - * - * a = a1 * B**n + a0 - * b = b1 * B**n + b0 - * - * Then, a * b => - a1b1 * B**2n + ((a1 + a0)(b1 + b0) - (a0b0 + a1b1)) * B + a0b0 - * - * Note that a1b1 and a0b0 are used twice and only need to be - * computed once. So in total three half size (half # of - * digit) multiplications are performed, a0b0, a1b1 and - * (a1+b1)(a0+b0) - * - * Note that a multiplication of half the digits requires - * 1/4th the number of single precision multiplications so in - * total after one call 25% of the single precision multiplications - * are saved. Note also that the call to mp_mul can end up back - * in this function if the a0, a1, b0, or b1 are above the threshold. - * This is known as divide-and-conquer and leads to the famous - * O(N**lg(3)) or O(N**1.584) work which is asymptopically lower than - * the standard O(N**2) that the baseline/comba methods use. - * Generally though the overhead of this method doesn't pay off - * until a certain size (N ~ 80) is reached. - */ -int mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) -{ - mp_int x0, x1, y0, y1, t1, x0y0, x1y1; - int B, err; - - /* default the return code to an error */ - err = MP_MEM; - - /* min # of digits */ - B = MIN(a->used, b->used); - - /* now divide in two */ - B = B >> 1; - - /* init copy all the temps */ - if (mp_init_size(&x0, B) != MP_OKAY) - goto LBL_ERR; - if (mp_init_size(&x1, a->used - B) != MP_OKAY) - goto X0; - if (mp_init_size(&y0, B) != MP_OKAY) - goto X1; - if (mp_init_size(&y1, b->used - B) != MP_OKAY) - goto Y0; - - /* init temps */ - if (mp_init_size(&t1, B * 2) != MP_OKAY) - goto Y1; - if (mp_init_size(&x0y0, B * 2) != MP_OKAY) - goto T1; - if (mp_init_size(&x1y1, B * 2) != MP_OKAY) - goto X0Y0; - - /* now shift the digits */ - x0.used = y0.used = B; - x1.used = a->used - B; - y1.used = b->used - B; - - { - int x; - mp_digit *tmpa, *tmpb, *tmpx, *tmpy; - - /* we copy the digits directly instead of using higher level functions - * since we also need to shift the digits - */ - tmpa = a->dp; - tmpb = b->dp; - - tmpx = x0.dp; - tmpy = y0.dp; - for (x = 0; x < B; x++) { - *tmpx++ = *tmpa++; - *tmpy++ = *tmpb++; - } - - tmpx = x1.dp; - for (x = B; x < a->used; x++) { - *tmpx++ = *tmpa++; - } - - tmpy = y1.dp; - for (x = B; x < b->used; x++) { - *tmpy++ = *tmpb++; - } - } - - /* only need to clamp the lower words since by definition the - * upper words x1/y1 must have a known number of digits - */ - mp_clamp(&x0); - mp_clamp(&y0); - - /* now calc the products x0y0 and x1y1 */ - /* after this x0 is no longer required, free temp [x0==t2]! */ - if (mp_mul(&x0, &y0, &x0y0) != MP_OKAY) - goto X1Y1; /* x0y0 = x0*y0 */ - if (mp_mul(&x1, &y1, &x1y1) != MP_OKAY) - goto X1Y1; /* x1y1 = x1*y1 */ - - /* now calc x1+x0 and y1+y0 */ - if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) - goto X1Y1; /* t1 = x1 - x0 */ - if (s_mp_add(&y1, &y0, &x0) != MP_OKAY) - goto X1Y1; /* t2 = y1 - y0 */ - if (mp_mul(&t1, &x0, &t1) != MP_OKAY) - goto X1Y1; /* t1 = (x1 + x0) * (y1 + y0) */ - - /* add x0y0 */ - if (mp_add(&x0y0, &x1y1, &x0) != MP_OKAY) - goto X1Y1; /* t2 = x0y0 + x1y1 */ - if (s_mp_sub(&t1, &x0, &t1) != MP_OKAY) - goto X1Y1; /* t1 = (x1+x0)*(y1+y0) - (x1y1 + x0y0) */ - - /* shift by B */ - if (mp_lshd(&t1, B) != MP_OKAY) - goto X1Y1; /* t1 = (x0y0 + x1y1 - (x1-x0)*(y1-y0))<used; - - /* now divide in two */ - B = B >> 1; - - /* init copy all the temps */ - if (mp_init_size(&x0, B) != MP_OKAY) - goto LBL_ERR; - if (mp_init_size(&x1, a->used - B) != MP_OKAY) - goto X0; - - /* init temps */ - if (mp_init_size(&t1, a->used * 2) != MP_OKAY) - goto X1; - if (mp_init_size(&t2, a->used * 2) != MP_OKAY) - goto T1; - if (mp_init_size(&x0x0, B * 2) != MP_OKAY) - goto T2; - if (mp_init_size(&x1x1, (a->used - B) * 2) != MP_OKAY) - goto X0X0; - - { - int x; - mp_digit *dst, *src; - - src = a->dp; - - /* now shift the digits */ - dst = x0.dp; - for (x = 0; x < B; x++) { - *dst++ = *src++; - } - - dst = x1.dp; - for (x = B; x < a->used; x++) { - *dst++ = *src++; - } - } - - x0.used = B; - x1.used = a->used - B; - - mp_clamp(&x0); - - /* now calc the products x0*x0 and x1*x1 */ - if (mp_sqr(&x0, &x0x0) != MP_OKAY) - goto X1X1; /* x0x0 = x0*x0 */ - if (mp_sqr(&x1, &x1x1) != MP_OKAY) - goto X1X1; /* x1x1 = x1*x1 */ - - /* now calc (x1+x0)**2 */ - if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) - goto X1X1; /* t1 = x1 - x0 */ - if (mp_sqr(&t1, &t1) != MP_OKAY) - goto X1X1; /* t1 = (x1 - x0) * (x1 - x0) */ - - /* add x0y0 */ - if (s_mp_add(&x0x0, &x1x1, &t2) != MP_OKAY) - goto X1X1; /* t2 = x0x0 + x1x1 */ - if (s_mp_sub(&t1, &t2, &t1) != MP_OKAY) - goto X1X1; /* t1 = (x1+x0)**2 - (x0x0 + x1x1) */ - - /* shift by B */ - if (mp_lshd(&t1, B) != MP_OKAY) - goto X1X1; /* t1 = (x0x0 + x1x1 - (x1-x0)*(x1-x0))<used == 1) && (a->dp[0] == 1u)) { *c = 1; - return e; } else { *c = 0; - return e; } + return MP_OKAY; } - if ((mp_iseven(a) != MP_NO) && (mp_iseven(p) != MP_NO)) { + if (MP_IS_EVEN(a) && MP_IS_EVEN(p)) { *c = 0; - return e; + return MP_OKAY; } - if ((e = mp_init_copy(&a1, a)) != MP_OKAY) { - return e; + if ((err = mp_init_copy(&a1, a)) != MP_OKAY) { + return err; } - if ((e = mp_init_copy(&p1, p)) != MP_OKAY) { + if ((err = mp_init_copy(&p1, p)) != MP_OKAY) { goto LBL_KRON_0; } v = mp_cnt_lsb(&p1); - if ((e = mp_div_2d(&p1, v, &p1, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&p1, v, &p1, NULL)) != MP_OKAY) { goto LBL_KRON_1; } - if ((v & 0x1) == 0) { + if ((v & 1) == 0) { k = 1; } else { k = table[a->dp[0] & 7u]; } @@ -73,16 +62,16 @@ if (a1.sign == MP_NEG) { k = -k; } } - if ((e = mp_init(&r)) != MP_OKAY) { + if ((err = mp_init(&r)) != MP_OKAY) { goto LBL_KRON_1; } for (;;) { - if (mp_iszero(&a1) != MP_NO) { + if (MP_IS_ZERO(&a1)) { if (mp_cmp_d(&p1, 1uL) == MP_EQ) { *c = k; goto LBL_KRON; } else { *c = 0; @@ -89,15 +78,15 @@ goto LBL_KRON; } } v = mp_cnt_lsb(&a1); - if ((e = mp_div_2d(&a1, v, &a1, NULL)) != MP_OKAY) { + if ((err = mp_div_2d(&a1, v, &a1, NULL)) != MP_OKAY) { goto LBL_KRON; } - if ((v & 0x1) == 1) { + if ((v & 1) == 1) { k = k * table[p1.dp[0] & 7u]; } if (a1.sign == MP_NEG) { /* @@ -113,18 +102,18 @@ if ((a1.dp[0] & p1.dp[0] & 2u) != 0u) { k = -k; } } - if ((e = mp_copy(&a1, &r)) != MP_OKAY) { + if ((err = mp_copy(&a1, &r)) != MP_OKAY) { goto LBL_KRON; } r.sign = MP_ZPOS; - if ((e = mp_mod(&p1, &r, &a1)) != MP_OKAY) { + if ((err = mp_mod(&p1, &r, &a1)) != MP_OKAY) { goto LBL_KRON; } - if ((e = mp_copy(&r, &p1)) != MP_OKAY) { + if ((err = mp_copy(&r, &p1)) != MP_OKAY) { goto LBL_KRON; } } LBL_KRON: @@ -132,13 +121,9 @@ LBL_KRON_1: mp_clear(&p1); LBL_KRON_0: mp_clear(&a1); - return e; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_lcm.c ================================================================== --- libtommath/bn_mp_lcm.c +++ libtommath/bn_mp_lcm.c @@ -1,57 +1,44 @@ #include "tommath_private.h" #ifdef BN_MP_LCM_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* computes least common multiple as |a*b|/(a, b) */ -int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) -{ - int res; +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* computes least common multiple as |a*b|/(a, b) */ +mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_err err; mp_int t1, t2; - if ((res = mp_init_multi(&t1, &t2, NULL)) != MP_OKAY) { - return res; + if ((err = mp_init_multi(&t1, &t2, NULL)) != MP_OKAY) { + return err; } /* t1 = get the GCD of the two inputs */ - if ((res = mp_gcd(a, b, &t1)) != MP_OKAY) { + if ((err = mp_gcd(a, b, &t1)) != MP_OKAY) { goto LBL_T; } /* divide the smallest by the GCD */ if (mp_cmp_mag(a, b) == MP_LT) { /* store quotient in t2 such that t2 * b is the LCM */ - if ((res = mp_div(a, &t1, &t2, NULL)) != MP_OKAY) { + if ((err = mp_div(a, &t1, &t2, NULL)) != MP_OKAY) { goto LBL_T; } - res = mp_mul(b, &t2, c); + err = mp_mul(b, &t2, c); } else { /* store quotient in t2 such that t2 * a is the LCM */ - if ((res = mp_div(b, &t1, &t2, NULL)) != MP_OKAY) { + if ((err = mp_div(b, &t1, &t2, NULL)) != MP_OKAY) { goto LBL_T; } - res = mp_mul(a, &t2, c); + err = mp_mul(a, &t2, c); } /* fix the sign to positive */ c->sign = MP_ZPOS; LBL_T: mp_clear_multi(&t1, &t2, NULL); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_log_u32.c Index: libtommath/bn_mp_log_u32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_log_u32.c @@ -0,0 +1,180 @@ +#include "tommath_private.h" +#ifdef BN_MP_LOG_U32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* Compute log_{base}(a) */ +static mp_word s_pow(mp_word base, mp_word exponent) +{ + mp_word result = 1u; + while (exponent != 0u) { + if ((exponent & 1u) == 1u) { + result *= base; + } + exponent >>= 1; + base *= base; + } + + return result; +} + +static mp_digit s_digit_ilogb(mp_digit base, mp_digit n) +{ + mp_word bracket_low = 1u, bracket_mid, bracket_high, N; + mp_digit ret, high = 1u, low = 0uL, mid; + + if (n < base) { + return 0uL; + } + if (n == base) { + return 1uL; + } + + bracket_high = (mp_word) base ; + N = (mp_word) n; + + while (bracket_high < N) { + low = high; + bracket_low = bracket_high; + high <<= 1; + bracket_high *= bracket_high; + } + + while (((mp_digit)(high - low)) > 1u) { + mid = (low + high) >> 1; + bracket_mid = bracket_low * s_pow(base, (mp_word)(mid - low)); + + if (N < bracket_mid) { + high = mid ; + bracket_high = bracket_mid ; + } + if (N > bracket_mid) { + low = mid ; + bracket_low = bracket_mid ; + } + if (N == bracket_mid) { + return (mp_digit) mid; + } + } + + if (bracket_high == N) { + ret = high; + } else { + ret = low; + } + + return ret; +} + +/* TODO: output could be "int" because the output of mp_radix_size is int, too, + as is the output of mp_bitcount. + With the same problem: max size is INT_MAX * MP_DIGIT not INT_MAX only! +*/ +mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) +{ + mp_err err; + mp_ord cmp; + uint32_t high, low, mid; + mp_int bracket_low, bracket_high, bracket_mid, t, bi_base; + + err = MP_OKAY; + + if (a->sign == MP_NEG) { + return MP_VAL; + } + + if (MP_IS_ZERO(a)) { + return MP_VAL; + } + + if (base < 2u) { + return MP_VAL; + } + + /* A small shortcut for bases that are powers of two. */ + if ((base & (base - 1u)) == 0u) { + int y, bit_count; + for (y=0; (y < 7) && ((base & 1u) == 0u); y++) { + base >>= 1; + } + bit_count = mp_count_bits(a) - 1; + *c = (uint32_t)(bit_count/y); + return MP_OKAY; + } + + if (a->used == 1) { + *c = (uint32_t)s_digit_ilogb(base, a->dp[0]); + return err; + } + + cmp = mp_cmp_d(a, base); + if ((cmp == MP_LT) || (cmp == MP_EQ)) { + *c = cmp == MP_EQ; + return err; + } + + if ((err = + mp_init_multi(&bracket_low, &bracket_high, + &bracket_mid, &t, &bi_base, NULL)) != MP_OKAY) { + return err; + } + + low = 0u; + mp_set(&bracket_low, 1uL); + high = 1u; + + mp_set(&bracket_high, base); + + /* + A kind of Giant-step/baby-step algorithm. + Idea shamelessly stolen from https://programmingpraxis.com/2010/05/07/integer-logarithms/2/ + The effect is asymptotic, hence needs benchmarks to test if the Giant-step should be skipped + for small n. + */ + while (mp_cmp(&bracket_high, a) == MP_LT) { + low = high; + if ((err = mp_copy(&bracket_high, &bracket_low)) != MP_OKAY) { + goto LBL_ERR; + } + high <<= 1; + if ((err = mp_sqr(&bracket_high, &bracket_high)) != MP_OKAY) { + goto LBL_ERR; + } + } + mp_set(&bi_base, base); + + while ((high - low) > 1u) { + mid = (high + low) >> 1; + + if ((err = mp_expt_u32(&bi_base, (uint32_t)(mid - low), &t)) != MP_OKAY) { + goto LBL_ERR; + } + if ((err = mp_mul(&bracket_low, &t, &bracket_mid)) != MP_OKAY) { + goto LBL_ERR; + } + cmp = mp_cmp(a, &bracket_mid); + if (cmp == MP_LT) { + high = mid; + mp_exch(&bracket_mid, &bracket_high); + } + if (cmp == MP_GT) { + low = mid; + mp_exch(&bracket_mid, &bracket_low); + } + if (cmp == MP_EQ) { + *c = mid; + goto LBL_END; + } + } + + *c = (mp_cmp(&bracket_high, a) == MP_EQ) ? high : low; + +LBL_END: +LBL_ERR: + mp_clear_multi(&bracket_low, &bracket_high, &bracket_mid, + &t, &bi_base, NULL); + return err; +} + + +#endif Index: libtommath/bn_mp_lshd.c ================================================================== --- libtommath/bn_mp_lshd.c +++ libtommath/bn_mp_lshd.c @@ -1,68 +1,51 @@ #include "tommath_private.h" #ifdef BN_MP_LSHD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* shift left a certain amount of digits */ -int mp_lshd(mp_int *a, int b) +mp_err mp_lshd(mp_int *a, int b) { - int x, res; + int x; + mp_err err; + mp_digit *top, *bottom; /* if its less than zero return */ if (b <= 0) { return MP_OKAY; } /* no need to shift 0 around */ - if (mp_iszero(a) == MP_YES) { + if (MP_IS_ZERO(a)) { return MP_OKAY; } /* grow to fit the new digits */ if (a->alloc < (a->used + b)) { - if ((res = mp_grow(a, a->used + b)) != MP_OKAY) { - return res; - } - } - - { - mp_digit *top, *bottom; - - /* increment the used by the shift amount then copy upwards */ - a->used += b; - - /* top */ - top = a->dp + a->used - 1; - - /* base */ - bottom = (a->dp + a->used - 1) - b; - - /* much like mp_rshd this is implemented using a sliding window - * except the window goes the otherway around. Copying from - * the bottom to the top. see bn_mp_rshd.c for more info. - */ - for (x = a->used - 1; x >= b; x--) { - *top-- = *bottom--; - } - - /* zero the lower digits */ - top = a->dp; - for (x = 0; x < b; x++) { - *top++ = 0; - } - } - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ + if ((err = mp_grow(a, a->used + b)) != MP_OKAY) { + return err; + } + } + + /* increment the used by the shift amount then copy upwards */ + a->used += b; + + /* top */ + top = a->dp + a->used - 1; + + /* base */ + bottom = (a->dp + a->used - 1) - b; + + /* much like mp_rshd this is implemented using a sliding window + * except the window goes the otherway around. Copying from + * the bottom to the top. see bn_mp_rshd.c for more info. + */ + for (x = a->used - 1; x >= b; x--) { + *top-- = *bottom--; + } + + /* zero the lower digits */ + MP_ZERO_DIGITS(a->dp, b); + + return MP_OKAY; +} +#endif Index: libtommath/bn_mp_mod.c ================================================================== --- libtommath/bn_mp_mod.c +++ libtommath/bn_mp_mod.c @@ -1,44 +1,31 @@ #include "tommath_private.h" #ifdef BN_MP_MOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* c = a mod b, 0 <= c 0, b < c <= 0 if b < 0 */ -int mp_mod(const mp_int *a, const mp_int *b, mp_int *c) -{ - mp_int t; - int res; - - if ((res = mp_init_size(&t, b->used)) != MP_OKAY) { - return res; - } - - if ((res = mp_div(a, b, NULL, &t)) != MP_OKAY) { - mp_clear(&t); - return res; - } - - if ((mp_iszero(&t) != MP_NO) || (t.sign == b->sign)) { - res = MP_OKAY; - mp_exch(&t, c); - } else { - res = mp_add(b, &t, c); - } - - mp_clear(&t); - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* c = a mod b, 0 <= c 0, b < c <= 0 if b < 0 */ +mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_int t; + mp_err err; + + if ((err = mp_init_size(&t, b->used)) != MP_OKAY) { + return err; + } + + if ((err = mp_div(a, b, NULL, &t)) != MP_OKAY) { + goto LBL_ERR; + } + + if (MP_IS_ZERO(&t) || (t.sign == b->sign)) { + err = MP_OKAY; + mp_exch(&t, c); + } else { + err = mp_add(b, &t, c); + } + +LBL_ERR: + mp_clear(&t); + return err; +} +#endif Index: libtommath/bn_mp_mod_2d.c ================================================================== --- libtommath/bn_mp_mod_2d.c +++ libtommath/bn_mp_mod_2d.c @@ -1,51 +1,38 @@ #include "tommath_private.h" #ifdef BN_MP_MOD_2D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* calc a value mod 2**b */ -int mp_mod_2d(const mp_int *a, int b, mp_int *c) +mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) { - int x, res; + int x; + mp_err err; /* if b is <= 0 then zero the int */ if (b <= 0) { mp_zero(c); return MP_OKAY; } /* if the modulus is larger than the value than return */ - if (b >= (a->used * DIGIT_BIT)) { - res = mp_copy(a, c); - return res; + if (b >= (a->used * MP_DIGIT_BIT)) { + return mp_copy(a, c); } /* copy */ - if ((res = mp_copy(a, c)) != MP_OKAY) { - return res; + if ((err = mp_copy(a, c)) != MP_OKAY) { + return err; } /* zero digits above the last digit of the modulus */ - for (x = (b / DIGIT_BIT) + (((b % DIGIT_BIT) == 0) ? 0 : 1); x < c->used; x++) { - c->dp[x] = 0; - } + x = (b / MP_DIGIT_BIT) + (((b % MP_DIGIT_BIT) == 0) ? 0 : 1); + MP_ZERO_DIGITS(c->dp + x, c->used - x); + /* clear the digit that is not completely outside/inside the modulus */ - c->dp[b / DIGIT_BIT] &= - ((mp_digit)1 << (mp_digit)(b % DIGIT_BIT)) - (mp_digit)1; + c->dp[b / MP_DIGIT_BIT] &= + ((mp_digit)1 << (mp_digit)(b % MP_DIGIT_BIT)) - (mp_digit)1; mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_mod_d.c ================================================================== --- libtommath/bn_mp_mod_d.c +++ libtommath/bn_mp_mod_d.c @@ -1,23 +1,10 @@ #include "tommath_private.h" #ifdef BN_MP_MOD_D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -int mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) { return mp_div_d(a, b, NULL, c); } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_montgomery_calc_normalization.c ================================================================== --- libtommath/bn_mp_montgomery_calc_normalization.c +++ libtommath/bn_mp_montgomery_calc_normalization.c @@ -1,56 +1,44 @@ #include "tommath_private.h" #ifdef BN_MP_MONTGOMERY_CALC_NORMALIZATION_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* * shifts with subtractions when the result is greater than b. * * The method is slightly modified to shift B unconditionally upto just under * the leading bit of b. This saves alot of multiple precision shifting. */ -int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) +mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) { - int x, bits, res; + int x, bits; + mp_err err; /* how many bits of last digit does b use */ - bits = mp_count_bits(b) % DIGIT_BIT; + bits = mp_count_bits(b) % MP_DIGIT_BIT; if (b->used > 1) { - if ((res = mp_2expt(a, ((b->used - 1) * DIGIT_BIT) + bits - 1)) != MP_OKAY) { - return res; + if ((err = mp_2expt(a, ((b->used - 1) * MP_DIGIT_BIT) + bits - 1)) != MP_OKAY) { + return err; } } else { mp_set(a, 1uL); bits = 1; } /* now compute C = A * B mod b */ - for (x = bits - 1; x < (int)DIGIT_BIT; x++) { - if ((res = mp_mul_2(a, a)) != MP_OKAY) { - return res; + for (x = bits - 1; x < (int)MP_DIGIT_BIT; x++) { + if ((err = mp_mul_2(a, a)) != MP_OKAY) { + return err; } if (mp_cmp_mag(a, b) != MP_LT) { - if ((res = s_mp_sub(a, b, a)) != MP_OKAY) { - return res; + if ((err = s_mp_sub(a, b, a)) != MP_OKAY) { + return err; } } } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_montgomery_reduce.c ================================================================== --- libtommath/bn_mp_montgomery_reduce.c +++ libtommath/bn_mp_montgomery_reduce.c @@ -1,43 +1,34 @@ #include "tommath_private.h" #ifdef BN_MP_MONTGOMERY_REDUCE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* computes xR**-1 == x (mod N) via Montgomery Reduction */ -int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) +mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) { - int ix, res, digs; + int ix, digs; + mp_err err; mp_digit mu; /* can the fast reduction [comba] method be used? * * Note that unlike in mul you're safely allowed *less* * than the available columns [255 per default] since carries * are fixed up in the inner loop. */ digs = (n->used * 2) + 1; - if ((digs < (int)MP_WARRAY) && - (x->used <= (int)MP_WARRAY) && - (n->used < - (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) { - return fast_mp_montgomery_reduce(x, n, rho); + if ((digs < MP_WARRAY) && + (x->used <= MP_WARRAY) && + (n->used < MP_MAXFAST)) { + return s_mp_montgomery_reduce_fast(x, n, rho); } /* grow the input as required */ if (x->alloc < digs) { - if ((res = mp_grow(x, digs)) != MP_OKAY) { - return res; + if ((err = mp_grow(x, digs)) != MP_OKAY) { + return err; } } x->used = digs; for (ix = 0; ix < n->used; ix++) { @@ -71,11 +62,11 @@ /* compute product and sum */ r = ((mp_word)mu * (mp_word)*tmpn++) + (mp_word)u + (mp_word)*tmpx; /* get carry */ - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); /* fix digit */ *tmpx++ = (mp_digit)(r & (mp_word)MP_MASK); } /* At this point the ix'th digit of x should be zero */ @@ -82,11 +73,11 @@ /* propagate carries upwards as required*/ while (u != 0u) { *tmpx += u; - u = *tmpx >> DIGIT_BIT; + u = *tmpx >> MP_DIGIT_BIT; *tmpx++ &= MP_MASK; } } } @@ -107,9 +98,5 @@ } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_montgomery_setup.c ================================================================== --- libtommath/bn_mp_montgomery_setup.c +++ libtommath/bn_mp_montgomery_setup.c @@ -1,21 +1,12 @@ #include "tommath_private.h" #ifdef BN_MP_MONTGOMERY_SETUP_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* setups the montgomery reduction stuff */ -int mp_montgomery_setup(const mp_int *n, mp_digit *rho) +mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) { mp_digit x, b; /* fast inversion mod 2**k * @@ -42,14 +33,10 @@ #ifdef MP_64BIT x *= 2u - (b * x); /* here x*a==1 mod 2**64 */ #endif /* rho = -1/m mod b */ - *rho = (mp_digit)(((mp_word)1 << (mp_word)DIGIT_BIT) - x) & MP_MASK; + *rho = (mp_digit)(((mp_word)1 << (mp_word)MP_DIGIT_BIT) - x) & MP_MASK; return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_mul.c ================================================================== --- libtommath/bn_mp_mul.c +++ libtommath/bn_mp_mul.c @@ -1,64 +1,54 @@ #include "tommath_private.h" #ifdef BN_MP_MUL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* high level multiplication (handles sign) */ -int mp_mul(const mp_int *a, const mp_int *b, mp_int *c) -{ - int res, neg; - neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; - - /* use Toom-Cook? */ -#ifdef BN_MP_TOOM_MUL_C - if (MIN(a->used, b->used) >= TOOM_MUL_CUTOFF) { - res = mp_toom_mul(a, b, c); - } else -#endif -#ifdef BN_MP_KARATSUBA_MUL_C - /* use Karatsuba? */ - if (MIN(a->used, b->used) >= KARATSUBA_MUL_CUTOFF) { - res = mp_karatsuba_mul(a, b, c); - } else -#endif - { - /* can we use the fast multiplier? - * - * The fast multiplier can be used if the output will - * have less than MP_WARRAY digits and the number of - * digits won't affect carry propagation - */ - int digs = a->used + b->used + 1; - -#ifdef BN_FAST_S_MP_MUL_DIGS_C - if ((digs < (int)MP_WARRAY) && - (MIN(a->used, b->used) <= - (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) { - res = fast_s_mp_mul_digs(a, b, c, digs); - } else -#endif - { -#ifdef BN_S_MP_MUL_DIGS_C - res = s_mp_mul(a, b, c); /* uses s_mp_mul_digs */ -#else - res = MP_VAL; -#endif - } - } - c->sign = (c->used > 0) ? neg : MP_ZPOS; - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ +mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_err err; + int min_len = MP_MIN(a->used, b->used), + max_len = MP_MAX(a->used, b->used), + digs = a->used + b->used + 1; + mp_sign neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; + + if (a == b) { + return mp_sqr(a,c); + } else if (MP_HAS(S_MP_BALANCE_MUL) && + /* Check sizes. The smaller one needs to be larger than the Karatsuba cut-off. + * The bigger one needs to be at least about one MP_KARATSUBA_MUL_CUTOFF bigger + * to make some sense, but it depends on architecture, OS, position of the + * stars... so YMMV. + * Using it to cut the input into slices small enough for fast_s_mp_mul_digs + * was actually slower on the author's machine, but YMMV. + */ + (min_len >= MP_KARATSUBA_MUL_CUTOFF) && + ((max_len / 2) >= MP_KARATSUBA_MUL_CUTOFF) && + /* Not much effect was observed below a ratio of 1:2, but again: YMMV. */ + (max_len >= (2 * min_len))) { + err = s_mp_balance_mul(a,b,c); + } else if (MP_HAS(S_MP_TOOM_MUL) && + (min_len >= MP_TOOM_MUL_CUTOFF)) { + err = s_mp_toom_mul(a, b, c); + } else if (MP_HAS(S_MP_KARATSUBA_MUL) && + (min_len >= MP_KARATSUBA_MUL_CUTOFF)) { + err = s_mp_karatsuba_mul(a, b, c); + } else if (MP_HAS(S_MP_MUL_DIGS_FAST) && + /* can we use the fast multiplier? + * + * The fast multiplier can be used if the output will + * have less than MP_WARRAY digits and the number of + * digits won't affect carry propagation + */ + (digs < MP_WARRAY) && + (min_len <= MP_MAXFAST)) { + err = s_mp_mul_digs_fast(a, b, c, digs); + } else if (MP_HAS(S_MP_MUL_DIGS)) { + err = s_mp_mul_digs(a, b, c, digs); + } else { + err = MP_VAL; + } + c->sign = (c->used > 0) ? neg : MP_ZPOS; + return err; +} +#endif Index: libtommath/bn_mp_mul_2.c ================================================================== --- libtommath/bn_mp_mul_2.c +++ libtommath/bn_mp_mul_2.c @@ -1,28 +1,20 @@ #include "tommath_private.h" #ifdef BN_MP_MUL_2_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* b = a*2 */ -int mp_mul_2(const mp_int *a, mp_int *b) +mp_err mp_mul_2(const mp_int *a, mp_int *b) { - int x, res, oldused; + int x, oldused; + mp_err err; /* grow to accomodate result */ if (b->alloc < (a->used + 1)) { - if ((res = mp_grow(b, a->used + 1)) != MP_OKAY) { - return res; + if ((err = mp_grow(b, a->used + 1)) != MP_OKAY) { + return err; } } oldused = b->used; b->used = a->used; @@ -41,11 +33,11 @@ for (x = 0; x < a->used; x++) { /* get what will be the *next* carry bit from the * MSB of the current digit */ - rr = *tmpa >> (mp_digit)(DIGIT_BIT - 1); + rr = *tmpa >> (mp_digit)(MP_DIGIT_BIT - 1); /* now shift up this digit, add in the carry [from the previous] */ *tmpb++ = ((*tmpa++ << 1uL) | r) & MP_MASK; /* copy the carry that would be from the source @@ -62,18 +54,11 @@ } /* now zero any excess digits on the destination * that we didn't write to */ - tmpb = b->dp + b->used; - for (x = b->used; x < oldused; x++) { - *tmpb++ = 0; - } + MP_ZERO_DIGITS(b->dp + b->used, oldused - b->used); } b->sign = a->sign; return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_mul_2d.c ================================================================== --- libtommath/bn_mp_mul_2d.c +++ libtommath/bn_mp_mul_2d.c @@ -1,56 +1,47 @@ #include "tommath_private.h" #ifdef BN_MP_MUL_2D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* shift left by a certain bit count */ -int mp_mul_2d(const mp_int *a, int b, mp_int *c) +mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) { mp_digit d; - int res; + mp_err err; /* copy */ if (a != c) { - if ((res = mp_copy(a, c)) != MP_OKAY) { - return res; + if ((err = mp_copy(a, c)) != MP_OKAY) { + return err; } } - if (c->alloc < (c->used + (b / DIGIT_BIT) + 1)) { - if ((res = mp_grow(c, c->used + (b / DIGIT_BIT) + 1)) != MP_OKAY) { - return res; + if (c->alloc < (c->used + (b / MP_DIGIT_BIT) + 1)) { + if ((err = mp_grow(c, c->used + (b / MP_DIGIT_BIT) + 1)) != MP_OKAY) { + return err; } } /* shift by as many digits in the bit count */ - if (b >= DIGIT_BIT) { - if ((res = mp_lshd(c, b / DIGIT_BIT)) != MP_OKAY) { - return res; + if (b >= MP_DIGIT_BIT) { + if ((err = mp_lshd(c, b / MP_DIGIT_BIT)) != MP_OKAY) { + return err; } } - /* shift any bit count < DIGIT_BIT */ - d = (mp_digit)(b % DIGIT_BIT); + /* shift any bit count < MP_DIGIT_BIT */ + d = (mp_digit)(b % MP_DIGIT_BIT); if (d != 0u) { mp_digit *tmpc, shift, mask, r, rr; int x; /* bitmask for carries */ mask = ((mp_digit)1 << d) - (mp_digit)1; /* shift for msbs */ - shift = (mp_digit)DIGIT_BIT - d; + shift = (mp_digit)MP_DIGIT_BIT - d; /* alias */ tmpc = c->dp; /* carry */ @@ -74,9 +65,5 @@ } mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_mul_d.c ================================================================== --- libtommath/bn_mp_mul_d.c +++ libtommath/bn_mp_mul_d.c @@ -1,30 +1,22 @@ #include "tommath_private.h" #ifdef BN_MP_MUL_D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* multiply by a digit */ -int mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) +mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) { mp_digit u, *tmpa, *tmpc; mp_word r; - int ix, res, olduse; + mp_err err; + int ix, olduse; /* make sure c is big enough to hold a*b */ if (c->alloc < (a->used + 1)) { - if ((res = mp_grow(c, a->used + 1)) != MP_OKAY) { - return res; + if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) { + return err; } } /* get the original destinations used count */ olduse = c->used; @@ -48,28 +40,22 @@ /* mask off higher bits to get a single digit */ *tmpc++ = (mp_digit)(r & (mp_word)MP_MASK); /* send carry into next iteration */ - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } /* store final carry [if any] and increment ix offset */ *tmpc++ = u; ++ix; /* now zero digits above the top */ - while (ix++ < olduse) { - *tmpc++ = 0; - } + MP_ZERO_DIGITS(tmpc, olduse - ix); /* set used count */ c->used = a->used + 1; mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_mulmod.c ================================================================== --- libtommath/bn_mp_mulmod.c +++ libtommath/bn_mp_mulmod.c @@ -1,37 +1,25 @@ #include "tommath_private.h" #ifdef BN_MP_MULMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* d = a * b (mod c) */ -int mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) -{ - int res; - mp_int t; - - if ((res = mp_init_size(&t, c->used)) != MP_OKAY) { - return res; - } - - if ((res = mp_mul(a, b, &t)) != MP_OKAY) { - mp_clear(&t); - return res; - } - res = mp_mod(&t, c, d); - mp_clear(&t); - return res; +mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) +{ + mp_err err; + mp_int t; + + if ((err = mp_init_size(&t, c->used)) != MP_OKAY) { + return err; + } + + if ((err = mp_mul(a, b, &t)) != MP_OKAY) { + goto LBL_ERR; + } + err = mp_mod(&t, c, d); + +LBL_ERR: + mp_clear(&t); + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_n_root.c Index: libtommath/bn_mp_n_root.c ================================================================== --- libtommath/bn_mp_n_root.c +++ /dev/null @@ -1,27 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_N_ROOT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* wrapper function for mp_n_root_ex() - * computes c = (a)**(1/b) such that (c)**b <= a and (c+1)**b > a - */ -int mp_n_root(const mp_int *a, mp_digit b, mp_int *c) -{ - return mp_n_root_ex(a, b, c, 0); -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_n_root_ex.c Index: libtommath/bn_mp_n_root_ex.c ================================================================== --- libtommath/bn_mp_n_root_ex.c +++ /dev/null @@ -1,129 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_N_ROOT_EX_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* find the n'th root of an integer - * - * Result found such that (c)**b <= a and (c+1)**b > a - * - * This algorithm uses Newton's approximation - * x[i+1] = x[i] - f(x[i])/f'(x[i]) - * which will find the root in log(N) time where - * each step involves a fair bit. This is not meant to - * find huge roots [square and cube, etc]. - */ -int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) -{ - mp_int t1, t2, t3, a_; - int res; - - /* input must be positive if b is even */ - if (((b & 1u) == 0u) && (a->sign == MP_NEG)) { - return MP_VAL; - } - - if ((res = mp_init(&t1)) != MP_OKAY) { - return res; - } - - if ((res = mp_init(&t2)) != MP_OKAY) { - goto LBL_T1; - } - - if ((res = mp_init(&t3)) != MP_OKAY) { - goto LBL_T2; - } - - /* if a is negative fudge the sign but keep track */ - a_ = *a; - a_.sign = MP_ZPOS; - - /* t2 = 2 */ - mp_set(&t2, 2uL); - - do { - /* t1 = t2 */ - if ((res = mp_copy(&t2, &t1)) != MP_OKAY) { - goto LBL_T3; - } - - /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */ - - /* t3 = t1**(b-1) */ - if ((res = mp_expt_d_ex(&t1, b - 1u, &t3, fast)) != MP_OKAY) { - goto LBL_T3; - } - - /* numerator */ - /* t2 = t1**b */ - if ((res = mp_mul(&t3, &t1, &t2)) != MP_OKAY) { - goto LBL_T3; - } - - /* t2 = t1**b - a */ - if ((res = mp_sub(&t2, &a_, &t2)) != MP_OKAY) { - goto LBL_T3; - } - - /* denominator */ - /* t3 = t1**(b-1) * b */ - if ((res = mp_mul_d(&t3, b, &t3)) != MP_OKAY) { - goto LBL_T3; - } - - /* t3 = (t1**b - a)/(b * t1**(b-1)) */ - if ((res = mp_div(&t2, &t3, &t3, NULL)) != MP_OKAY) { - goto LBL_T3; - } - - if ((res = mp_sub(&t1, &t3, &t2)) != MP_OKAY) { - goto LBL_T3; - } - } while (mp_cmp(&t1, &t2) != MP_EQ); - - /* result can be off by a few so check */ - for (;;) { - if ((res = mp_expt_d_ex(&t1, b, &t2, fast)) != MP_OKAY) { - goto LBL_T3; - } - - if (mp_cmp(&t2, &a_) == MP_GT) { - if ((res = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) { - goto LBL_T3; - } - } else { - break; - } - } - - /* set the result */ - mp_exch(&t1, c); - - /* set the sign of the result */ - c->sign = a->sign; - - res = MP_OKAY; - -LBL_T3: - mp_clear(&t3); -LBL_T2: - mp_clear(&t2); -LBL_T1: - mp_clear(&t1); - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_neg.c ================================================================== --- libtommath/bn_mp_neg.c +++ libtommath/bn_mp_neg.c @@ -1,37 +1,24 @@ #include "tommath_private.h" #ifdef BN_MP_NEG_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* b = -a */ -int mp_neg(const mp_int *a, mp_int *b) -{ - int res; - if (a != b) { - if ((res = mp_copy(a, b)) != MP_OKAY) { - return res; - } - } - - if (mp_iszero(b) != MP_YES) { +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* b = -a */ +mp_err mp_neg(const mp_int *a, mp_int *b) +{ + mp_err err; + if (a != b) { + if ((err = mp_copy(a, b)) != MP_OKAY) { + return err; + } + } + + if (!MP_IS_ZERO(b)) { b->sign = (a->sign == MP_ZPOS) ? MP_NEG : MP_ZPOS; } else { b->sign = MP_ZPOS; } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_or.c ================================================================== --- libtommath/bn_mp_or.c +++ libtommath/bn_mp_or.c @@ -4,11 +4,11 @@ /* SPDX-License-Identifier: Unlicense */ /* two complement or */ mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) { - int used = MAX(a->used, b->used) + 1, i; + int used = MP_MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = ((a->sign == MP_NEG) || (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { ADDED libtommath/bn_mp_pack.c Index: libtommath/bn_mp_pack.c ================================================================== --- /dev/null +++ libtommath/bn_mp_pack.c @@ -0,0 +1,69 @@ +#include "tommath_private.h" +#ifdef BN_MP_PACK_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* based on gmp's mpz_export. + * see http://gmplib.org/manual/Integer-Import-and-Export.html + */ +mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, + mp_endian endian, size_t nails, const mp_int *op) +{ + mp_err err; + size_t odd_nails, nail_bytes, i, j, count; + unsigned char odd_nail_mask; + + mp_int t; + + count = mp_pack_count(op, nails, size); + + if (count > maxcount) { + return MP_BUF; + } + + if ((err = mp_init_copy(&t, op)) != MP_OKAY) { + return err; + } + + if (endian == MP_NATIVE_ENDIAN) { + MP_GET_ENDIANNESS(endian); + } + + odd_nails = (nails % 8u); + odd_nail_mask = 0xff; + for (i = 0u; i < odd_nails; ++i) { + odd_nail_mask ^= (unsigned char)(1u << (7u - i)); + } + nail_bytes = nails / 8u; + + for (i = 0u; i < count; ++i) { + for (j = 0u; j < size; ++j) { + unsigned char *byte = (unsigned char *)rop + + (((order == MP_LSB_FIRST) ? i : ((count - 1u) - i)) * size) + + ((endian == MP_LITTLE_ENDIAN) ? j : ((size - 1u) - j)); + + if (j >= (size - nail_bytes)) { + *byte = 0; + continue; + } + + *byte = (unsigned char)((j == ((size - nail_bytes) - 1u)) ? (t.dp[0] & odd_nail_mask) : (t.dp[0] & 0xFFuL)); + + if ((err = mp_div_2d(&t, (j == ((size - nail_bytes) - 1u)) ? (int)(8u - odd_nails) : 8, &t, NULL)) != MP_OKAY) { + goto LBL_ERR; + } + + } + } + + if (written != NULL) { + *written = count; + } + err = MP_OKAY; + +LBL_ERR: + mp_clear(&t); + return err; +} + +#endif ADDED libtommath/bn_mp_pack_count.c Index: libtommath/bn_mp_pack_count.c ================================================================== --- /dev/null +++ libtommath/bn_mp_pack_count.c @@ -0,0 +1,12 @@ +#include "tommath_private.h" +#ifdef BN_MP_PACK_COUNT_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) +{ + size_t bits = (size_t)mp_count_bits(a); + return ((bits / ((size * 8u) - nails)) + (((bits % ((size * 8u) - nails)) != 0u) ? 1u : 0u)); +} + +#endif Index: libtommath/bn_mp_prime_fermat.c ================================================================== --- libtommath/bn_mp_prime_fermat.c +++ libtommath/bn_mp_prime_fermat.c @@ -1,31 +1,22 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_FERMAT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* performs one Fermat test. * * If "a" were prime then b**a == b (mod a) since the order of * the multiplicative sub-group would be phi(a) = a-1. That means * it would be the same as b**(a mod (a-1)) == b**1 == b (mod a). * * Sets result to 1 if the congruence holds, or zero otherwise. */ -int mp_prime_fermat(const mp_int *a, const mp_int *b, int *result) +mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) { mp_int t; - int err; + mp_err err; /* default to composite */ *result = MP_NO; /* ensure b > 1 */ @@ -52,9 +43,5 @@ LBL_T: mp_clear(&t); return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_prime_frobenius_underwood.c ================================================================== --- libtommath/bn_mp_prime_frobenius_underwood.c +++ libtommath/bn_mp_prime_frobenius_underwood.c @@ -1,24 +1,15 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_FROBENIUS_UNDERWOOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* * See file bn_mp_prime_is_prime.c or the documentation in doc/bn.tex for the details */ -#ifndef LTM_USE_FIPS_ONLY +#ifndef LTM_USE_ONLY_MR #ifdef MP_8BIT /* * floor of positive solution of * (2^16)-1 = (a+4)*(2*a+5) @@ -30,45 +21,37 @@ */ #define LTM_FROBENIUS_UNDERWOOD_A 177 #else #define LTM_FROBENIUS_UNDERWOOD_A 32764 #endif -int mp_prime_frobenius_underwood(const mp_int *N, int *result) +mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) { mp_int T1z, T2z, Np1z, sz, tz; - int a, ap2, length, i, j, isset; - int e; + int a, ap2, length, i, j; + mp_err err; *result = MP_NO; - if ((e = mp_init_multi(&T1z, &T2z, &Np1z, &sz, &tz, NULL)) != MP_OKAY) { - return e; + if ((err = mp_init_multi(&T1z, &T2z, &Np1z, &sz, &tz, NULL)) != MP_OKAY) { + return err; } for (a = 0; a < LTM_FROBENIUS_UNDERWOOD_A; a++) { /* TODO: That's ugly! No, really, it is! */ if ((a==2) || (a==4) || (a==7) || (a==8) || (a==10) || (a==14) || (a==18) || (a==23) || (a==26) || (a==28)) { continue; } /* (32764^2 - 4) < 2^31, no bigint for >MP_8BIT needed) */ - if ((e = mp_set_long(&T1z, (unsigned long)a)) != MP_OKAY) { - goto LBL_FU_ERR; - } - - if ((e = mp_sqr(&T1z, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - - if ((e = mp_sub_d(&T1z, 4uL, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - - if ((e = mp_kronecker(&T1z, N, &j)) != MP_OKAY) { - goto LBL_FU_ERR; - } + mp_set_u32(&T1z, (uint32_t)a); + + if ((err = mp_sqr(&T1z, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + + if ((err = mp_sub_d(&T1z, 4uL, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + + if ((err = mp_kronecker(&T1z, N, &j)) != MP_OKAY) goto LBL_FU_ERR; if (j == -1) { break; } @@ -77,30 +60,22 @@ goto LBL_FU_ERR; } } /* Tell it a composite and set return value accordingly */ if (a >= LTM_FROBENIUS_UNDERWOOD_A) { - e = MP_ITER; + err = MP_ITER; goto LBL_FU_ERR; } /* Composite if N and (a+4)*(2*a+5) are not coprime */ - if ((e = mp_set_long(&T1z, (unsigned long)((a+4)*((2*a)+5)))) != MP_OKAY) { - goto LBL_FU_ERR; - } - - if ((e = mp_gcd(N, &T1z, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - - if (!((T1z.used == 1) && (T1z.dp[0] == 1u))) { - goto LBL_FU_ERR; - } + mp_set_u32(&T1z, (uint32_t)((a+4)*((2*a)+5))); + + if ((err = mp_gcd(N, &T1z, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + + if (!((T1z.used == 1) && (T1z.dp[0] == 1u))) goto LBL_FU_ERR; ap2 = a + 2; - if ((e = mp_add_d(N, 1uL, &Np1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } + if ((err = mp_add_d(N, 1uL, &Np1z)) != MP_OKAY) goto LBL_FU_ERR; mp_set(&sz, 1uL); mp_set(&tz, 2uL); length = mp_count_bits(&Np1z); @@ -108,91 +83,50 @@ /* * temp = (sz*(a*sz+2*tz))%N; * tz = ((tz-sz)*(tz+sz))%N; * sz = temp; */ - if ((e = mp_mul_2(&tz, &T2z)) != MP_OKAY) { - goto LBL_FU_ERR; - } + if ((err = mp_mul_2(&tz, &T2z)) != MP_OKAY) goto LBL_FU_ERR; /* a = 0 at about 50% of the cases (non-square and odd input) */ if (a != 0) { - if ((e = mp_mul_d(&sz, (mp_digit)a, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_add(&T1z, &T2z, &T2z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - } - - if ((e = mp_mul(&T2z, &sz, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_sub(&tz, &sz, &T2z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_add(&sz, &tz, &sz)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_mul(&sz, &T2z, &tz)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_mod(&tz, N, &tz)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_mod(&T1z, N, &sz)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((isset = mp_get_bit(&Np1z, i)) == MP_VAL) { - e = isset; - goto LBL_FU_ERR; - } - if (isset == MP_YES) { + if ((err = mp_mul_d(&sz, (mp_digit)a, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_add(&T1z, &T2z, &T2z)) != MP_OKAY) goto LBL_FU_ERR; + } + + if ((err = mp_mul(&T2z, &sz, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_sub(&tz, &sz, &T2z)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_add(&sz, &tz, &sz)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_mul(&sz, &T2z, &tz)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_mod(&tz, N, &tz)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_mod(&T1z, N, &sz)) != MP_OKAY) goto LBL_FU_ERR; + if (s_mp_get_bit(&Np1z, (unsigned int)i) == MP_YES) { /* * temp = (a+2) * sz + tz * tz = 2 * tz - sz * sz = temp */ if (a == 0) { - if ((e = mp_mul_2(&sz, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - } else { - if ((e = mp_mul_d(&sz, (mp_digit)ap2, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - } - if ((e = mp_add(&T1z, &tz, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_mul_2(&tz, &T2z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_sub(&T2z, &sz, &tz)) != MP_OKAY) { - goto LBL_FU_ERR; - } + if ((err = mp_mul_2(&sz, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + } else { + if ((err = mp_mul_d(&sz, (mp_digit)ap2, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + } + if ((err = mp_add(&T1z, &tz, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_mul_2(&tz, &T2z)) != MP_OKAY) goto LBL_FU_ERR; + if ((err = mp_sub(&T2z, &sz, &tz)) != MP_OKAY) goto LBL_FU_ERR; mp_exch(&sz, &T1z); } } - if ((e = mp_set_long(&T1z, (unsigned long)((2 * a) + 5))) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((e = mp_mod(&T1z, N, &T1z)) != MP_OKAY) { - goto LBL_FU_ERR; - } - if ((mp_iszero(&sz) != MP_NO) && (mp_cmp(&tz, &T1z) == MP_EQ)) { + mp_set_u32(&T1z, (uint32_t)((2 * a) + 5)); + if ((err = mp_mod(&T1z, N, &T1z)) != MP_OKAY) goto LBL_FU_ERR; + if (MP_IS_ZERO(&sz) && (mp_cmp(&tz, &T1z) == MP_EQ)) { *result = MP_YES; - goto LBL_FU_ERR; } LBL_FU_ERR: mp_clear_multi(&tz, &sz, &Np1z, &T2z, &T1z, NULL); - return e; + return err; } #endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_prime_is_divisible.c Index: libtommath/bn_mp_prime_is_divisible.c ================================================================== --- libtommath/bn_mp_prime_is_divisible.c +++ /dev/null @@ -1,47 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_PRIME_IS_DIVISIBLE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* determines if an integers is divisible by one - * of the first PRIME_SIZE primes or not - * - * sets result to 0 if not, 1 if yes - */ -int mp_prime_is_divisible(const mp_int *a, int *result) -{ - int err, ix; - mp_digit res; - - /* default to not */ - *result = MP_NO; - - for (ix = 0; ix < PRIME_SIZE; ix++) { - /* what is a mod LBL_prime_tab[ix] */ - if ((err = mp_mod_d(a, ltm_prime_tab[ix], &res)) != MP_OKAY) { - return err; - } - - /* is the residue zero? */ - if (res == 0u) { - *result = MP_YES; - return MP_OKAY; - } - } - - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_prime_is_prime.c ================================================================== --- libtommath/bn_mp_prime_is_prime.c +++ libtommath/bn_mp_prime_is_prime.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_IS_PRIME_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* portable integer log of two with small footprint */ static unsigned int s_floor_ilog2(int value) { unsigned int r = 0; @@ -21,65 +12,62 @@ } return r; } -int mp_prime_is_prime(const mp_int *a, int t, int *result) +mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) { mp_int b; - int ix, err, res, p_max = 0, size_a, len; + int ix, p_max = 0, size_a, len; + mp_bool res; + mp_err err; unsigned int fips_rand, mask; /* default to no */ *result = MP_NO; - /* valid value of t? */ - if (t > PRIME_SIZE) { - return MP_VAL; - } - /* Some shortcuts */ /* N > 3 */ if (a->used == 1) { if ((a->dp[0] == 0u) || (a->dp[0] == 1u)) { - *result = 0; + *result = MP_NO; return MP_OKAY; } if (a->dp[0] == 2u) { - *result = 1; + *result = MP_YES; return MP_OKAY; } } /* N must be odd */ - if (mp_iseven(a) == MP_YES) { + if (MP_IS_EVEN(a)) { return MP_OKAY; } /* N is not a perfect square: floor(sqrt(N))^2 != N */ if ((err = mp_is_square(a, &res)) != MP_OKAY) { return err; } - if (res != 0) { + if (res != MP_NO) { return MP_OKAY; } /* is the input equal to one of the primes in the table? */ - for (ix = 0; ix < PRIME_SIZE; ix++) { - if (mp_cmp_d(a, ltm_prime_tab[ix]) == MP_EQ) { + for (ix = 0; ix < PRIVATE_MP_PRIME_TAB_SIZE; ix++) { + if (mp_cmp_d(a, s_mp_prime_tab[ix]) == MP_EQ) { *result = MP_YES; return MP_OKAY; } } #ifdef MP_8BIT /* The search in the loop above was exhaustive in this case */ - if ((a->used == 1) && (PRIME_SIZE >= 31)) { + if ((a->used == 1) && (PRIVATE_MP_PRIME_TAB_SIZE >= 31)) { return MP_OKAY; } #endif /* first perform trial division */ - if ((err = mp_prime_is_divisible(a, &res)) != MP_OKAY) { + if ((err = s_mp_prime_is_divisible(a, &res)) != MP_OKAY) { return err; } /* return if it was trivially divisible */ if (res == MP_YES) { @@ -112,14 +100,14 @@ goto LBL_B; } /* * Both, the Frobenius-Underwood test and the the Lucas-Selfridge test are quite - * slow so if speed is an issue, define LTM_USE_FIPS_ONLY to use M-R tests with + * slow so if speed is an issue, define LTM_USE_ONLY_MR to use M-R tests with * bases 2, 3 and t random bases. */ -#ifndef LTM_USE_FIPS_ONLY +#ifndef LTM_USE_ONLY_MR if (t >= 0) { /* * Use a Frobenius-Underwood test instead of the Lucas-Selfridge test for * MP_8BIT (It is unknown if the Lucas-Selfridge test works with 16-bit * integers but the necesssary analysis is on the todo-list). @@ -147,48 +135,18 @@ if (t == 0) { t = 1; } /* - abs(t) extra rounds of M-R to extend the range of primes it can find if t < 0. Only recommended if the input range is known to be < 3317044064679887385961981 - It uses the bases for a deterministic M-R test if input < 3317044064679887385961981 + It uses the bases necessary for a deterministic M-R test if the input is + smaller than 3317044064679887385961981 The caller has to check the size. - - Not for cryptographic use because with known bases strong M-R pseudoprimes can - be constructed. Use at least one M-R test with a random base (t >= 1). - - The 1119 bit large number - - 80383745745363949125707961434194210813883768828755814583748891752229742737653\ - 33652186502336163960045457915042023603208766569966760987284043965408232928738\ - 79185086916685732826776177102938969773947016708230428687109997439976544144845\ - 34115587245063340927902227529622941498423068816854043264575340183297861112989\ - 60644845216191652872597534901 - - has been constructed by F. Arnault (F. Arnault, "Rabin-Miller primality test: - composite numbers which pass it.", Mathematics of Computation, 1995, 64. Jg., - Nr. 209, S. 355-361), is a semiprime with the two factors - - 40095821663949960541830645208454685300518816604113250877450620473800321707011\ - 96242716223191597219733582163165085358166969145233813917169287527980445796800\ - 452592031836601 - - 20047910831974980270915322604227342650259408302056625438725310236900160853505\ - 98121358111595798609866791081582542679083484572616906958584643763990222898400\ - 226296015918301 - - and it is a strong pseudoprime to all forty-six prime M-R bases up to 200 - - It does not fail the strong Bailley-PSP test as implemented here, it is just - given as an example, if not the reason to use the BPSW-test instead of M-R-tests - with a sequence of primes 2...n. - + TODO: can be made a bit finer grained but comparing is not free. */ if (t < 0) { - t = -t; /* Sorenson, Jonathan; Webster, Jonathan (2015). "Strong Pseudoprimes to Twelve Prime Bases". */ /* 0x437ae92817f9fc85b7e5 = 318665857834031151167461 */ @@ -210,22 +168,13 @@ err = MP_VAL; goto LBL_B; } } - /* for compatibility with the current API (well, compatible within a sign's width) */ - if (p_max < t) { - p_max = t; - } - - if (p_max > PRIME_SIZE) { - err = MP_VAL; - goto LBL_B; - } /* we did bases 2 and 3 already, skip them */ for (ix = 2; ix < p_max; ix++) { - mp_set(&b, ltm_prime_tab[ix]); + mp_set(&b, s_mp_prime_tab[ix]); if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) { goto LBL_B; } if (res == MP_NO) { goto LBL_B; @@ -294,23 +243,23 @@ #ifdef MP_8BIT /* * One 8-bit digit is too small, so concatenate two if the size of * unsigned int allows for it. */ - if (((sizeof(unsigned int) * CHAR_BIT)/2) >= (sizeof(mp_digit) * CHAR_BIT)) { + if ((MP_SIZEOF_BITS(unsigned int)/2) >= MP_SIZEOF_BITS(mp_digit)) { if ((err = mp_rand(&b, 1)) != MP_OKAY) { goto LBL_B; } - fips_rand <<= sizeof(mp_digit) * CHAR_BIT; + fips_rand <<= MP_SIZEOF_BITS(mp_digit); fips_rand |= (unsigned int) b.dp[0]; fips_rand &= mask; } #endif - if (fips_rand > (unsigned int)(INT_MAX - DIGIT_BIT)) { - len = INT_MAX / DIGIT_BIT; + if (fips_rand > (unsigned int)(INT_MAX - MP_DIGIT_BIT)) { + len = INT_MAX / MP_DIGIT_BIT; } else { - len = (((int)fips_rand + DIGIT_BIT) / DIGIT_BIT); + len = (((int)fips_rand + MP_DIGIT_BIT) / MP_DIGIT_BIT); } /* Unlikely. */ if (len < 0) { ix--; continue; @@ -330,20 +279,19 @@ if ((err = mp_rand(&b, len)) != MP_OKAY) { goto LBL_B; } /* * That number might got too big and the witness has to be - * smaller than or equal to "a" + * smaller than "a" */ len = mp_count_bits(&b); - if (len > size_a) { - len = len - size_a; + if (len >= size_a) { + len = (len - size_a) + 1; if ((err = mp_div_2d(&b, len, &b, NULL)) != MP_OKAY) { goto LBL_B; } } - /* Although the chance for b <= 3 is miniscule, try again. */ if (mp_cmp_d(&b, 3uL) != MP_GT) { ix--; continue; } @@ -362,9 +310,5 @@ mp_clear(&b); return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_prime_miller_rabin.c ================================================================== --- libtommath/bn_mp_prime_miller_rabin.c +++ libtommath/bn_mp_prime_miller_rabin.c @@ -1,30 +1,22 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_MILLER_RABIN_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* Miller-Rabin test of "a" to the base of "b" as described in * HAC pp. 139 Algorithm 4.24 * * Sets result to 0 if definitely composite or 1 if probably prime. * Randomly the chance of error is no more than 1/4 and often * very much lower. */ -int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result) +mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) { mp_int n1, y, r; - int s, j, err; + mp_err err; + int s, j; /* default */ *result = MP_NO; /* ensure b > 1 */ @@ -95,9 +87,5 @@ LBL_N1: mp_clear(&n1); return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_prime_next_prime.c ================================================================== --- libtommath/bn_mp_prime_next_prime.c +++ libtommath/bn_mp_prime_next_prime.c @@ -1,64 +1,44 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_NEXT_PRIME_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* finds the next prime after the number "a" using "t" trials * of Miller-Rabin. * * bbs_style = 1 means the prime must be congruent to 3 mod 4 */ -int mp_prime_next_prime(mp_int *a, int t, int bbs_style) +mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) { - int err, res = MP_NO, x, y; - mp_digit res_tab[PRIME_SIZE], step, kstep; + int x, y; + mp_ord cmp; + mp_err err; + mp_bool res = MP_NO; + mp_digit res_tab[PRIVATE_MP_PRIME_TAB_SIZE], step, kstep; mp_int b; /* force positive */ a->sign = MP_ZPOS; /* simple algo if a is less than the largest prime in the table */ - if (mp_cmp_d(a, ltm_prime_tab[PRIME_SIZE-1]) == MP_LT) { - /* find which prime it is bigger than */ - for (x = PRIME_SIZE - 2; x >= 0; x--) { - if (mp_cmp_d(a, ltm_prime_tab[x]) != MP_LT) { - if (bbs_style == 1) { - /* ok we found a prime smaller or - * equal [so the next is larger] - * - * however, the prime must be - * congruent to 3 mod 4 - */ - if ((ltm_prime_tab[x + 1] & 3u) != 3u) { - /* scan upwards for a prime congruent to 3 mod 4 */ - for (y = x + 1; y < PRIME_SIZE; y++) { - if ((ltm_prime_tab[y] & 3u) == 3u) { - mp_set(a, ltm_prime_tab[y]); - return MP_OKAY; - } - } - } - } else { - mp_set(a, ltm_prime_tab[x + 1]); - return MP_OKAY; - } - } - } - /* at this point a maybe 1 */ - if (mp_cmp_d(a, 1uL) == MP_EQ) { - mp_set(a, 2uL); - return MP_OKAY; + if (mp_cmp_d(a, s_mp_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE-1]) == MP_LT) { + /* find which prime it is bigger than "a" */ + for (x = 0; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) { + cmp = mp_cmp_d(a, s_mp_prime_tab[x]); + if (cmp == MP_EQ) { + continue; + } + if (cmp != MP_GT) { + if ((bbs_style == 1) && ((s_mp_prime_tab[x] & 3u) != 3u)) { + /* try again until we get a prime congruent to 3 mod 4 */ + continue; + } else { + mp_set(a, s_mp_prime_tab[x]); + return MP_OKAY; + } + } } /* fall through to the sieve */ } /* generate a prime congruent to 3 mod 4 or 1/3 mod 4? */ @@ -73,24 +53,24 @@ if (bbs_style == 1) { /* if a mod 4 != 3 subtract the correct value to make it so */ if ((a->dp[0] & 3u) != 3u) { if ((err = mp_sub_d(a, (a->dp[0] & 3u) + 1u, a)) != MP_OKAY) { return err; - }; + } } } else { - if (mp_iseven(a) == MP_YES) { + if (MP_IS_EVEN(a)) { /* force odd */ if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) { return err; } } } /* generate the restable */ - for (x = 1; x < PRIME_SIZE; x++) { - if ((err = mp_mod_d(a, ltm_prime_tab[x], res_tab + x)) != MP_OKAY) { + for (x = 1; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) { + if ((err = mp_mod_d(a, s_mp_prime_tab[x], res_tab + x)) != MP_OKAY) { return err; } } /* init temp used for Miller-Rabin Testing */ @@ -107,33 +87,33 @@ /* increase step to next candidate */ step += kstep; /* compute the new residue without using division */ - for (x = 1; x < PRIME_SIZE; x++) { + for (x = 1; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) { /* add the step to each residue */ res_tab[x] += kstep; /* subtract the modulus [instead of using division] */ - if (res_tab[x] >= ltm_prime_tab[x]) { - res_tab[x] -= ltm_prime_tab[x]; + if (res_tab[x] >= s_mp_prime_tab[x]) { + res_tab[x] -= s_mp_prime_tab[x]; } /* set flag if zero */ if (res_tab[x] == 0u) { y = 1; } } - } while ((y == 1) && (step < (((mp_digit)1 << DIGIT_BIT) - kstep))); + } while ((y == 1) && (step < (((mp_digit)1 << MP_DIGIT_BIT) - kstep))); /* add the step */ if ((err = mp_add_d(a, step, a)) != MP_OKAY) { goto LBL_ERR; } - /* if didn't pass sieve and step == MAX then skip test */ - if ((y == 1) && (step >= (((mp_digit)1 << DIGIT_BIT) - kstep))) { + /* if didn't pass sieve and step == MP_MAX then skip test */ + if ((y == 1) && (step >= (((mp_digit)1 << MP_DIGIT_BIT) - kstep))) { continue; } if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { goto LBL_ERR; @@ -148,9 +128,5 @@ mp_clear(&b); return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_prime_rabin_miller_trials.c ================================================================== --- libtommath/bn_mp_prime_rabin_miller_trials.c +++ libtommath/bn_mp_prime_rabin_miller_trials.c @@ -1,41 +1,36 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_RABIN_MILLER_TRIALS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ static const struct { int k, t; } sizes[] = { - { 80, -1 }, /* Use deterministic algorithm for size <= 80 bits */ - { 81, 39 }, - { 96, 37 }, - { 128, 32 }, - { 160, 27 }, - { 192, 21 }, - { 256, 16 }, - { 384, 10 }, - { 512, 7 }, - { 640, 6 }, - { 768, 5 }, - { 896, 4 }, - { 1024, 4 }, - { 2048, 2 }, - { 4096, 1 }, + { 80, -1 }, /* Use deterministic algorithm for size <= 80 bits */ + { 81, 37 }, /* max. error = 2^(-96)*/ + { 96, 32 }, /* max. error = 2^(-96)*/ + { 128, 40 }, /* max. error = 2^(-112)*/ + { 160, 35 }, /* max. error = 2^(-112)*/ + { 256, 27 }, /* max. error = 2^(-128)*/ + { 384, 16 }, /* max. error = 2^(-128)*/ + { 512, 18 }, /* max. error = 2^(-160)*/ + { 768, 11 }, /* max. error = 2^(-160)*/ + { 896, 10 }, /* max. error = 2^(-160)*/ + { 1024, 12 }, /* max. error = 2^(-192)*/ + { 1536, 8 }, /* max. error = 2^(-192)*/ + { 2048, 6 }, /* max. error = 2^(-192)*/ + { 3072, 4 }, /* max. error = 2^(-192)*/ + { 4096, 5 }, /* max. error = 2^(-256)*/ + { 5120, 4 }, /* max. error = 2^(-256)*/ + { 6144, 4 }, /* max. error = 2^(-256)*/ + { 8192, 3 }, /* max. error = 2^(-256)*/ + { 9216, 3 }, /* max. error = 2^(-256)*/ + { 10240, 2 } /* For bigger keysizes use always at least 2 Rounds */ }; -/* returns # of RM trials required for a given bit size and max. error of 2^(-96)*/ +/* returns # of RM trials required for a given bit size */ int mp_prime_rabin_miller_trials(int size) { int x; for (x = 0; x < (int)(sizeof(sizes)/(sizeof(sizes[0]))); x++) { @@ -43,14 +38,10 @@ return sizes[x].t; } else if (sizes[x].k > size) { return (x == 0) ? sizes[0].t : sizes[x - 1].t; } } - return sizes[x-1].t + 1; + return sizes[x-1].t; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_prime_rand.c Index: libtommath/bn_mp_prime_rand.c ================================================================== --- /dev/null +++ libtommath/bn_mp_prime_rand.c @@ -0,0 +1,141 @@ +#include "tommath_private.h" +#ifdef BN_MP_PRIME_RAND_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* makes a truly random prime of a given size (bits), + * + * Flags are as follows: + * + * MP_PRIME_BBS - make prime congruent to 3 mod 4 + * MP_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS) + * MP_PRIME_2MSB_ON - make the 2nd highest bit one + * + * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can + * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself + * so it can be NULL + * + */ + +/* This is possibly the mother of all prime generation functions, muahahahahaha! */ +mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat) +{ + unsigned char *tmp, maskAND, maskOR_msb, maskOR_lsb; + int bsize, maskOR_msb_offset; + mp_bool res; + mp_err err; + + /* sanity check the input */ + if ((size <= 1) || (t <= 0)) { + return MP_VAL; + } + + /* MP_PRIME_SAFE implies MP_PRIME_BBS */ + if ((flags & MP_PRIME_SAFE) != 0) { + flags |= MP_PRIME_BBS; + } + + /* calc the byte size */ + bsize = (size>>3) + ((size&7)?1:0); + + /* we need a buffer of bsize bytes */ + tmp = (unsigned char *) MP_MALLOC((size_t)bsize); + if (tmp == NULL) { + return MP_MEM; + } + + /* calc the maskAND value for the MSbyte*/ + maskAND = ((size&7) == 0) ? 0xFFu : (unsigned char)(0xFFu >> (8 - (size & 7))); + + /* calc the maskOR_msb */ + maskOR_msb = 0; + maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0; + if ((flags & MP_PRIME_2MSB_ON) != 0) { + maskOR_msb |= (unsigned char)(0x80 >> ((9 - size) & 7)); + } + + /* get the maskOR_lsb */ + maskOR_lsb = 1u; + if ((flags & MP_PRIME_BBS) != 0) { + maskOR_lsb |= 3u; + } + + do { + /* read the bytes */ + if (cb(tmp, bsize, dat) != bsize) { + err = MP_VAL; + goto error; + } + + /* work over the MSbyte */ + tmp[0] &= maskAND; + tmp[0] |= (unsigned char)(1 << ((size - 1) & 7)); + + /* mix in the maskORs */ + tmp[maskOR_msb_offset] |= maskOR_msb; + tmp[bsize-1] |= maskOR_lsb; + + /* read it in */ + /* TODO: casting only for now until all lengths have been changed to the type "size_t"*/ + if ((err = mp_from_ubin(a, tmp, (size_t)bsize)) != MP_OKAY) { + goto error; + } + + /* is it prime? */ + if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { + goto error; + } + if (res == MP_NO) { + continue; + } + + if ((flags & MP_PRIME_SAFE) != 0) { + /* see if (a-1)/2 is prime */ + if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) { + goto error; + } + if ((err = mp_div_2(a, a)) != MP_OKAY) { + goto error; + } + + /* is it prime? */ + if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { + goto error; + } + } + } while (res == MP_NO); + + if ((flags & MP_PRIME_SAFE) != 0) { + /* restore a to the original value */ + if ((err = mp_mul_2(a, a)) != MP_OKAY) { + goto error; + } + if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) { + goto error; + } + } + + err = MP_OKAY; +error: + MP_FREE_BUFFER(tmp, (size_t)bsize); + return err; +} + +static int s_mp_rand_cb(unsigned char *dst, int len, void *dat) +{ + (void)dat; + if (len <= 0) { + return len; + } + if (s_mp_rand_source(dst, (size_t)len) != MP_OKAY) { + return 0; + } + return len; +} + +mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) +{ + return s_mp_prime_random_ex(a, t, size, flags, s_mp_rand_cb, NULL); +} + +#endif DELETED libtommath/bn_mp_prime_random_ex.c Index: libtommath/bn_mp_prime_random_ex.c ================================================================== --- libtommath/bn_mp_prime_random_ex.c +++ /dev/null @@ -1,135 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_PRIME_RANDOM_EX_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* makes a truly random prime of a given size (bits), - * - * Flags are as follows: - * - * LTM_PRIME_BBS - make prime congruent to 3 mod 4 - * LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS) - * LTM_PRIME_2MSB_ON - make the 2nd highest bit one - * - * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can - * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself - * so it can be NULL - * - */ - -/* This is possibly the mother of all prime generation functions, muahahahahaha! */ -int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat) -{ - unsigned char *tmp, maskAND, maskOR_msb, maskOR_lsb; - int res, err, bsize, maskOR_msb_offset; - - /* sanity check the input */ - if ((size <= 1) || (t <= 0)) { - return MP_VAL; - } - - /* LTM_PRIME_SAFE implies LTM_PRIME_BBS */ - if ((flags & LTM_PRIME_SAFE) != 0) { - flags |= LTM_PRIME_BBS; - } - - /* calc the byte size */ - bsize = (size>>3) + ((size&7)?1:0); - - /* we need a buffer of bsize bytes */ - tmp = (unsigned char *) XMALLOC((size_t)bsize); - if (tmp == NULL) { - return MP_MEM; - } - - /* calc the maskAND value for the MSbyte*/ - maskAND = ((size&7) == 0) ? 0xFF : (unsigned char)(0xFF >> (8 - (size & 7))); - - /* calc the maskOR_msb */ - maskOR_msb = 0; - maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0; - if ((flags & LTM_PRIME_2MSB_ON) != 0) { - maskOR_msb |= (unsigned char)(0x80 >> ((9 - size) & 7)); - } - - /* get the maskOR_lsb */ - maskOR_lsb = 1; - if ((flags & LTM_PRIME_BBS) != 0) { - maskOR_lsb |= 3; - } - - do { - /* read the bytes */ - if (cb(tmp, bsize, dat) != bsize) { - err = MP_VAL; - goto error; - } - - /* work over the MSbyte */ - tmp[0] &= maskAND; - tmp[0] |= (unsigned char)(1 << ((size - 1) & 7)); - - /* mix in the maskORs */ - tmp[maskOR_msb_offset] |= maskOR_msb; - tmp[bsize-1] |= maskOR_lsb; - - /* read it in */ - if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY) { - goto error; - } - - /* is it prime? */ - if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { - goto error; - } - if (res == MP_NO) { - continue; - } - - if ((flags & LTM_PRIME_SAFE) != 0) { - /* see if (a-1)/2 is prime */ - if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) { - goto error; - } - if ((err = mp_div_2(a, a)) != MP_OKAY) { - goto error; - } - - /* is it prime? */ - if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) { - goto error; - } - } - } while (res == MP_NO); - - if ((flags & LTM_PRIME_SAFE) != 0) { - /* restore a to the original value */ - if ((err = mp_mul_2(a, a)) != MP_OKAY) { - goto error; - } - if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) { - goto error; - } - } - - err = MP_OKAY; -error: - XFREE(tmp, bsize); - return err; -} - - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_prime_strong_lucas_selfridge.c ================================================================== --- libtommath/bn_mp_prime_strong_lucas_selfridge.c +++ libtommath/bn_mp_prime_strong_lucas_selfridge.c @@ -1,24 +1,15 @@ #include "tommath_private.h" #ifdef BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* * See file bn_mp_prime_is_prime.c or the documentation in doc/bn.tex for the details */ -#ifndef LTM_USE_FIPS_ONLY +#ifndef LTM_USE_ONLY_MR /* * 8-bit is just too small. You can try the Frobenius test * but that frobenius test can fail, too, for the same reason. */ @@ -26,37 +17,25 @@ /* * multiply bigint a with int d and put the result in c * Like mp_mul_d() but with a signed long as the small input */ -static int s_mp_mul_si(const mp_int *a, long d, mp_int *c) +static mp_err s_mp_mul_si(const mp_int *a, int32_t d, mp_int *c) { mp_int t; - int err, neg = 0; + mp_err err; if ((err = mp_init(&t)) != MP_OKAY) { return err; } - if (d < 0) { - neg = 1; - d = -d; - } /* * mp_digit might be smaller than a long, which excludes * the use of mp_mul_d() here. */ - if ((err = mp_set_long(&t, (unsigned long) d)) != MP_OKAY) { - goto LBL_MPMULSI_ERR; - } - if ((err = mp_mul(a, &t, c)) != MP_OKAY) { - goto LBL_MPMULSI_ERR; - } - if (neg == 1) { - c->sign = (a->sign == MP_NEG) ? MP_ZPOS: MP_NEG; - } -LBL_MPMULSI_ERR: + mp_set_i32(&t, d); + err = mp_mul(a, &t, c); mp_clear(&t); return err; } /* Strong Lucas-Selfridge test. @@ -73,18 +52,18 @@ Additional comments marked "CZ" (without the quotes) are by the code-portist. (If that name sounds familiar, he is the guy who found the fdiv bug in the Pentium (P5x, I think) Intel processor) */ -int mp_prime_strong_lucas_selfridge(const mp_int *a, int *result) +mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) { /* CZ TODO: choose better variable names! */ mp_int Dz, gcd, Np1, Uz, Vz, U2mz, V2mz, Qmz, Q2mz, Qkdz, T1z, T2z, T3z, T4z, Q2kdz; /* CZ TODO: Some of them need the full 32 bit, hence the (temporary) exclusion of MP_8BIT */ int32_t D, Ds, J, sign, P, Q, r, s, u, Nbits; - int e; - int isset, oddness; + mp_err err; + mp_bool oddness; *result = MP_NO; /* Find the first element D in the sequence {5, -7, 9, -11, 13, ...} such that Jacobi(D,N) = -1 (Selfridge's algorithm). Theory @@ -91,47 +70,42 @@ indicates that, if N is not a perfect square, D will "nearly always" be "small." Just in case, an overflow trap for D is included. */ - if ((e = mp_init_multi(&Dz, &gcd, &Np1, &Uz, &Vz, &U2mz, &V2mz, &Qmz, &Q2mz, &Qkdz, &T1z, &T2z, &T3z, &T4z, &Q2kdz, - NULL)) != MP_OKAY) { - return e; + if ((err = mp_init_multi(&Dz, &gcd, &Np1, &Uz, &Vz, &U2mz, &V2mz, &Qmz, &Q2mz, &Qkdz, &T1z, &T2z, &T3z, &T4z, &Q2kdz, + NULL)) != MP_OKAY) { + return err; } D = 5; sign = 1; for (;;) { Ds = sign * D; sign = -sign; - if ((e = mp_set_long(&Dz, (unsigned long)D)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_gcd(a, &Dz, &gcd)) != MP_OKAY) { - goto LBL_LS_ERR; - } + mp_set_u32(&Dz, (uint32_t)D); + if ((err = mp_gcd(a, &Dz, &gcd)) != MP_OKAY) goto LBL_LS_ERR; + /* if 1 < GCD < N then N is composite with factor "D", and Jacobi(D,N) is technically undefined (but often returned as zero). */ if ((mp_cmp_d(&gcd, 1uL) == MP_GT) && (mp_cmp(&gcd, a) == MP_LT)) { goto LBL_LS_ERR; } if (Ds < 0) { Dz.sign = MP_NEG; } - if ((e = mp_kronecker(&Dz, a, &J)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_kronecker(&Dz, a, &J)) != MP_OKAY) goto LBL_LS_ERR; if (J == -1) { break; } D += 2; if (D > (INT_MAX - 2)) { - e = MP_VAL; + err = MP_VAL; goto LBL_LS_ERR; } } @@ -167,25 +141,21 @@ the evidence indicates that the strong Lucas-Selfridge test is more effective than the standard Lucas-Selfridge test, and a Baillie-PSW test based on the strong Lucas-Selfridge test should be more reliable. */ - if ((e = mp_add_d(a, 1uL, &Np1)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_add_d(a, 1uL, &Np1)) != MP_OKAY) goto LBL_LS_ERR; s = mp_cnt_lsb(&Np1); /* CZ * This should round towards zero because * Thomas R. Nicely used GMP's mpz_tdiv_q_2exp() * and mp_div_2d() is equivalent. Additionally: * dividing an even number by two does not produce * any leftovers. */ - if ((e = mp_div_2d(&Np1, s, &Dz, NULL)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_div_2d(&Np1, s, &Dz, NULL)) != MP_OKAY) goto LBL_LS_ERR; /* We must now compute U_d and V_d. Since d is odd, the accumulated values U and V are initialized to U_1 and V_1 (if the target index were even, U and V would be initialized instead to U_0=0 and V_0=2). The values of U_2m and V_2m are also initialized to U_1 and V_1; the FOR loop calculates in succession U_2 and V_2, @@ -198,38 +168,14 @@ mp_set(&Uz, 1uL); /* U=U_1 */ mp_set(&Vz, (mp_digit)P); /* V=V_1 */ mp_set(&U2mz, 1uL); /* U_1 */ mp_set(&V2mz, (mp_digit)P); /* V_1 */ - if (Q < 0) { - Q = -Q; - if ((e = mp_set_long(&Qmz, (unsigned long)Q)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - /* Initializes calculation of Q^d */ - if ((e = mp_set_long(&Qkdz, (unsigned long)Q)) != MP_OKAY) { - goto LBL_LS_ERR; - } - Qmz.sign = MP_NEG; - Q2mz.sign = MP_NEG; - Qkdz.sign = MP_NEG; - Q = -Q; - } else { - if ((e = mp_set_long(&Qmz, (unsigned long)Q)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - /* Initializes calculation of Q^d */ - if ((e = mp_set_long(&Qkdz, (unsigned long)Q)) != MP_OKAY) { - goto LBL_LS_ERR; - } - } + mp_set_i32(&Qmz, Q); + if ((err = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) goto LBL_LS_ERR; + /* Initializes calculation of Q^d */ + mp_set_i32(&Qkdz, Q); Nbits = mp_count_bits(&Dz); for (u = 1; u < Nbits; u++) { /* zero bit off, already accounted for */ /* Formulas for doubling of indices (carried out mod N). Note that @@ -238,121 +184,71 @@ * * U_2m = U_m*V_m * V_2m = V_m*V_m - 2*Q^m */ - if ((e = mp_mul(&U2mz, &V2mz, &U2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mod(&U2mz, a, &U2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_sqr(&V2mz, &V2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_sub(&V2mz, &Q2mz, &V2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mod(&V2mz, a, &V2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_mul(&U2mz, &V2mz, &U2mz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mod(&U2mz, a, &U2mz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_sqr(&V2mz, &V2mz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_sub(&V2mz, &Q2mz, &V2mz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mod(&V2mz, a, &V2mz)) != MP_OKAY) goto LBL_LS_ERR; + /* Must calculate powers of Q for use in V_2m, also for Q^d later */ - if ((e = mp_sqr(&Qmz, &Qmz)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_sqr(&Qmz, &Qmz)) != MP_OKAY) goto LBL_LS_ERR; + /* prevents overflow */ /* CZ still necessary without a fixed prealloc'd mem.? */ - if ((e = mp_mod(&Qmz, a, &Qmz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((isset = mp_get_bit(&Dz, u)) == MP_VAL) { - e = isset; - goto LBL_LS_ERR; - } - if (isset == MP_YES) { + if ((err = mp_mod(&Qmz, a, &Qmz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY) goto LBL_LS_ERR; + + if (s_mp_get_bit(&Dz, (unsigned int)u) == MP_YES) { /* Formulas for addition of indices (carried out mod N); * * U_(m+n) = (U_m*V_n + U_n*V_m)/2 * V_(m+n) = (V_m*V_n + D*U_m*U_n)/2 * * Be careful with division by 2 (mod N)! */ - if ((e = mp_mul(&U2mz, &Vz, &T1z)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul(&Uz, &V2mz, &T2z)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul(&V2mz, &Vz, &T3z)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul(&U2mz, &Uz, &T4z)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = s_mp_mul_si(&T4z, (long)Ds, &T4z)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_add(&T1z, &T2z, &Uz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if (mp_isodd(&Uz) != MP_NO) { - if ((e = mp_add(&Uz, a, &Uz)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_mul(&U2mz, &Vz, &T1z)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mul(&Uz, &V2mz, &T2z)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mul(&V2mz, &Vz, &T3z)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mul(&U2mz, &Uz, &T4z)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = s_mp_mul_si(&T4z, Ds, &T4z)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_add(&T1z, &T2z, &Uz)) != MP_OKAY) goto LBL_LS_ERR; + if (MP_IS_ODD(&Uz)) { + if ((err = mp_add(&Uz, a, &Uz)) != MP_OKAY) goto LBL_LS_ERR; } /* CZ * This should round towards negative infinity because * Thomas R. Nicely used GMP's mpz_fdiv_q_2exp(). * But mp_div_2() does not do so, it is truncating instead. */ - oddness = mp_isodd(&Uz); - if ((e = mp_div_2(&Uz, &Uz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((Uz.sign == MP_NEG) && (oddness != MP_NO)) { - if ((e = mp_sub_d(&Uz, 1uL, &Uz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - } - if ((e = mp_add(&T3z, &T4z, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if (mp_isodd(&Vz) != MP_NO) { - if ((e = mp_add(&Vz, a, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - } - oddness = mp_isodd(&Vz); - if ((e = mp_div_2(&Vz, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((Vz.sign == MP_NEG) && (oddness != MP_NO)) { - if ((e = mp_sub_d(&Vz, 1uL, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - } - if ((e = mp_mod(&Uz, a, &Uz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mod(&Vz, a, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - /* Calculating Q^d for later use */ - if ((e = mp_mul(&Qkdz, &Qmz, &Qkdz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY) { - goto LBL_LS_ERR; - } + oddness = MP_IS_ODD(&Uz) ? MP_YES : MP_NO; + if ((err = mp_div_2(&Uz, &Uz)) != MP_OKAY) goto LBL_LS_ERR; + if ((Uz.sign == MP_NEG) && (oddness != MP_NO)) { + if ((err = mp_sub_d(&Uz, 1uL, &Uz)) != MP_OKAY) goto LBL_LS_ERR; + } + if ((err = mp_add(&T3z, &T4z, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + if (MP_IS_ODD(&Vz)) { + if ((err = mp_add(&Vz, a, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + } + oddness = MP_IS_ODD(&Vz) ? MP_YES : MP_NO; + if ((err = mp_div_2(&Vz, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + if ((Vz.sign == MP_NEG) && (oddness != MP_NO)) { + if ((err = mp_sub_d(&Vz, 1uL, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + } + if ((err = mp_mod(&Uz, a, &Uz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mod(&Vz, a, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + + /* Calculating Q^d for later use */ + if ((err = mp_mul(&Qkdz, &Qmz, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; } } /* If U_d or V_d is congruent to 0 mod N, then N is a prime or a strong Lucas pseudoprime. */ - if ((mp_iszero(&Uz) != MP_NO) || (mp_iszero(&Vz) != MP_NO)) { + if (MP_IS_ZERO(&Uz) || MP_IS_ZERO(&Vz)) { *result = MP_YES; goto LBL_LS_ERR; } /* NOTE: Ribenboim ("The new book of prime number records," 3rd ed., @@ -365,47 +261,29 @@ by repeated use of the formula V_2m = V_m*V_m - 2*Q^m. If any of these are congruent to 0 mod N, then N is a prime or a strong Lucas pseudoprime. */ /* Initialize 2*Q^(d*2^r) for V_2m */ - if ((e = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY) goto LBL_LS_ERR; for (r = 1; r < s; r++) { - if ((e = mp_sqr(&Vz, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_sub(&Vz, &Q2kdz, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mod(&Vz, a, &Vz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if (mp_iszero(&Vz) != MP_NO) { + if ((err = mp_sqr(&Vz, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_sub(&Vz, &Q2kdz, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mod(&Vz, a, &Vz)) != MP_OKAY) goto LBL_LS_ERR; + if (MP_IS_ZERO(&Vz)) { *result = MP_YES; goto LBL_LS_ERR; } /* Calculate Q^{d*2^r} for next r (final iteration irrelevant). */ if (r < (s - 1)) { - if ((e = mp_sqr(&Qkdz, &Qkdz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY) { - goto LBL_LS_ERR; - } - if ((e = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY) { - goto LBL_LS_ERR; - } + if ((err = mp_sqr(&Qkdz, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY) goto LBL_LS_ERR; + if ((err = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY) goto LBL_LS_ERR; } } LBL_LS_ERR: mp_clear_multi(&Q2kdz, &T4z, &T3z, &T2z, &T1z, &Qkdz, &Q2mz, &Qmz, &V2mz, &U2mz, &Vz, &Uz, &Np1, &gcd, &Dz, NULL); - return e; + return err; } #endif #endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_radix_size.c ================================================================== --- libtommath/bn_mp_radix_size.c +++ libtommath/bn_mp_radix_size.c @@ -1,41 +1,33 @@ #include "tommath_private.h" #ifdef BN_MP_RADIX_SIZE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* returns size of ASCII reprensentation */ -int mp_radix_size(const mp_int *a, int radix, int *size) -{ - int res, digs; - mp_int t; +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* returns size of ASCII representation */ +mp_err mp_radix_size(const mp_int *a, int radix, int *size) +{ + mp_err err; + int digs; + mp_int t; mp_digit d; *size = 0; /* make sure the radix is in range */ if ((radix < 2) || (radix > 64)) { return MP_VAL; } - if (mp_iszero(a) == MP_YES) { + if (MP_IS_ZERO(a)) { *size = 2; return MP_OKAY; } /* special case for binary */ if (radix == 2) { - *size = mp_count_bits(a) + ((a->sign == MP_NEG) ? 1 : 0) + 1; + *size = (mp_count_bits(a) + ((a->sign == MP_NEG) ? 1 : 0) + 1); return MP_OKAY; } /* digs is the digit count */ digs = 0; @@ -44,32 +36,30 @@ if (a->sign == MP_NEG) { ++digs; } /* init a copy of the input */ - if ((res = mp_init_copy(&t, a)) != MP_OKAY) { - return res; + if ((err = mp_init_copy(&t, a)) != MP_OKAY) { + return err; } /* force temp to positive */ t.sign = MP_ZPOS; /* fetch out all of the digits */ - while (mp_iszero(&t) == MP_NO) { - if ((res = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { - mp_clear(&t); - return res; + while (!MP_IS_ZERO(&t)) { + if ((err = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { + goto LBL_ERR; } ++digs; } - mp_clear(&t); /* return digs + 1, the 1 is for the NULL byte that would be required. */ *size = digs + 1; - return MP_OKAY; + err = MP_OKAY; + +LBL_ERR: + mp_clear(&t); + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_radix_smap.c ================================================================== --- libtommath/bn_mp_radix_smap.c +++ libtommath/bn_mp_radix_smap.c @@ -1,22 +1,13 @@ #include "tommath_private.h" #ifdef BN_MP_RADIX_SMAP_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* chars used in radix conversions */ const char *const mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/"; -const unsigned char mp_s_rmap_reverse[] = { +const uint8_t mp_s_rmap_reverse[] = { 0xff, 0xff, 0xff, 0x3e, 0xff, 0xff, 0xff, 0x3f, /* ()*+,-./ */ 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, /* 01234567 */ 0x08, 0x09, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, /* 89:;<=>? */ 0xff, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, /* @ABCDEFG */ 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, /* HIJKLMNO */ @@ -27,9 +18,5 @@ 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, /* pqrstuvw */ 0x3b, 0x3c, 0x3d, 0xff, 0xff, 0xff, 0xff, 0xff, /* xyz{|}~. */ }; const size_t mp_s_rmap_reverse_sz = sizeof(mp_s_rmap_reverse); #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_rand.c ================================================================== --- libtommath/bn_mp_rand.c +++ libtommath/bn_mp_rand.c @@ -1,222 +1,46 @@ #include "tommath_private.h" #ifdef BN_MP_RAND_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* First the OS-specific special cases - * - *BSD - * - Windows - */ -#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__) -#define MP_ARC4RANDOM -#define MP_GEN_RANDOM_MAX 0xffffffffu -#define MP_GEN_RANDOM_SHIFT 32 - -static int s_read_arc4random(mp_digit *p) -{ - mp_digit d = 0, msk = 0; - do { - d <<= MP_GEN_RANDOM_SHIFT; - d |= ((mp_digit) arc4random()); - msk <<= MP_GEN_RANDOM_SHIFT; - msk |= (MP_MASK & MP_GEN_RANDOM_MAX); - } while ((MP_MASK & msk) != MP_MASK); - *p = d; - return MP_OKAY; -} -#endif - -#if defined(_WIN32) || defined(_WIN32_WCE) -#define MP_WIN_CSP - -#ifndef _WIN32_WINNT -#define _WIN32_WINNT 0x0400 -#endif -#ifdef _WIN32_WCE -#define UNDER_CE -#define ARM -#endif - -#define WIN32_LEAN_AND_MEAN -#include -#include - -static HCRYPTPROV hProv = 0; - -static void s_cleanup_win_csp(void) -{ - CryptReleaseContext(hProv, 0); - hProv = 0; -} - -static int s_read_win_csp(mp_digit *p) -{ - int ret = -1; - if (hProv == 0) { - if (!CryptAcquireContext(&hProv, NULL, MS_DEF_PROV, PROV_RSA_FULL, - (CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET)) && - !CryptAcquireContext(&hProv, NULL, MS_DEF_PROV, PROV_RSA_FULL, - CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET | CRYPT_NEWKEYSET)) { - hProv = 0; - return ret; - } - atexit(s_cleanup_win_csp); - } - if (CryptGenRandom(hProv, sizeof(*p), (void *)p) == TRUE) { - ret = MP_OKAY; - } - return ret; -} -#endif /* WIN32 */ - -#if !defined(MP_WIN_CSP) && defined(__linux__) && defined(__GLIBC_PREREQ) -#if __GLIBC_PREREQ(2, 25) -#define MP_GETRANDOM -#include -#include - -static int s_read_getrandom(mp_digit *p) -{ - int ret; - do { - ret = getrandom(p, sizeof(*p), 0); - } while ((ret == -1) && (errno == EINTR)); - if (ret == sizeof(*p)) return MP_OKAY; - return -1; -} -#endif -#endif - -/* We assume all platforms besides windows provide "/dev/urandom". - * In case yours doesn't, define MP_NO_DEV_URANDOM at compile-time. - */ -#if !defined(MP_WIN_CSP) && !defined(MP_NO_DEV_URANDOM) -#ifndef MP_DEV_URANDOM -#define MP_DEV_URANDOM "/dev/urandom" -#endif -#include -#include -#include - -static int s_read_dev_urandom(mp_digit *p) -{ - ssize_t r; - int fd; - do { - fd = open(MP_DEV_URANDOM, O_RDONLY); - } while ((fd == -1) && (errno == EINTR)); - if (fd == -1) return -1; - do { - r = read(fd, p, sizeof(*p)); - } while ((r == -1) && (errno == EINTR)); - close(fd); - if (r != sizeof(*p)) return -1; - return MP_OKAY; -} -#endif - -#if defined(MP_PRNG_ENABLE_LTM_RNG) -unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); -void (*ltm_rng_callback)(void); - -static int s_read_ltm_rng(mp_digit *p) -{ - unsigned long ret; - if (ltm_rng == NULL) return -1; - ret = ltm_rng((void *)p, sizeof(*p), ltm_rng_callback); - if (ret != sizeof(*p)) return -1; - return MP_OKAY; -} -#endif - -static int s_rand_digit(mp_digit *p) -{ - int ret = -1; - -#if defined(MP_ARC4RANDOM) - ret = s_read_arc4random(p); - if (ret == MP_OKAY) return ret; -#endif - -#if defined(MP_WIN_CSP) - ret = s_read_win_csp(p); - if (ret == MP_OKAY) return ret; -#else - -#if defined(MP_GETRANDOM) - ret = s_read_getrandom(p); - if (ret == MP_OKAY) return ret; -#endif -#if defined(MP_DEV_URANDOM) - ret = s_read_dev_urandom(p); - if (ret == MP_OKAY) return ret; -#endif - -#endif /* MP_WIN_CSP */ - -#if defined(MP_PRNG_ENABLE_LTM_RNG) - ret = s_read_ltm_rng(p); - if (ret == MP_OKAY) return ret; -#endif - - return ret; -} - -/* makes a pseudo-random int of a given size */ -int mp_rand_digit(mp_digit *r) -{ - int ret = s_rand_digit(r); - *r &= MP_MASK; - return ret; -} - -int mp_rand(mp_int *a, int digits) -{ - int res; - mp_digit d; - - mp_zero(a); - if (digits <= 0) { - return MP_OKAY; - } - - /* first place a random non-zero digit */ - do { - if (mp_rand_digit(&d) != MP_OKAY) { - return MP_VAL; - } - } while (d == 0u); - - if ((res = mp_add_d(a, d, a)) != MP_OKAY) { - return res; - } - - while (--digits > 0) { - if ((res = mp_lshd(a, 1)) != MP_OKAY) { - return res; - } - - if (mp_rand_digit(&d) != MP_OKAY) { - return MP_VAL; - } - if ((res = mp_add_d(a, d, a)) != MP_OKAY) { - return res; - } - } - - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +mp_err(*s_mp_rand_source)(void *out, size_t size) = s_mp_rand_platform; + +void mp_rand_source(mp_err(*source)(void *out, size_t size)) +{ + s_mp_rand_source = (source == NULL) ? s_mp_rand_platform : source; +} + +mp_err mp_rand(mp_int *a, int digits) +{ + int i; + mp_err err; + + mp_zero(a); + + if (digits <= 0) { + return MP_OKAY; + } + + if ((err = mp_grow(a, digits)) != MP_OKAY) { + return err; + } + + if ((err = s_mp_rand_source(a->dp, (size_t)digits * sizeof(mp_digit))) != MP_OKAY) { + return err; + } + + /* TODO: We ensure that the highest digit is nonzero. Should this be removed? */ + while ((a->dp[digits - 1] & MP_MASK) == 0u) { + if ((err = s_mp_rand_source(a->dp + digits - 1, sizeof(mp_digit))) != MP_OKAY) { + return err; + } + } + + a->used = digits; + for (i = 0; i < digits; ++i) { + a->dp[i] &= MP_MASK; + } + + return MP_OKAY; +} +#endif Index: libtommath/bn_mp_read_radix.c ================================================================== --- libtommath/bn_mp_read_radix.c +++ libtommath/bn_mp_read_radix.c @@ -1,27 +1,20 @@ #include "tommath_private.h" #ifdef BN_MP_READ_RADIX_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #define MP_TOUPPER(c) ((((c) >= 'a') && ((c) <= 'z')) ? (((c) + 'A') - 'a') : (c)) /* read a string [ASCII] in a given radix */ -int mp_read_radix(mp_int *a, const char *str, int radix) +mp_err mp_read_radix(mp_int *a, const char *str, int radix) { - int y, res, neg; + mp_err err; + int y; + mp_sign neg; unsigned pos; - char ch; + char ch; /* zero the digit bignum */ mp_zero(a); /* make sure the radix is ok */ @@ -60,15 +53,15 @@ * to the number, otherwise exit the loop. */ if ((y == 0xff) || (y >= radix)) { break; } - if ((res = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) { - return res; + if ((err = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) { + return err; } - if ((res = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) { - return res; + if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) { + return err; } ++str; } /* if an illegal character was found, fail. */ @@ -76,15 +69,11 @@ mp_zero(a); return MP_VAL; } /* set the sign only if a != 0 */ - if (mp_iszero(a) != MP_YES) { + if (!MP_IS_ZERO(a)) { a->sign = neg; } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_read_signed_bin.c Index: libtommath/bn_mp_read_signed_bin.c ================================================================== --- libtommath/bn_mp_read_signed_bin.c +++ /dev/null @@ -1,38 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_READ_SIGNED_BIN_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* read signed bin, big endian, first byte is 0==positive or 1==negative */ -int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) -{ - int res; - - /* read magnitude */ - if ((res = mp_read_unsigned_bin(a, b + 1, c - 1)) != MP_OKAY) { - return res; - } - - /* first byte is 0 for positive, non-zero for negative */ - if (b[0] == (unsigned char)0) { - a->sign = MP_ZPOS; - } else { - a->sign = MP_NEG; - } - - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_read_unsigned_bin.c Index: libtommath/bn_mp_read_unsigned_bin.c ================================================================== --- libtommath/bn_mp_read_unsigned_bin.c +++ /dev/null @@ -1,52 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_READ_UNSIGNED_BIN_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* reads a unsigned char array, assumes the msb is stored first [big endian] */ -int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) -{ - int res; - - /* make sure there are at least two digits */ - if (a->alloc < 2) { - if ((res = mp_grow(a, 2)) != MP_OKAY) { - return res; - } - } - - /* zero the int */ - mp_zero(a); - - /* read the bytes in */ - while (c-- > 0) { - if ((res = mp_mul_2d(a, 8, a)) != MP_OKAY) { - return res; - } - -#ifndef MP_8BIT - a->dp[0] |= *b++; - a->used += 1; -#else - a->dp[0] = (*b & MP_MASK); - a->dp[1] |= ((*b++ >> 7) & 1u); - a->used += 2; -#endif - } - mp_clamp(a); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce.c ================================================================== --- libtommath/bn_mp_reduce.c +++ libtommath/bn_mp_reduce.c @@ -1,97 +1,83 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* reduces x mod m, assumes 0 < x < m**2, mu is * precomputed via mp_reduce_setup. * From HAC pp.604 Algorithm 14.42 */ -int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) +mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) { mp_int q; - int res, um = m->used; + mp_err err; + int um = m->used; /* q = x */ - if ((res = mp_init_copy(&q, x)) != MP_OKAY) { - return res; + if ((err = mp_init_copy(&q, x)) != MP_OKAY) { + return err; } /* q1 = x / b**(k-1) */ mp_rshd(&q, um - 1); /* according to HAC this optimization is ok */ - if ((mp_digit)um > ((mp_digit)1 << (DIGIT_BIT - 1))) { - if ((res = mp_mul(&q, mu, &q)) != MP_OKAY) { + if ((mp_digit)um > ((mp_digit)1 << (MP_DIGIT_BIT - 1))) { + if ((err = mp_mul(&q, mu, &q)) != MP_OKAY) { + goto CLEANUP; + } + } else if (MP_HAS(S_MP_MUL_HIGH_DIGS)) { + if ((err = s_mp_mul_high_digs(&q, mu, &q, um)) != MP_OKAY) { + goto CLEANUP; + } + } else if (MP_HAS(S_MP_MUL_HIGH_DIGS_FAST)) { + if ((err = s_mp_mul_high_digs_fast(&q, mu, &q, um)) != MP_OKAY) { goto CLEANUP; } } else { -#ifdef BN_S_MP_MUL_HIGH_DIGS_C - if ((res = s_mp_mul_high_digs(&q, mu, &q, um)) != MP_OKAY) { - goto CLEANUP; - } -#elif defined(BN_FAST_S_MP_MUL_HIGH_DIGS_C) - if ((res = fast_s_mp_mul_high_digs(&q, mu, &q, um)) != MP_OKAY) { - goto CLEANUP; - } -#else - { - res = MP_VAL; - goto CLEANUP; - } -#endif + err = MP_VAL; + goto CLEANUP; } /* q3 = q2 / b**(k+1) */ mp_rshd(&q, um + 1); /* x = x mod b**(k+1), quick (no division) */ - if ((res = mp_mod_2d(x, DIGIT_BIT * (um + 1), x)) != MP_OKAY) { + if ((err = mp_mod_2d(x, MP_DIGIT_BIT * (um + 1), x)) != MP_OKAY) { goto CLEANUP; } /* q = q * m mod b**(k+1), quick (no division) */ - if ((res = s_mp_mul_digs(&q, m, &q, um + 1)) != MP_OKAY) { + if ((err = s_mp_mul_digs(&q, m, &q, um + 1)) != MP_OKAY) { goto CLEANUP; } /* x = x - q */ - if ((res = mp_sub(x, &q, x)) != MP_OKAY) { + if ((err = mp_sub(x, &q, x)) != MP_OKAY) { goto CLEANUP; } /* If x < 0, add b**(k+1) to it */ if (mp_cmp_d(x, 0uL) == MP_LT) { mp_set(&q, 1uL); - if ((res = mp_lshd(&q, um + 1)) != MP_OKAY) + if ((err = mp_lshd(&q, um + 1)) != MP_OKAY) { goto CLEANUP; - if ((res = mp_add(x, &q, x)) != MP_OKAY) + } + if ((err = mp_add(x, &q, x)) != MP_OKAY) { goto CLEANUP; + } } /* Back off if it's too big */ while (mp_cmp(x, m) != MP_LT) { - if ((res = s_mp_sub(x, m, x)) != MP_OKAY) { + if ((err = s_mp_sub(x, m, x)) != MP_OKAY) { goto CLEANUP; } } CLEANUP: mp_clear(&q); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_2k.c ================================================================== --- libtommath/bn_mp_reduce_2k.c +++ libtommath/bn_mp_reduce_2k.c @@ -1,60 +1,48 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* reduces a modulo n where n is of the form 2**p - d */ -int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) +mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) { mp_int q; - int p, res; + mp_err err; + int p; - if ((res = mp_init(&q)) != MP_OKAY) { - return res; + if ((err = mp_init(&q)) != MP_OKAY) { + return err; } p = mp_count_bits(n); top: /* q = a/2**p, a = a mod 2**p */ - if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) { + if ((err = mp_div_2d(a, p, &q, a)) != MP_OKAY) { goto LBL_ERR; } if (d != 1u) { /* q = q * d */ - if ((res = mp_mul_d(&q, d, &q)) != MP_OKAY) { + if ((err = mp_mul_d(&q, d, &q)) != MP_OKAY) { goto LBL_ERR; } } /* a = a + q */ - if ((res = s_mp_add(a, &q, a)) != MP_OKAY) { + if ((err = s_mp_add(a, &q, a)) != MP_OKAY) { goto LBL_ERR; } if (mp_cmp_mag(a, n) != MP_LT) { - if ((res = s_mp_sub(a, n, a)) != MP_OKAY) { + if ((err = s_mp_sub(a, n, a)) != MP_OKAY) { goto LBL_ERR; } goto top; } LBL_ERR: mp_clear(&q); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_2k_l.c ================================================================== --- libtommath/bn_mp_reduce_2k_l.c +++ libtommath/bn_mp_reduce_2k_l.c @@ -1,61 +1,49 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_L_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* reduces a modulo n where n is of the form 2**p - d This differs from reduce_2k since "d" can be larger than a single digit. */ -int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) +mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) { mp_int q; - int p, res; + mp_err err; + int p; - if ((res = mp_init(&q)) != MP_OKAY) { - return res; + if ((err = mp_init(&q)) != MP_OKAY) { + return err; } p = mp_count_bits(n); top: /* q = a/2**p, a = a mod 2**p */ - if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) { + if ((err = mp_div_2d(a, p, &q, a)) != MP_OKAY) { goto LBL_ERR; } /* q = q * d */ - if ((res = mp_mul(&q, d, &q)) != MP_OKAY) { + if ((err = mp_mul(&q, d, &q)) != MP_OKAY) { goto LBL_ERR; } /* a = a + q */ - if ((res = s_mp_add(a, &q, a)) != MP_OKAY) { + if ((err = s_mp_add(a, &q, a)) != MP_OKAY) { goto LBL_ERR; } if (mp_cmp_mag(a, n) != MP_LT) { - if ((res = s_mp_sub(a, n, a)) != MP_OKAY) { + if ((err = s_mp_sub(a, n, a)) != MP_OKAY) { goto LBL_ERR; } goto top; } LBL_ERR: mp_clear(&q); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_2k_setup.c ================================================================== --- libtommath/bn_mp_reduce_2k_setup.c +++ libtommath/bn_mp_reduce_2k_setup.c @@ -1,44 +1,32 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_SETUP_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* determines the setup value */ -int mp_reduce_2k_setup(const mp_int *a, mp_digit *d) +mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) { - int res, p; + mp_err err; mp_int tmp; + int p; - if ((res = mp_init(&tmp)) != MP_OKAY) { - return res; + if ((err = mp_init(&tmp)) != MP_OKAY) { + return err; } p = mp_count_bits(a); - if ((res = mp_2expt(&tmp, p)) != MP_OKAY) { + if ((err = mp_2expt(&tmp, p)) != MP_OKAY) { mp_clear(&tmp); - return res; + return err; } - if ((res = s_mp_sub(&tmp, a, &tmp)) != MP_OKAY) { + if ((err = s_mp_sub(&tmp, a, &tmp)) != MP_OKAY) { mp_clear(&tmp); - return res; + return err; } *d = tmp.dp[0]; mp_clear(&tmp); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_2k_setup_l.c ================================================================== --- libtommath/bn_mp_reduce_2k_setup_l.c +++ libtommath/bn_mp_reduce_2k_setup_l.c @@ -1,41 +1,28 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_2K_SETUP_L_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* determines the setup value */ -int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) +mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) { - int res; + mp_err err; mp_int tmp; - if ((res = mp_init(&tmp)) != MP_OKAY) { - return res; + if ((err = mp_init(&tmp)) != MP_OKAY) { + return err; } - if ((res = mp_2expt(&tmp, mp_count_bits(a))) != MP_OKAY) { + if ((err = mp_2expt(&tmp, mp_count_bits(a))) != MP_OKAY) { goto LBL_ERR; } - if ((res = s_mp_sub(&tmp, a, d)) != MP_OKAY) { + if ((err = s_mp_sub(&tmp, a, d)) != MP_OKAY) { goto LBL_ERR; } LBL_ERR: mp_clear(&tmp); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_is_2k.c ================================================================== --- libtommath/bn_mp_reduce_is_2k.c +++ libtommath/bn_mp_reduce_is_2k.c @@ -1,21 +1,12 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_IS_2K_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* determines if mp_reduce_2k can be used */ -int mp_reduce_is_2k(const mp_int *a) +mp_bool mp_reduce_is_2k(const mp_int *a) { int ix, iy, iw; mp_digit iz; if (a->used == 0) { @@ -26,24 +17,22 @@ iy = mp_count_bits(a); iz = 1; iw = 1; /* Test every bit from the second digit up, must be 1 */ - for (ix = DIGIT_BIT; ix < iy; ix++) { + for (ix = MP_DIGIT_BIT; ix < iy; ix++) { if ((a->dp[iw] & iz) == 0u) { return MP_NO; } iz <<= 1; - if (iz > (mp_digit)MP_MASK) { + if (iz > MP_DIGIT_MAX) { ++iw; iz = 1; } } + return MP_YES; + } else { + return MP_YES; } - return MP_YES; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_is_2k_l.c ================================================================== --- libtommath/bn_mp_reduce_is_2k_l.c +++ libtommath/bn_mp_reduce_is_2k_l.c @@ -1,21 +1,12 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_IS_2K_L_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* determines if reduce_2k_l can be used */ -int mp_reduce_is_2k_l(const mp_int *a) +mp_bool mp_reduce_is_2k_l(const mp_int *a) { int ix, iy; if (a->used == 0) { return MP_NO; @@ -22,20 +13,16 @@ } else if (a->used == 1) { return MP_YES; } else if (a->used > 1) { /* if more than half of the digits are -1 we're sold */ for (iy = ix = 0; ix < a->used; ix++) { - if (a->dp[ix] == MP_MASK) { + if (a->dp[ix] == MP_DIGIT_MAX) { ++iy; } } return (iy >= (a->used/2)) ? MP_YES : MP_NO; - + } else { + return MP_NO; } - return MP_NO; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_reduce_setup.c ================================================================== --- libtommath/bn_mp_reduce_setup.c +++ libtommath/bn_mp_reduce_setup.c @@ -1,31 +1,17 @@ #include "tommath_private.h" #ifdef BN_MP_REDUCE_SETUP_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* pre-calculate the value required for Barrett reduction * For a given modulus "b" it calulates the value required in "a" */ -int mp_reduce_setup(mp_int *a, const mp_int *b) +mp_err mp_reduce_setup(mp_int *a, const mp_int *b) { - int res; - - if ((res = mp_2expt(a, b->used * 2 * DIGIT_BIT)) != MP_OKAY) { - return res; + mp_err err; + if ((err = mp_2expt(a, b->used * 2 * MP_DIGIT_BIT)) != MP_OKAY) { + return err; } return mp_div(a, b, a, NULL); } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_root_u32.c Index: libtommath/bn_mp_root_u32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_root_u32.c @@ -0,0 +1,139 @@ +#include "tommath_private.h" +#ifdef BN_MP_ROOT_U32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* find the n'th root of an integer + * + * Result found such that (c)**b <= a and (c+1)**b > a + * + * This algorithm uses Newton's approximation + * x[i+1] = x[i] - f(x[i])/f'(x[i]) + * which will find the root in log(N) time where + * each step involves a fair bit. + */ +mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) +{ + mp_int t1, t2, t3, a_; + mp_ord cmp; + int ilog2; + mp_err err; + + /* input must be positive if b is even */ + if (((b & 1u) == 0u) && (a->sign == MP_NEG)) { + return MP_VAL; + } + + if ((err = mp_init_multi(&t1, &t2, &t3, NULL)) != MP_OKAY) { + return err; + } + + /* if a is negative fudge the sign but keep track */ + a_ = *a; + a_.sign = MP_ZPOS; + + /* Compute seed: 2^(log_2(n)/b + 2)*/ + ilog2 = mp_count_bits(a); + + /* + If "b" is larger than INT_MAX it is also larger than + log_2(n) because the bit-length of the "n" is measured + with an int and hence the root is always < 2 (two). + */ + if (b > (uint32_t)(INT_MAX/2)) { + mp_set(c, 1uL); + c->sign = a->sign; + err = MP_OKAY; + goto LBL_ERR; + } + + /* "b" is smaller than INT_MAX, we can cast safely */ + if (ilog2 < (int)b) { + mp_set(c, 1uL); + c->sign = a->sign; + err = MP_OKAY; + goto LBL_ERR; + } + ilog2 = ilog2 / ((int)b); + if (ilog2 == 0) { + mp_set(c, 1uL); + c->sign = a->sign; + err = MP_OKAY; + goto LBL_ERR; + } + /* Start value must be larger than root */ + ilog2 += 2; + if ((err = mp_2expt(&t2,ilog2)) != MP_OKAY) goto LBL_ERR; + do { + /* t1 = t2 */ + if ((err = mp_copy(&t2, &t1)) != MP_OKAY) goto LBL_ERR; + + /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */ + + /* t3 = t1**(b-1) */ + if ((err = mp_expt_u32(&t1, b - 1u, &t3)) != MP_OKAY) goto LBL_ERR; + + /* numerator */ + /* t2 = t1**b */ + if ((err = mp_mul(&t3, &t1, &t2)) != MP_OKAY) goto LBL_ERR; + + /* t2 = t1**b - a */ + if ((err = mp_sub(&t2, &a_, &t2)) != MP_OKAY) goto LBL_ERR; + + /* denominator */ + /* t3 = t1**(b-1) * b */ + if ((err = mp_mul_d(&t3, b, &t3)) != MP_OKAY) goto LBL_ERR; + + /* t3 = (t1**b - a)/(b * t1**(b-1)) */ + if ((err = mp_div(&t2, &t3, &t3, NULL)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&t1, &t3, &t2)) != MP_OKAY) goto LBL_ERR; + + /* + Number of rounds is at most log_2(root). If it is more it + got stuck, so break out of the loop and do the rest manually. + */ + if (ilog2-- == 0) { + break; + } + } while (mp_cmp(&t1, &t2) != MP_EQ); + + /* result can be off by a few so check */ + /* Loop beneath can overshoot by one if found root is smaller than actual root */ + for (;;) { + if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; + cmp = mp_cmp(&t2, &a_); + if (cmp == MP_EQ) { + err = MP_OKAY; + goto LBL_ERR; + } + if (cmp == MP_LT) { + if ((err = mp_add_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; + } else { + break; + } + } + /* correct overshoot from above or from recurrence */ + for (;;) { + if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; + if (mp_cmp(&t2, &a_) == MP_GT) { + if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; + } else { + break; + } + } + + /* set the result */ + mp_exch(&t1, c); + + /* set the sign of the result */ + c->sign = a->sign; + + err = MP_OKAY; + +LBL_ERR: + mp_clear_multi(&t1, &t2, &t3, NULL); + return err; +} + +#endif Index: libtommath/bn_mp_rshd.c ================================================================== --- libtommath/bn_mp_rshd.c +++ libtommath/bn_mp_rshd.c @@ -1,23 +1,15 @@ #include "tommath_private.h" #ifdef BN_MP_RSHD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* shift right a certain amount of digits */ void mp_rshd(mp_int *a, int b) { int x; + mp_digit *bottom, *top; /* if b <= 0 then ignore it */ if (b <= 0) { return; } @@ -26,44 +18,34 @@ if (a->used <= b) { mp_zero(a); return; } - { - mp_digit *bottom, *top; - - /* shift the digits down */ - - /* bottom */ - bottom = a->dp; - - /* top [offset into digits] */ - top = a->dp + b; - - /* this is implemented as a sliding window where - * the window is b-digits long and digits from - * the top of the window are copied to the bottom - * - * e.g. - - b-2 | b-1 | b0 | b1 | b2 | ... | bb | ----> - /\ | ----> - \-------------------/ ----> - */ - for (x = 0; x < (a->used - b); x++) { - *bottom++ = *top++; - } - - /* zero the top digits */ - for (; x < a->used; x++) { - *bottom++ = 0; - } - } + /* shift the digits down */ + + /* bottom */ + bottom = a->dp; + + /* top [offset into digits] */ + top = a->dp + b; + + /* this is implemented as a sliding window where + * the window is b-digits long and digits from + * the top of the window are copied to the bottom + * + * e.g. + + b-2 | b-1 | b0 | b1 | b2 | ... | bb | ----> + /\ | ----> + \-------------------/ ----> + */ + for (x = 0; x < (a->used - b); x++) { + *bottom++ = *top++; + } + + /* zero the top digits */ + MP_ZERO_DIGITS(bottom, a->used - x); /* remove excess digits */ a->used -= b; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_sbin_size.c Index: libtommath/bn_mp_sbin_size.c ================================================================== --- /dev/null +++ libtommath/bn_mp_sbin_size.c @@ -0,0 +1,11 @@ +#include "tommath_private.h" +#ifdef BN_MP_SBIN_SIZE_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* get the size for an signed equivalent */ +size_t mp_sbin_size(const mp_int *a) +{ + return 1u + mp_ubin_size(a); +} +#endif Index: libtommath/bn_mp_set.c ================================================================== --- libtommath/bn_mp_set.c +++ libtommath/bn_mp_set.c @@ -1,26 +1,14 @@ #include "tommath_private.h" #ifdef BN_MP_SET_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* set to a digit */ void mp_set(mp_int *a, mp_digit b) { - mp_zero(a); a->dp[0] = b & MP_MASK; + a->sign = MP_ZPOS; a->used = (a->dp[0] != 0u) ? 1 : 0; + MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_set_double.c ================================================================== --- libtommath/bn_mp_set_double.c +++ libtommath/bn_mp_set_double.c @@ -1,49 +1,38 @@ #include "tommath_private.h" #ifdef BN_MP_SET_DOUBLE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559) -int mp_set_double(mp_int *a, double b) +mp_err mp_set_double(mp_int *a, double b) { - unsigned long long frac; - int exp, res; + uint64_t frac; + int exp; + mp_err err; union { double dbl; - unsigned long long bits; + uint64_t bits; } cast; cast.dbl = b; - exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFU); - frac = (cast.bits & ((1ULL << 52) - 1ULL)) | (1ULL << 52); + exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFu); + frac = (cast.bits & (((uint64_t)1 << 52) - (uint64_t)1)) | ((uint64_t)1 << 52); if (exp == 0x7FF) { /* +-inf, NaN */ return MP_VAL; } exp -= 1023 + 52; - res = mp_set_long_long(a, frac); - if (res != MP_OKAY) { - return res; + mp_set_u64(a, frac); + + err = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a); + if (err != MP_OKAY) { + return err; } - res = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a); - if (res != MP_OKAY) { - return res; - } - - if (((cast.bits >> 63) != 0ULL) && !IS_ZERO(a)) { + if (((cast.bits >> 63) != 0u) && !MP_IS_ZERO(a)) { a->sign = MP_NEG; } return MP_OKAY; } @@ -54,9 +43,5 @@ # else # warning "mp_set_double implementation is only available on platforms with IEEE754 floating point format" # endif #endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_set_i32.c Index: libtommath/bn_mp_set_i32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_i32.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_I32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_SIGNED(mp_set_i32, mp_set_u32, int32_t, uint32_t) +#endif ADDED libtommath/bn_mp_set_i64.c Index: libtommath/bn_mp_set_i64.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_i64.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_I64_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_SIGNED(mp_set_i64, mp_set_u64, int64_t, uint64_t) +#endif DELETED libtommath/bn_mp_set_int.c Index: libtommath/bn_mp_set_int.c ================================================================== --- libtommath/bn_mp_set_int.c +++ /dev/null @@ -1,45 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_SET_INT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* set a 32-bit const */ -int mp_set_int(mp_int *a, unsigned long b) -{ - int x, res; - - mp_zero(a); - - /* set four bits at a time */ - for (x = 0; x < 8; x++) { - /* shift the number up four bits */ - if ((res = mp_mul_2d(a, 4, a)) != MP_OKAY) { - return res; - } - - /* OR in the top four bits of the source */ - a->dp[0] |= (mp_digit)(b >> 28) & 15uL; - - /* shift the source up to the next four bits */ - b <<= 4; - - /* ensure that digits are not clamped off */ - a->used += 1; - } - mp_clamp(a); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_set_l.c Index: libtommath/bn_mp_set_l.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_l.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_L_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_SIGNED(mp_set_l, mp_set_ul, long, unsigned long) +#endif ADDED libtommath/bn_mp_set_ll.c Index: libtommath/bn_mp_set_ll.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_ll.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_LL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_SIGNED(mp_set_ll, mp_set_ull, long long, unsigned long long) +#endif DELETED libtommath/bn_mp_set_long.c Index: libtommath/bn_mp_set_long.c ================================================================== --- libtommath/bn_mp_set_long.c +++ /dev/null @@ -1,21 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_SET_LONG_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* set a platform dependent unsigned long int */ -MP_SET_XLONG(mp_set_long, unsigned long) -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_set_long_long.c Index: libtommath/bn_mp_set_long_long.c ================================================================== --- libtommath/bn_mp_set_long_long.c +++ /dev/null @@ -1,21 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_SET_LONG_LONG_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* set a platform dependent unsigned long long int */ -MP_SET_XLONG(mp_set_long_long, Tcl_WideUInt) -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_set_u32.c Index: libtommath/bn_mp_set_u32.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_u32.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_U32_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_UNSIGNED(mp_set_u32, uint32_t) +#endif ADDED libtommath/bn_mp_set_u64.c Index: libtommath/bn_mp_set_u64.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_u64.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_U64_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_UNSIGNED(mp_set_u64, uint64_t) +#endif ADDED libtommath/bn_mp_set_ul.c Index: libtommath/bn_mp_set_ul.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_ul.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_UL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_UNSIGNED(mp_set_ul, unsigned long) +#endif ADDED libtommath/bn_mp_set_ull.c Index: libtommath/bn_mp_set_ull.c ================================================================== --- /dev/null +++ libtommath/bn_mp_set_ull.c @@ -0,0 +1,7 @@ +#include "tommath_private.h" +#ifdef BN_MP_SET_ULL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +MP_SET_UNSIGNED(mp_set_ull, unsigned long long) +#endif Index: libtommath/bn_mp_shrink.c ================================================================== --- libtommath/bn_mp_shrink.c +++ libtommath/bn_mp_shrink.c @@ -1,40 +1,22 @@ #include "tommath_private.h" #ifdef BN_MP_SHRINK_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* shrink a bignum */ -int mp_shrink(mp_int *a) +mp_err mp_shrink(mp_int *a) { mp_digit *tmp; - int used = 1; - - if (a->used > 0) { - used = a->used; - } - - if (a->alloc != used) { - if ((tmp = (mp_digit *) XREALLOC(a->dp, - (size_t)a->alloc * sizeof (mp_digit), - (size_t)used * sizeof(mp_digit))) == NULL) { + int alloc = MP_MAX(MP_MIN_PREC, a->used); + if (a->alloc != alloc) { + if ((tmp = (mp_digit *) MP_REALLOC(a->dp, + (size_t)a->alloc * sizeof(mp_digit), + (size_t)alloc * sizeof(mp_digit))) == NULL) { return MP_MEM; } a->dp = tmp; - a->alloc = used; + a->alloc = alloc; } return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_signed_bin_size.c Index: libtommath/bn_mp_signed_bin_size.c ================================================================== --- libtommath/bn_mp_signed_bin_size.c +++ /dev/null @@ -1,24 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_SIGNED_BIN_SIZE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* get the size for an signed equivalent */ -int mp_signed_bin_size(const mp_int *a) -{ - return 1 + mp_unsigned_bin_size(a); -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_sqr.c ================================================================== --- libtommath/bn_mp_sqr.c +++ libtommath/bn_mp_sqr.c @@ -1,56 +1,28 @@ #include "tommath_private.h" #ifdef BN_MP_SQR_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* computes b = a*a */ -int mp_sqr(const mp_int *a, mp_int *b) -{ - int res; - -#ifdef BN_MP_TOOM_SQR_C - /* use Toom-Cook? */ - if (a->used >= TOOM_SQR_CUTOFF) { - res = mp_toom_sqr(a, b); - /* Karatsuba? */ - } else -#endif -#ifdef BN_MP_KARATSUBA_SQR_C - if (a->used >= KARATSUBA_SQR_CUTOFF) { - res = mp_karatsuba_sqr(a, b); - } else -#endif - { -#ifdef BN_FAST_S_MP_SQR_C - /* can we use the fast comba multiplier? */ - if ((((a->used * 2) + 1) < (int)MP_WARRAY) && - (a->used < - (int)(1u << (((sizeof(mp_word) * (size_t)CHAR_BIT) - (2u * (size_t)DIGIT_BIT)) - 1u)))) { - res = fast_s_mp_sqr(a, b); - } else -#endif - { -#ifdef BN_S_MP_SQR_C - res = s_mp_sqr(a, b); -#else - res = MP_VAL; -#endif - } - } - b->sign = MP_ZPOS; - return res; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ +mp_err mp_sqr(const mp_int *a, mp_int *b) +{ + mp_err err; + if (MP_HAS(S_MP_TOOM_SQR) && /* use Toom-Cook? */ + (a->used >= MP_TOOM_SQR_CUTOFF)) { + err = s_mp_toom_sqr(a, b); + } else if (MP_HAS(S_MP_KARATSUBA_SQR) && /* Karatsuba? */ + (a->used >= MP_KARATSUBA_SQR_CUTOFF)) { + err = s_mp_karatsuba_sqr(a, b); + } else if (MP_HAS(S_MP_SQR_FAST) && /* can we use the fast comba multiplier? */ + (((a->used * 2) + 1) < MP_WARRAY) && + (a->used < (MP_MAXFAST / 2))) { + err = s_mp_sqr_fast(a, b); + } else if (MP_HAS(S_MP_SQR)) { + err = s_mp_sqr(a, b); + } else { + err = MP_VAL; + } + b->sign = MP_ZPOS; + return err; +} +#endif Index: libtommath/bn_mp_sqrmod.c ================================================================== --- libtommath/bn_mp_sqrmod.c +++ libtommath/bn_mp_sqrmod.c @@ -1,37 +1,25 @@ #include "tommath_private.h" #ifdef BN_MP_SQRMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* c = a * a (mod b) */ -int mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) +mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) { - int res; + mp_err err; mp_int t; - if ((res = mp_init(&t)) != MP_OKAY) { - return res; - } - - if ((res = mp_sqr(a, &t)) != MP_OKAY) { - mp_clear(&t); - return res; - } - res = mp_mod(&t, b, c); - mp_clear(&t); - return res; + if ((err = mp_init(&t)) != MP_OKAY) { + return err; + } + + if ((err = mp_sqr(a, &t)) != MP_OKAY) { + goto LBL_ERR; + } + err = mp_mod(&t, b, c); + +LBL_ERR: + mp_clear(&t); + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_sqrt.c ================================================================== --- libtommath/bn_mp_sqrt.c +++ libtommath/bn_mp_sqrt.c @@ -1,30 +1,21 @@ #include "tommath_private.h" #ifdef BN_MP_SQRT_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #ifndef NO_FLOATING_POINT #include -#if (DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024) +#if (MP_DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024) #define NO_FLOATING_POINT #endif #endif /* this function is less generic than mp_n_root, simpler and faster */ -int mp_sqrt(const mp_int *arg, mp_int *ret) +mp_err mp_sqrt(const mp_int *arg, mp_int *ret) { - int res; + mp_err err; mp_int t1, t2; #ifndef NO_FLOATING_POINT int i, j, k; volatile double d; mp_digit dig; @@ -34,24 +25,24 @@ if (arg->sign == MP_NEG) { return MP_VAL; } /* easy out */ - if (mp_iszero(arg) == MP_YES) { + if (MP_IS_ZERO(arg)) { mp_zero(ret); return MP_OKAY; } #ifndef NO_FLOATING_POINT i = (arg->used / 2) - 1; j = 2 * i; - if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) { - return res; + if ((err = mp_init_size(&t1, i+2)) != MP_OKAY) { + return err; } - if ((res = mp_init(&t2)) != MP_OKAY) { + if ((err = mp_init(&t2)) != MP_OKAY) { goto E2; } for (k = 0; k < i; ++k) { t1.dp[k] = (mp_digit) 0; @@ -59,11 +50,11 @@ /* Estimate the square root using the hardware floating point unit. */ d = 0.0; for (k = arg->used-1; k >= j; --k) { - d = ldexp(d, DIGIT_BIT) + (double)(arg->dp[k]); + d = ldexp(d, MP_DIGIT_BIT) + (double)(arg->dp[k]); } /* * At this point, d is the nearest floating point number to the most * significant 1 or 2 mp_digits of arg. Extract its square root. @@ -71,22 +62,22 @@ d = sqrt(d); /* dig is the most significant mp_digit of the square root */ - dig = (mp_digit) ldexp(d, -DIGIT_BIT); + dig = (mp_digit) ldexp(d, -MP_DIGIT_BIT); /* * If the most significant digit is nonzero, find the next digit down - * by subtracting DIGIT_BIT times thie most significant digit. + * by subtracting MP_DIGIT_BIT times thie most significant digit. * Subtract one from the result so that our initial estimate is always * low. */ if (dig) { t1.used = i+2; - d -= ldexp((double) dig, DIGIT_BIT); + d -= ldexp((double) dig, MP_DIGIT_BIT); if (d >= 1.0) { t1.dp[i+1] = dig; t1.dp[i] = ((mp_digit) d) - 1; } else { t1.dp[i+1] = dig-1; @@ -97,42 +88,42 @@ t1.dp[i] = ((mp_digit) d) - 1; } #else - if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) { - return res; + if ((err = mp_init_copy(&t1, arg)) != MP_OKAY) { + return err; } - if ((res = mp_init(&t2)) != MP_OKAY) { + if ((err = mp_init(&t2)) != MP_OKAY) { goto E2; } /* First approx. (not very bad for large arg) */ mp_rshd(&t1, t1.used/2); #endif /* t1 > 0 */ - if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { + if ((err = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { goto E1; } - if ((res = mp_add(&t1, &t2, &t1)) != MP_OKAY) { + if ((err = mp_add(&t1, &t2, &t1)) != MP_OKAY) { goto E1; } - if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) { + if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) { goto E1; } /* And now t1 > sqrt(arg) */ do { - if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { + if ((err = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { goto E1; } - if ((res = mp_add(&t1, &t2, &t1)) != MP_OKAY) { + if ((err = mp_add(&t1, &t2, &t1)) != MP_OKAY) { goto E1; } - if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) { + if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) { goto E1; } /* t1 >= sqrt(arg) >= t2 at this point */ } while (mp_cmp_mag(&t1, &t2) == MP_GT); @@ -140,13 +131,9 @@ E1: mp_clear(&t2); E2: mp_clear(&t1); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_sqrtmod_prime.c ================================================================== --- libtommath/bn_mp_sqrtmod_prime.c +++ libtommath/bn_mp_sqrtmod_prime.c @@ -1,131 +1,118 @@ #include "tommath_private.h" #ifdef BN_MP_SQRTMOD_PRIME_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* Tonelli-Shanks algorithm * https://en.wikipedia.org/wiki/Tonelli%E2%80%93Shanks_algorithm * https://gmplib.org/list-archives/gmp-discuss/2013-April/005300.html * */ -int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) +mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) { - int res, legendre; + mp_err err; + int legendre; mp_int t1, C, Q, S, Z, M, T, R, two; mp_digit i; /* first handle the simple cases */ if (mp_cmp_d(n, 0uL) == MP_EQ) { mp_zero(ret); return MP_OKAY; } if (mp_cmp_d(prime, 2uL) == MP_EQ) return MP_VAL; /* prime must be odd */ - if ((res = mp_jacobi(n, prime, &legendre)) != MP_OKAY) return res; + if ((err = mp_kronecker(n, prime, &legendre)) != MP_OKAY) return err; if (legendre == -1) return MP_VAL; /* quadratic non-residue mod prime */ - if ((res = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL)) != MP_OKAY) { - return res; + if ((err = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL)) != MP_OKAY) { + return err; } /* SPECIAL CASE: if prime mod 4 == 3 - * compute directly: res = n^(prime+1)/4 mod prime + * compute directly: err = n^(prime+1)/4 mod prime * Handbook of Applied Cryptography algorithm 3.36 */ - if ((res = mp_mod_d(prime, 4uL, &i)) != MP_OKAY) goto cleanup; + if ((err = mp_mod_d(prime, 4uL, &i)) != MP_OKAY) goto cleanup; if (i == 3u) { - if ((res = mp_add_d(prime, 1uL, &t1)) != MP_OKAY) goto cleanup; - if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; - if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; - if ((res = mp_exptmod(n, &t1, prime, ret)) != MP_OKAY) goto cleanup; - res = MP_OKAY; + if ((err = mp_add_d(prime, 1uL, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(n, &t1, prime, ret)) != MP_OKAY) goto cleanup; + err = MP_OKAY; goto cleanup; } /* NOW: Tonelli-Shanks algorithm */ /* factor out powers of 2 from prime-1, defining Q and S as: prime-1 = Q*2^S */ - if ((res = mp_copy(prime, &Q)) != MP_OKAY) goto cleanup; - if ((res = mp_sub_d(&Q, 1uL, &Q)) != MP_OKAY) goto cleanup; + if ((err = mp_copy(prime, &Q)) != MP_OKAY) goto cleanup; + if ((err = mp_sub_d(&Q, 1uL, &Q)) != MP_OKAY) goto cleanup; /* Q = prime - 1 */ mp_zero(&S); /* S = 0 */ - while (mp_iseven(&Q) != MP_NO) { - if ((res = mp_div_2(&Q, &Q)) != MP_OKAY) goto cleanup; + while (MP_IS_EVEN(&Q)) { + if ((err = mp_div_2(&Q, &Q)) != MP_OKAY) goto cleanup; /* Q = Q / 2 */ - if ((res = mp_add_d(&S, 1uL, &S)) != MP_OKAY) goto cleanup; + if ((err = mp_add_d(&S, 1uL, &S)) != MP_OKAY) goto cleanup; /* S = S + 1 */ } /* find a Z such that the Legendre symbol (Z|prime) == -1 */ - if ((res = mp_set_int(&Z, 2uL)) != MP_OKAY) goto cleanup; + mp_set_u32(&Z, 2u); /* Z = 2 */ - while (1) { - if ((res = mp_jacobi(&Z, prime, &legendre)) != MP_OKAY) goto cleanup; + for (;;) { + if ((err = mp_kronecker(&Z, prime, &legendre)) != MP_OKAY) goto cleanup; if (legendre == -1) break; - if ((res = mp_add_d(&Z, 1uL, &Z)) != MP_OKAY) goto cleanup; + if ((err = mp_add_d(&Z, 1uL, &Z)) != MP_OKAY) goto cleanup; /* Z = Z + 1 */ } - if ((res = mp_exptmod(&Z, &Q, prime, &C)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(&Z, &Q, prime, &C)) != MP_OKAY) goto cleanup; /* C = Z ^ Q mod prime */ - if ((res = mp_add_d(&Q, 1uL, &t1)) != MP_OKAY) goto cleanup; - if ((res = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_add_d(&Q, 1uL, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) goto cleanup; /* t1 = (Q + 1) / 2 */ - if ((res = mp_exptmod(n, &t1, prime, &R)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(n, &t1, prime, &R)) != MP_OKAY) goto cleanup; /* R = n ^ ((Q + 1) / 2) mod prime */ - if ((res = mp_exptmod(n, &Q, prime, &T)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(n, &Q, prime, &T)) != MP_OKAY) goto cleanup; /* T = n ^ Q mod prime */ - if ((res = mp_copy(&S, &M)) != MP_OKAY) goto cleanup; + if ((err = mp_copy(&S, &M)) != MP_OKAY) goto cleanup; /* M = S */ - if ((res = mp_set_int(&two, 2uL)) != MP_OKAY) goto cleanup; + mp_set_u32(&two, 2u); - res = MP_VAL; - while (1) { - if ((res = mp_copy(&T, &t1)) != MP_OKAY) goto cleanup; + for (;;) { + if ((err = mp_copy(&T, &t1)) != MP_OKAY) goto cleanup; i = 0; - while (1) { + for (;;) { if (mp_cmp_d(&t1, 1uL) == MP_EQ) break; - if ((res = mp_exptmod(&t1, &two, prime, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(&t1, &two, prime, &t1)) != MP_OKAY) goto cleanup; i++; } if (i == 0u) { - if ((res = mp_copy(&R, ret)) != MP_OKAY) goto cleanup; - res = MP_OKAY; + if ((err = mp_copy(&R, ret)) != MP_OKAY) goto cleanup; + err = MP_OKAY; goto cleanup; } - if ((res = mp_sub_d(&M, i, &t1)) != MP_OKAY) goto cleanup; - if ((res = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto cleanup; - if ((res = mp_exptmod(&two, &t1, prime, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_sub_d(&M, i, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(&two, &t1, prime, &t1)) != MP_OKAY) goto cleanup; /* t1 = 2 ^ (M - i - 1) */ - if ((res = mp_exptmod(&C, &t1, prime, &t1)) != MP_OKAY) goto cleanup; + if ((err = mp_exptmod(&C, &t1, prime, &t1)) != MP_OKAY) goto cleanup; /* t1 = C ^ (2 ^ (M - i - 1)) mod prime */ - if ((res = mp_sqrmod(&t1, prime, &C)) != MP_OKAY) goto cleanup; + if ((err = mp_sqrmod(&t1, prime, &C)) != MP_OKAY) goto cleanup; /* C = (t1 * t1) mod prime */ - if ((res = mp_mulmod(&R, &t1, prime, &R)) != MP_OKAY) goto cleanup; + if ((err = mp_mulmod(&R, &t1, prime, &R)) != MP_OKAY) goto cleanup; /* R = (R * t1) mod prime */ - if ((res = mp_mulmod(&T, &C, prime, &T)) != MP_OKAY) goto cleanup; + if ((err = mp_mulmod(&T, &C, prime, &T)) != MP_OKAY) goto cleanup; /* T = (T * C) mod prime */ mp_set(&M, i); /* M = i */ } cleanup: mp_clear_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL); - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_sub.c ================================================================== --- libtommath/bn_mp_sub.c +++ libtommath/bn_mp_sub.c @@ -1,55 +1,40 @@ #include "tommath_private.h" #ifdef BN_MP_SUB_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* high level subtraction (handles signs) */ -int mp_sub(const mp_int *a, const mp_int *b, mp_int *c) +mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) { - int sa, sb, res; - - sa = a->sign; - sb = b->sign; + mp_sign sa = a->sign, sb = b->sign; + mp_err err; if (sa != sb) { /* subtract a negative from a positive, OR */ /* subtract a positive from a negative. */ /* In either case, ADD their magnitudes, */ /* and use the sign of the first number. */ c->sign = sa; - res = s_mp_add(a, b, c); + err = s_mp_add(a, b, c); } else { /* subtract a positive from a positive, OR */ /* subtract a negative from a negative. */ /* First, take the difference between their */ /* magnitudes, then... */ if (mp_cmp_mag(a, b) != MP_LT) { /* Copy the sign from the first */ c->sign = sa; /* The first has a larger or equal magnitude */ - res = s_mp_sub(a, b, c); + err = s_mp_sub(a, b, c); } else { /* The result has the *opposite* sign from */ /* the first number. */ c->sign = (sa == MP_ZPOS) ? MP_NEG : MP_ZPOS; /* The second has a larger magnitude */ - res = s_mp_sub(b, a, c); + err = s_mp_sub(b, a, c); } } - return res; + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_sub_d.c ================================================================== --- libtommath/bn_mp_sub_d.c +++ libtommath/bn_mp_sub_d.c @@ -1,45 +1,37 @@ #include "tommath_private.h" #ifdef BN_MP_SUB_D_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* single digit subtraction */ -int mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) +mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) { - mp_digit *tmpa, *tmpc, mu; - int res, ix, oldused; + mp_digit *tmpa, *tmpc; + mp_err err; + int ix, oldused; /* grow c as required */ if (c->alloc < (a->used + 1)) { - if ((res = mp_grow(c, a->used + 1)) != MP_OKAY) { - return res; + if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) { + return err; } } /* if a is negative just do an unsigned * addition [with fudged signs] */ if (a->sign == MP_NEG) { mp_int a_ = *a; a_.sign = MP_ZPOS; - res = mp_add_d(&a_, b, c); + err = mp_add_d(&a_, b, c); c->sign = MP_NEG; /* clamp */ mp_clamp(c); - return res; + return err; } /* setup regs */ oldused = c->used; tmpa = a->dp; @@ -56,35 +48,27 @@ /* negative/1digit */ c->sign = MP_NEG; c->used = 1; } else { + mp_digit mu = b; + /* positive/size */ c->sign = MP_ZPOS; c->used = a->used; - /* subtract first digit */ - *tmpc = *tmpa++ - b; - mu = *tmpc >> ((sizeof(mp_digit) * (size_t)CHAR_BIT) - 1u); - *tmpc++ &= MP_MASK; - - /* handle rest of the digits */ - for (ix = 1; ix < a->used; ix++) { + /* subtract digits, mu is carry */ + for (ix = 0; ix < a->used; ix++) { *tmpc = *tmpa++ - mu; - mu = *tmpc >> ((sizeof(mp_digit) * (size_t)CHAR_BIT) - 1u); + mu = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u); *tmpc++ &= MP_MASK; } } /* zero excess digits */ - while (ix++ < oldused) { - *tmpc++ = 0; - } + MP_ZERO_DIGITS(tmpc, oldused - ix); + mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_submod.c ================================================================== --- libtommath/bn_mp_submod.c +++ libtommath/bn_mp_submod.c @@ -1,38 +1,25 @@ #include "tommath_private.h" #ifdef BN_MP_SUBMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* d = a - b (mod c) */ -int mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) -{ - int res; - mp_int t; - - - if ((res = mp_init(&t)) != MP_OKAY) { - return res; - } - - if ((res = mp_sub(a, b, &t)) != MP_OKAY) { - mp_clear(&t); - return res; - } - res = mp_mod(&t, c, d); - mp_clear(&t); - return res; +mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) +{ + mp_err err; + mp_int t; + + if ((err = mp_init(&t)) != MP_OKAY) { + return err; + } + + if ((err = mp_sub(a, b, &t)) != MP_OKAY) { + goto LBL_ERR; + } + err = mp_mod(&t, c, d); + +LBL_ERR: + mp_clear(&t); + return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_to_radix.c Index: libtommath/bn_mp_to_radix.c ================================================================== --- /dev/null +++ libtommath/bn_mp_to_radix.c @@ -0,0 +1,84 @@ +#include "tommath_private.h" +#ifdef BN_MP_TO_RADIX_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* stores a bignum as a ASCII string in a given radix (2..64) + * + * Stores upto "size - 1" chars and always a NULL byte, puts the number of characters + * written, including the '\0', in "written". + */ +mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) +{ + size_t digs; + mp_err err; + mp_int t; + mp_digit d; + char *_s = str; + + /* check range of radix and size*/ + if (maxlen < 2u) { + return MP_BUF; + } + if ((radix < 2) || (radix > 64)) { + return MP_VAL; + } + + /* quick out if its zero */ + if (MP_IS_ZERO(a)) { + *str++ = '0'; + *str = '\0'; + if (written != NULL) { + *written = 2u; + } + return MP_OKAY; + } + + if ((err = mp_init_copy(&t, a)) != MP_OKAY) { + return err; + } + + /* if it is negative output a - */ + if (t.sign == MP_NEG) { + /* we have to reverse our digits later... but not the - sign!! */ + ++_s; + + /* store the flag and mark the number as positive */ + *str++ = '-'; + t.sign = MP_ZPOS; + + /* subtract a char */ + --maxlen; + } + digs = 0u; + while (!MP_IS_ZERO(&t)) { + if (--maxlen < 1u) { + /* no more room */ + err = MP_BUF; + goto LBL_ERR; + } + if ((err = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { + goto LBL_ERR; + } + *str++ = mp_s_rmap[d]; + ++digs; + } + /* reverse the digits of the string. In this case _s points + * to the first digit [exluding the sign] of the number + */ + s_mp_reverse((unsigned char *)_s, digs); + + /* append a NULL so the string is properly terminated */ + *str = '\0'; + digs++; + + if (written != NULL) { + *written = (a->sign == MP_NEG) ? (digs + 1u): digs; + } + +LBL_ERR: + mp_clear(&t); + return err; +} + +#endif ADDED libtommath/bn_mp_to_sbin.c Index: libtommath/bn_mp_to_sbin.c ================================================================== --- /dev/null +++ libtommath/bn_mp_to_sbin.c @@ -0,0 +1,22 @@ +#include "tommath_private.h" +#ifdef BN_MP_TO_SBIN_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* store in signed [big endian] format */ +mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) +{ + mp_err err; + if (maxlen == 0u) { + return MP_BUF; + } + if ((err = mp_to_ubin(a, buf + 1, maxlen - 1u, written)) != MP_OKAY) { + return err; + } + if (written != NULL) { + (*written)++; + } + buf[0] = (a->sign == MP_ZPOS) ? (unsigned char)0 : (unsigned char)1; + return MP_OKAY; +} +#endif DELETED libtommath/bn_mp_to_signed_bin.c Index: libtommath/bn_mp_to_signed_bin.c ================================================================== --- libtommath/bn_mp_to_signed_bin.c +++ /dev/null @@ -1,30 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TO_SIGNED_BIN_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* store in signed [big endian] format */ -int mp_to_signed_bin(const mp_int *a, unsigned char *b) -{ - int res; - - if ((res = mp_to_unsigned_bin(a, b + 1)) != MP_OKAY) { - return res; - } - b[0] = (a->sign == MP_ZPOS) ? (unsigned char)0 : (unsigned char)1; - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_to_signed_bin_n.c Index: libtommath/bn_mp_to_signed_bin_n.c ================================================================== --- libtommath/bn_mp_to_signed_bin_n.c +++ /dev/null @@ -1,28 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TO_SIGNED_BIN_N_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* store in signed [big endian] format */ -int mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) -{ - if (*outlen < (unsigned long)mp_signed_bin_size(a)) { - return MP_VAL; - } - *outlen = (unsigned long)mp_signed_bin_size(a); - return mp_to_signed_bin(a, b); -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_to_ubin.c Index: libtommath/bn_mp_to_ubin.c ================================================================== --- /dev/null +++ libtommath/bn_mp_to_ubin.c @@ -0,0 +1,41 @@ +#include "tommath_private.h" +#ifdef BN_MP_TO_UBIN_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* store in unsigned [big endian] format */ +mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) +{ + size_t x, count; + mp_err err; + mp_int t; + + count = mp_ubin_size(a); + if (count > maxlen) { + return MP_BUF; + } + + if ((err = mp_init_copy(&t, a)) != MP_OKAY) { + return err; + } + + for (x = count; x --> 0u;) { +#ifndef MP_8BIT + buf[x] = (unsigned char)(t.dp[0] & 255u); +#else + buf[x] = (unsigned char)(t.dp[0] | ((t.dp[1] & 1u) << 7)); +#endif + if ((err = mp_div_2d(&t, 8, &t, NULL)) != MP_OKAY) { + goto LBL_ERR; + } + } + + if (written != NULL) { + *written = count; + } + +LBL_ERR: + mp_clear(&t); + return err; +} +#endif DELETED libtommath/bn_mp_to_unsigned_bin.c Index: libtommath/bn_mp_to_unsigned_bin.c ================================================================== --- libtommath/bn_mp_to_unsigned_bin.c +++ /dev/null @@ -1,45 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TO_UNSIGNED_BIN_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* store in unsigned [big endian] format */ -int mp_to_unsigned_bin(const mp_int *a, unsigned char *b) -{ - int x, res; - mp_int t; - - if ((res = mp_init_copy(&t, a)) != MP_OKAY) { - return res; - } - - x = 0; - while (mp_iszero(&t) == MP_NO) { -#ifndef MP_8BIT - b[x++] = (unsigned char)(t.dp[0] & 255u); -#else - b[x++] = (unsigned char)(t.dp[0] | ((t.dp[1] & 1u) << 7)); -#endif - if ((res = mp_div_2d(&t, 8, &t, NULL)) != MP_OKAY) { - mp_clear(&t); - return res; - } - } - bn_reverse(b, x); - mp_clear(&t); - return MP_OKAY; -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_to_unsigned_bin_n.c Index: libtommath/bn_mp_to_unsigned_bin_n.c ================================================================== --- libtommath/bn_mp_to_unsigned_bin_n.c +++ /dev/null @@ -1,28 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TO_UNSIGNED_BIN_N_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* store in unsigned [big endian] format */ -int mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) -{ - if (*outlen < (unsigned long)mp_unsigned_bin_size(a)) { - return MP_VAL; - } - *outlen = (unsigned long)mp_unsigned_bin_size(a); - return mp_to_unsigned_bin(a, b); -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_toom_mul.c Index: libtommath/bn_mp_toom_mul.c ================================================================== --- libtommath/bn_mp_toom_mul.c +++ /dev/null @@ -1,283 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TOOM_MUL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* multiplication using the Toom-Cook 3-way algorithm - * - * Much more complicated than Karatsuba but has a lower - * asymptotic running time of O(N**1.464). This algorithm is - * only particularly useful on VERY large inputs - * (we're talking 1000s of digits here...). -*/ -int mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) -{ - mp_int w0, w1, w2, w3, w4, tmp1, tmp2, a0, a1, a2, b0, b1, b2; - int res, B; - - /* init temps */ - if ((res = mp_init_multi(&w0, &w1, &w2, &w3, &w4, - &a0, &a1, &a2, &b0, &b1, - &b2, &tmp1, &tmp2, NULL)) != MP_OKAY) { - return res; - } - - /* B */ - B = MIN(a->used, b->used) / 3; - - /* a = a2 * B**2 + a1 * B + a0 */ - if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_copy(a, &a1)) != MP_OKAY) { - goto LBL_ERR; - } - mp_rshd(&a1, B); - if ((res = mp_mod_2d(&a1, DIGIT_BIT * B, &a1)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_copy(a, &a2)) != MP_OKAY) { - goto LBL_ERR; - } - mp_rshd(&a2, B*2); - - /* b = b2 * B**2 + b1 * B + b0 */ - if ((res = mp_mod_2d(b, DIGIT_BIT * B, &b0)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_copy(b, &b1)) != MP_OKAY) { - goto LBL_ERR; - } - mp_rshd(&b1, B); - (void)mp_mod_2d(&b1, DIGIT_BIT * B, &b1); - - if ((res = mp_copy(b, &b2)) != MP_OKAY) { - goto LBL_ERR; - } - mp_rshd(&b2, B*2); - - /* w0 = a0*b0 */ - if ((res = mp_mul(&a0, &b0, &w0)) != MP_OKAY) { - goto LBL_ERR; - } - - /* w4 = a2 * b2 */ - if ((res = mp_mul(&a2, &b2, &w4)) != MP_OKAY) { - goto LBL_ERR; - } - - /* w1 = (a2 + 2(a1 + 2a0))(b2 + 2(b1 + 2b0)) */ - if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_mul_2(&b0, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp2, &b2, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_mul(&tmp1, &tmp2, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - - /* w3 = (a0 + 2(a1 + 2a2))(b0 + 2(b1 + 2b2)) */ - if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_mul_2(&b2, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_mul(&tmp1, &tmp2, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - - - /* w2 = (a2 + a1 + a0)(b2 + b1 + b0) */ - if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&b2, &b1, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul(&tmp1, &tmp2, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - - /* now solve the matrix - - 0 0 0 0 1 - 1 2 4 8 16 - 1 1 1 1 1 - 16 8 4 2 1 - 1 0 0 0 0 - - using 12 subtractions, 4 shifts, - 2 small divisions and 1 small multiplication - */ - - /* r1 - r4 */ - if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - r0 */ - if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1/2 */ - if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3/2 */ - if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r2 - r0 - r4 */ - if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1 - r2 */ - if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - r2 */ - if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1 - 8r0 */ - if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - 8r4 */ - if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* 3r2 - r1 - r3 */ - if ((res = mp_mul_d(&w2, 3uL, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1 - r2 */ - if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - r2 */ - if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1/3 */ - if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3/3 */ - if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) { - goto LBL_ERR; - } - - /* at this point shift W[n] by B*n */ - if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_add(&w0, &w1, c)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, c, c)) != MP_OKAY) { - goto LBL_ERR; - } - -LBL_ERR: - mp_clear_multi(&w0, &w1, &w2, &w3, &w4, - &a0, &a1, &a2, &b0, &b1, - &b2, &tmp1, &tmp2, NULL); - return res; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_toom_sqr.c Index: libtommath/bn_mp_toom_sqr.c ================================================================== --- libtommath/bn_mp_toom_sqr.c +++ /dev/null @@ -1,224 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TOOM_SQR_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* squaring using Toom-Cook 3-way algorithm */ -int mp_toom_sqr(const mp_int *a, mp_int *b) -{ - mp_int w0, w1, w2, w3, w4, tmp1, a0, a1, a2; - int res, B; - - /* init temps */ - if ((res = mp_init_multi(&w0, &w1, &w2, &w3, &w4, &a0, &a1, &a2, &tmp1, NULL)) != MP_OKAY) { - return res; - } - - /* B */ - B = a->used / 3; - - /* a = a2 * B**2 + a1 * B + a0 */ - if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_copy(a, &a1)) != MP_OKAY) { - goto LBL_ERR; - } - mp_rshd(&a1, B); - if ((res = mp_mod_2d(&a1, DIGIT_BIT * B, &a1)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_copy(a, &a2)) != MP_OKAY) { - goto LBL_ERR; - } - mp_rshd(&a2, B*2); - - /* w0 = a0*a0 */ - if ((res = mp_sqr(&a0, &w0)) != MP_OKAY) { - goto LBL_ERR; - } - - /* w4 = a2 * a2 */ - if ((res = mp_sqr(&a2, &w4)) != MP_OKAY) { - goto LBL_ERR; - } - - /* w1 = (a2 + 2(a1 + 2a0))**2 */ - if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sqr(&tmp1, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - - /* w3 = (a0 + 2(a1 + 2a2))**2 */ - if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_sqr(&tmp1, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - - - /* w2 = (a2 + a1 + a0)**2 */ - if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sqr(&tmp1, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - - /* now solve the matrix - - 0 0 0 0 1 - 1 2 4 8 16 - 1 1 1 1 1 - 16 8 4 2 1 - 1 0 0 0 0 - - using 12 subtractions, 4 shifts, 2 small divisions and 1 small multiplication. - */ - - /* r1 - r4 */ - if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - r0 */ - if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1/2 */ - if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3/2 */ - if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r2 - r0 - r4 */ - if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1 - r2 */ - if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - r2 */ - if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1 - 8r0 */ - if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - 8r4 */ - if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* 3r2 - r1 - r3 */ - if ((res = mp_mul_d(&w2, 3uL, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1 - r2 */ - if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3 - r2 */ - if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) { - goto LBL_ERR; - } - /* r1/3 */ - if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) { - goto LBL_ERR; - } - /* r3/3 */ - if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) { - goto LBL_ERR; - } - - /* at this point shift W[n] by B*n */ - if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) { - goto LBL_ERR; - } - - if ((res = mp_add(&w0, &w1, b)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) { - goto LBL_ERR; - } - if ((res = mp_add(&tmp1, b, b)) != MP_OKAY) { - goto LBL_ERR; - } - -LBL_ERR: - mp_clear_multi(&w0, &w1, &w2, &w3, &w4, &a0, &a1, &a2, &tmp1, NULL); - return res; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_toradix.c Index: libtommath/bn_mp_toradix.c ================================================================== --- libtommath/bn_mp_toradix.c +++ /dev/null @@ -1,72 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TORADIX_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* stores a bignum as a ASCII string in a given radix (2..64) */ -int mp_toradix(const mp_int *a, char *str, int radix) -{ - int res, digs; - mp_int t; - mp_digit d; - char *_s = str; - - /* check range of the radix */ - if ((radix < 2) || (radix > 64)) { - return MP_VAL; - } - - /* quick out if its zero */ - if (mp_iszero(a) == MP_YES) { - *str++ = '0'; - *str = '\0'; - return MP_OKAY; - } - - if ((res = mp_init_copy(&t, a)) != MP_OKAY) { - return res; - } - - /* if it is negative output a - */ - if (t.sign == MP_NEG) { - ++_s; - *str++ = '-'; - t.sign = MP_ZPOS; - } - - digs = 0; - while (mp_iszero(&t) == MP_NO) { - if ((res = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { - mp_clear(&t); - return res; - } - *str++ = mp_s_rmap[d]; - ++digs; - } - - /* reverse the digits of the string. In this case _s points - * to the first digit [exluding the sign] of the number] - */ - bn_reverse((unsigned char *)_s, digs); - - /* append a NULL so the string is properly terminated */ - *str = '\0'; - - mp_clear(&t); - return MP_OKAY; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ DELETED libtommath/bn_mp_toradix_n.c Index: libtommath/bn_mp_toradix_n.c ================================================================== --- libtommath/bn_mp_toradix_n.c +++ /dev/null @@ -1,85 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_TORADIX_N_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* stores a bignum as a ASCII string in a given radix (2..64) - * - * Stores upto maxlen-1 chars and always a NULL byte - */ -int mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) -{ - int res, digs; - mp_int t; - mp_digit d; - char *_s = str; - - /* check range of the maxlen, radix */ - if ((maxlen < 2) || (radix < 2) || (radix > 64)) { - return MP_VAL; - } - - /* quick out if its zero */ - if (mp_iszero(a) == MP_YES) { - *str++ = '0'; - *str = '\0'; - return MP_OKAY; - } - - if ((res = mp_init_copy(&t, a)) != MP_OKAY) { - return res; - } - - /* if it is negative output a - */ - if (t.sign == MP_NEG) { - /* we have to reverse our digits later... but not the - sign!! */ - ++_s; - - /* store the flag and mark the number as positive */ - *str++ = '-'; - t.sign = MP_ZPOS; - - /* subtract a char */ - --maxlen; - } - - digs = 0; - while (mp_iszero(&t) == MP_NO) { - if (--maxlen < 1) { - /* no more room */ - break; - } - if ((res = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) { - mp_clear(&t); - return res; - } - *str++ = mp_s_rmap[d]; - ++digs; - } - - /* reverse the digits of the string. In this case _s points - * to the first digit [exluding the sign] of the number - */ - bn_reverse((unsigned char *)_s, digs); - - /* append a NULL so the string is properly terminated */ - *str = '\0'; - - mp_clear(&t); - return MP_OKAY; -} - -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_mp_ubin_size.c Index: libtommath/bn_mp_ubin_size.c ================================================================== --- /dev/null +++ libtommath/bn_mp_ubin_size.c @@ -0,0 +1,12 @@ +#include "tommath_private.h" +#ifdef BN_MP_UBIN_SIZE_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* get the size for an unsigned equivalent */ +size_t mp_ubin_size(const mp_int *a) +{ + size_t size = (size_t)mp_count_bits(a); + return (size / 8u) + (((size & 7u) != 0u) ? 1u : 0u); +} +#endif ADDED libtommath/bn_mp_unpack.c Index: libtommath/bn_mp_unpack.c ================================================================== --- /dev/null +++ libtommath/bn_mp_unpack.c @@ -0,0 +1,49 @@ +#include "tommath_private.h" +#ifdef BN_MP_UNPACK_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* based on gmp's mpz_import. + * see http://gmplib.org/manual/Integer-Import-and-Export.html + */ +mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, + mp_endian endian, size_t nails, const void *op) +{ + mp_err err; + size_t odd_nails, nail_bytes, i, j; + unsigned char odd_nail_mask; + + mp_zero(rop); + + if (endian == MP_NATIVE_ENDIAN) { + MP_GET_ENDIANNESS(endian); + } + + odd_nails = (nails % 8u); + odd_nail_mask = 0xff; + for (i = 0; i < odd_nails; ++i) { + odd_nail_mask ^= (unsigned char)(1u << (7u - i)); + } + nail_bytes = nails / 8u; + + for (i = 0; i < count; ++i) { + for (j = 0; j < (size - nail_bytes); ++j) { + unsigned char byte = *((const unsigned char *)op + + (((order == MP_MSB_FIRST) ? i : ((count - 1u) - i)) * size) + + ((endian == MP_BIG_ENDIAN) ? (j + nail_bytes) : (((size - 1u) - j) - nail_bytes))); + + if ((err = mp_mul_2d(rop, (j == 0u) ? (int)(8u - odd_nails) : 8, rop)) != MP_OKAY) { + return err; + } + + rop->dp[0] |= (j == 0u) ? (mp_digit)(byte & odd_nail_mask) : (mp_digit)byte; + rop->used += 1; + } + } + + mp_clamp(rop); + + return MP_OKAY; +} + +#endif DELETED libtommath/bn_mp_unsigned_bin_size.c Index: libtommath/bn_mp_unsigned_bin_size.c ================================================================== --- libtommath/bn_mp_unsigned_bin_size.c +++ /dev/null @@ -1,25 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_UNSIGNED_BIN_SIZE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* get the size for an unsigned equivalent */ -int mp_unsigned_bin_size(const mp_int *a) -{ - int size = mp_count_bits(a); - return (size / 8) + ((((unsigned)size & 7u) != 0u) ? 1 : 0); -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_mp_xor.c ================================================================== --- libtommath/bn_mp_xor.c +++ libtommath/bn_mp_xor.c @@ -4,11 +4,11 @@ /* SPDX-License-Identifier: Unlicense */ /* two complement xor */ mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) { - int used = MAX(a->used, b->used) + 1, i; + int used = MP_MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = (a->sign != b->sign) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { Index: libtommath/bn_mp_zero.c ================================================================== --- libtommath/bn_mp_zero.c +++ libtommath/bn_mp_zero.c @@ -1,33 +1,13 @@ #include "tommath_private.h" #ifdef BN_MP_ZERO_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* set to zero */ void mp_zero(mp_int *a) { - int n; - mp_digit *tmp; - a->sign = MP_ZPOS; a->used = 0; - - tmp = a->dp; - for (n = 0; n < a->alloc; n++) { - *tmp++ = 0; - } + MP_ZERO_DIGITS(a->dp, a->alloc); } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_prime_tab.c ================================================================== --- libtommath/bn_prime_tab.c +++ libtommath/bn_prime_tab.c @@ -1,18 +1,9 @@ #include "tommath_private.h" #ifdef BN_PRIME_TAB_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ const mp_digit ltm_prime_tab[] = { 0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013, 0x0017, 0x001D, 0x001F, 0x0025, 0x0029, 0x002B, 0x002F, 0x0035, 0x003B, 0x003D, 0x0043, 0x0047, 0x0049, 0x004F, 0x0053, 0x0059, @@ -50,10 +41,21 @@ 0x05BF, 0x05C9, 0x05CB, 0x05CF, 0x05D1, 0x05D5, 0x05DB, 0x05E7, 0x05F3, 0x05FB, 0x0607, 0x060D, 0x0611, 0x0617, 0x061F, 0x0623, 0x062B, 0x062F, 0x063D, 0x0641, 0x0647, 0x0649, 0x064D, 0x0653 #endif }; + +#if defined(__GNUC__) && __GNUC__ >= 4 +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wdeprecated-declarations" +const mp_digit *s_mp_prime_tab = ltm_prime_tab; +#pragma GCC diagnostic pop +#elif defined(_MSC_VER) && _MSC_VER >= 1500 +#pragma warning(push) +#pragma warning(disable: 4996) +const mp_digit *s_mp_prime_tab = ltm_prime_tab; +#pragma warning(pop) +#else +const mp_digit *s_mp_prime_tab = ltm_prime_tab; #endif -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ +#endif DELETED libtommath/bn_reverse.c Index: libtommath/bn_reverse.c ================================================================== --- libtommath/bn_reverse.c +++ /dev/null @@ -1,35 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_REVERSE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* reverse an array, used for radix code */ -void bn_reverse(unsigned char *s, int len) -{ - int ix, iy; - unsigned char t; - - ix = 0; - iy = len - 1; - while (ix < iy) { - t = s[ix]; - s[ix] = s[iy]; - s[iy] = t; - ++ix; - --iy; - } -} -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/bn_s_mp_add.c ================================================================== --- libtommath/bn_s_mp_add.c +++ libtommath/bn_s_mp_add.c @@ -1,24 +1,16 @@ #include "tommath_private.h" #ifdef BN_S_MP_ADD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* low level addition, based on HAC pp.594, Algorithm 14.7 */ -int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) +mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) { const mp_int *x; - int olduse, res, min, max; + mp_err err; + int olduse, min, max; /* find sizes, we let |a| <= |b| which means we have to sort * them. "x" will point to the input with the most digits */ if (a->used > b->used) { @@ -31,12 +23,12 @@ x = b; } /* init result */ if (c->alloc < (max + 1)) { - if ((res = mp_grow(c, max + 1)) != MP_OKAY) { - return res; + if ((err = mp_grow(c, max + 1)) != MP_OKAY) { + return err; } } /* get old used digit count and set new one */ olduse = c->used; @@ -62,11 +54,11 @@ for (i = 0; i < min; i++) { /* Compute the sum at one digit, T[i] = A[i] + B[i] + U */ *tmpc = *tmpa++ + *tmpb++ + u; /* U = carry bit of T[i] */ - u = *tmpc >> (mp_digit)DIGIT_BIT; + u = *tmpc >> (mp_digit)MP_DIGIT_BIT; /* take away carry bit from T[i] */ *tmpc++ &= MP_MASK; } @@ -77,11 +69,11 @@ for (; i < max; i++) { /* T[i] = X[i] + U */ *tmpc = x->dp[i] + u; /* U = carry bit of T[i] */ - u = *tmpc >> (mp_digit)DIGIT_BIT; + u = *tmpc >> (mp_digit)MP_DIGIT_BIT; /* take away carry bit from T[i] */ *tmpc++ &= MP_MASK; } } @@ -88,18 +80,12 @@ /* add carry */ *tmpc++ = u; /* clear digits above oldused */ - for (i = c->used; i < olduse; i++) { - *tmpc++ = 0; - } + MP_ZERO_DIGITS(tmpc, olduse - c->used); } mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_s_mp_balance_mul.c Index: libtommath/bn_s_mp_balance_mul.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_balance_mul.c @@ -0,0 +1,81 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_BALANCE_MUL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* single-digit multiplication with the smaller number as the single-digit */ +mp_err s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + int count, len_a, len_b, nblocks, i, j, bsize; + mp_int a0, tmp, A, B, r; + mp_err err; + + len_a = a->used; + len_b = b->used; + + nblocks = MP_MAX(a->used, b->used) / MP_MIN(a->used, b->used); + bsize = MP_MIN(a->used, b->used) ; + + if ((err = mp_init_size(&a0, bsize + 2)) != MP_OKAY) { + return err; + } + if ((err = mp_init_multi(&tmp, &r, NULL)) != MP_OKAY) { + mp_clear(&a0); + return err; + } + + /* Make sure that A is the larger one*/ + if (len_a < len_b) { + B = *a; + A = *b; + } else { + A = *a; + B = *b; + } + + for (i = 0, j=0; i < nblocks; i++) { + /* Cut a slice off of a */ + a0.used = 0; + for (count = 0; count < bsize; count++) { + a0.dp[count] = A.dp[ j++ ]; + a0.used++; + } + mp_clamp(&a0); + /* Multiply with b */ + if ((err = mp_mul(&a0, &B, &tmp)) != MP_OKAY) { + goto LBL_ERR; + } + /* Shift tmp to the correct position */ + if ((err = mp_lshd(&tmp, bsize * i)) != MP_OKAY) { + goto LBL_ERR; + } + /* Add to output. No carry needed */ + if ((err = mp_add(&r, &tmp, &r)) != MP_OKAY) { + goto LBL_ERR; + } + } + /* The left-overs; there are always left-overs */ + if (j < A.used) { + a0.used = 0; + for (count = 0; j < A.used; count++) { + a0.dp[count] = A.dp[ j++ ]; + a0.used++; + } + mp_clamp(&a0); + if ((err = mp_mul(&a0, &B, &tmp)) != MP_OKAY) { + goto LBL_ERR; + } + if ((err = mp_lshd(&tmp, bsize * i)) != MP_OKAY) { + goto LBL_ERR; + } + if ((err = mp_add(&r, &tmp, &r)) != MP_OKAY) { + goto LBL_ERR; + } + } + + mp_exch(&r,c); +LBL_ERR: + mp_clear_multi(&a0, &tmp, &r,NULL); + return err; +} +#endif Index: libtommath/bn_s_mp_exptmod.c ================================================================== --- libtommath/bn_s_mp_exptmod.c +++ libtommath/bn_s_mp_exptmod.c @@ -1,31 +1,25 @@ #include "tommath_private.h" #ifdef BN_S_MP_EXPTMOD_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #ifdef MP_LOW_MEM # define TAB_SIZE 32 +# define MAX_WINSIZE 5 #else # define TAB_SIZE 256 +# define MAX_WINSIZE 0 #endif -int s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) +mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) { mp_int M[TAB_SIZE], res, mu; mp_digit buf; - int err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize; - int (*redux)(mp_int *x, const mp_int *m, const mp_int *mu); + mp_err err; + int bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize; + mp_err(*redux)(mp_int *x, const mp_int *m, const mp_int *mu); /* find window size */ x = mp_count_bits(X); if (x <= 7) { winsize = 2; @@ -41,15 +35,11 @@ winsize = 7; } else { winsize = 8; } -#ifdef MP_LOW_MEM - if (winsize > 5) { - winsize = 5; - } -#endif + winsize = MAX_WINSIZE ? MP_MIN(MAX_WINSIZE, winsize) : winsize; /* init M array */ /* init first cell */ if ((err = mp_init(&M[1])) != MP_OKAY) { return err; @@ -65,23 +55,17 @@ return err; } } /* create mu, used for Barrett reduction */ - if ((err = mp_init(&mu)) != MP_OKAY) { - goto LBL_M; - } + if ((err = mp_init(&mu)) != MP_OKAY) goto LBL_M; if (redmode == 0) { - if ((err = mp_reduce_setup(&mu, P)) != MP_OKAY) { - goto LBL_MU; - } + if ((err = mp_reduce_setup(&mu, P)) != MP_OKAY) goto LBL_MU; redux = mp_reduce; } else { - if ((err = mp_reduce_2k_setup_l(P, &mu)) != MP_OKAY) { - goto LBL_MU; - } + if ((err = mp_reduce_2k_setup_l(P, &mu)) != MP_OKAY) goto LBL_MU; redux = mp_reduce_2k_l; } /* create M table * @@ -89,50 +73,36 @@ * e.g. M[x] = G**x mod P * * The first half of the table is not * computed though accept for M[0] and M[1] */ - if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) { - goto LBL_MU; - } + if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) goto LBL_MU; /* compute the value at M[1<<(winsize-1)] by squaring * M[1] (winsize-1) times */ - if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) { - goto LBL_MU; - } + if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_MU; for (x = 0; x < (winsize - 1); x++) { /* square it */ if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)], - &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) { - goto LBL_MU; - } + &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_MU; /* reduce modulo P */ - if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, &mu)) != MP_OKAY) { - goto LBL_MU; - } + if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, &mu)) != MP_OKAY) goto LBL_MU; } /* create upper table, that is M[x] = M[x-1] * M[1] (mod P) * for x = (2**(winsize - 1) + 1) to (2**winsize - 1) */ for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) { - if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY) { - goto LBL_MU; - } - if ((err = redux(&M[x], P, &mu)) != MP_OKAY) { - goto LBL_MU; - } + if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY) goto LBL_MU; + if ((err = redux(&M[x], P, &mu)) != MP_OKAY) goto LBL_MU; } /* setup result */ - if ((err = mp_init(&res)) != MP_OKAY) { - goto LBL_MU; - } + if ((err = mp_init(&res)) != MP_OKAY) goto LBL_MU; mp_set(&res, 1uL); /* set initial mode and bit cnt */ mode = 0; bitcnt = 1; @@ -148,15 +118,15 @@ if (digidx == -1) { break; } /* read next digit and reset the bitcnt */ buf = X->dp[digidx--]; - bitcnt = (int)DIGIT_BIT; + bitcnt = (int)MP_DIGIT_BIT; } /* grab the next msb from the exponent */ - y = (buf >> (mp_digit)(DIGIT_BIT - 1)) & 1; + y = (buf >> (mp_digit)(MP_DIGIT_BIT - 1)) & 1uL; buf <<= (mp_digit)1; /* if the bit is zero and mode == 0 then we ignore it * These represent the leading zero bits before the first 1 bit * in the exponent. Technically this opt is not required but it @@ -166,16 +136,12 @@ continue; } /* if the bit is zero and mode == 1 then we square */ if ((mode == 1) && (y == 0)) { - if ((err = mp_sqr(&res, &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, &mu)) != MP_OKAY) { - goto LBL_RES; - } + if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; continue; } /* else we add it to the window */ bitbuf |= (y << (winsize - ++bitcpy)); @@ -183,25 +149,17 @@ if (bitcpy == winsize) { /* ok window is filled so square as required and multiply */ /* square first */ for (x = 0; x < winsize; x++) { - if ((err = mp_sqr(&res, &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, &mu)) != MP_OKAY) { - goto LBL_RES; - } + if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; } /* then multiply */ - if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, &mu)) != MP_OKAY) { - goto LBL_RES; - } + if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; /* empty window and reset */ bitcpy = 0; bitbuf = 0; mode = 1; @@ -210,26 +168,18 @@ /* if bits remain then square/multiply */ if ((mode == 2) && (bitcpy > 0)) { /* square then multiply if the bit is set */ for (x = 0; x < bitcpy; x++) { - if ((err = mp_sqr(&res, &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, &mu)) != MP_OKAY) { - goto LBL_RES; - } + if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; bitbuf <<= 1; if ((bitbuf & (1 << winsize)) != 0) { /* then multiply */ - if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY) { - goto LBL_RES; - } - if ((err = redux(&res, P, &mu)) != MP_OKAY) { - goto LBL_RES; - } + if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, &mu)) != MP_OKAY) goto LBL_RES; } } } mp_exch(&res, Y); @@ -244,9 +194,5 @@ mp_clear(&M[x]); } return err; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_s_mp_exptmod_fast.c Index: libtommath/bn_s_mp_exptmod_fast.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_exptmod_fast.c @@ -0,0 +1,254 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_EXPTMOD_FAST_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85 + * + * Uses a left-to-right k-ary sliding window to compute the modular exponentiation. + * The value of k changes based on the size of the exponent. + * + * Uses Montgomery or Diminished Radix reduction [whichever appropriate] + */ + +#ifdef MP_LOW_MEM +# define TAB_SIZE 32 +# define MAX_WINSIZE 5 +#else +# define TAB_SIZE 256 +# define MAX_WINSIZE 0 +#endif + +mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) +{ + mp_int M[TAB_SIZE], res; + mp_digit buf, mp; + int bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize; + mp_err err; + + /* use a pointer to the reduction algorithm. This allows us to use + * one of many reduction algorithms without modding the guts of + * the code with if statements everywhere. + */ + mp_err(*redux)(mp_int *x, const mp_int *n, mp_digit rho); + + /* find window size */ + x = mp_count_bits(X); + if (x <= 7) { + winsize = 2; + } else if (x <= 36) { + winsize = 3; + } else if (x <= 140) { + winsize = 4; + } else if (x <= 450) { + winsize = 5; + } else if (x <= 1303) { + winsize = 6; + } else if (x <= 3529) { + winsize = 7; + } else { + winsize = 8; + } + + winsize = MAX_WINSIZE ? MP_MIN(MAX_WINSIZE, winsize) : winsize; + + /* init M array */ + /* init first cell */ + if ((err = mp_init_size(&M[1], P->alloc)) != MP_OKAY) { + return err; + } + + /* now init the second half of the array */ + for (x = 1<<(winsize-1); x < (1 << winsize); x++) { + if ((err = mp_init_size(&M[x], P->alloc)) != MP_OKAY) { + for (y = 1<<(winsize-1); y < x; y++) { + mp_clear(&M[y]); + } + mp_clear(&M[1]); + return err; + } + } + + /* determine and setup reduction code */ + if (redmode == 0) { + if (MP_HAS(MP_MONTGOMERY_SETUP)) { + /* now setup montgomery */ + if ((err = mp_montgomery_setup(P, &mp)) != MP_OKAY) goto LBL_M; + } else { + err = MP_VAL; + goto LBL_M; + } + + /* automatically pick the comba one if available (saves quite a few calls/ifs) */ + if (MP_HAS(S_MP_MONTGOMERY_REDUCE_FAST) && + (((P->used * 2) + 1) < MP_WARRAY) && + (P->used < MP_MAXFAST)) { + redux = s_mp_montgomery_reduce_fast; + } else if (MP_HAS(MP_MONTGOMERY_REDUCE)) { + /* use slower baseline Montgomery method */ + redux = mp_montgomery_reduce; + } else { + err = MP_VAL; + goto LBL_M; + } + } else if (redmode == 1) { + if (MP_HAS(MP_DR_SETUP) && MP_HAS(MP_DR_REDUCE)) { + /* setup DR reduction for moduli of the form B**k - b */ + mp_dr_setup(P, &mp); + redux = mp_dr_reduce; + } else { + err = MP_VAL; + goto LBL_M; + } + } else if (MP_HAS(MP_REDUCE_2K_SETUP) && MP_HAS(MP_REDUCE_2K)) { + /* setup DR reduction for moduli of the form 2**k - b */ + if ((err = mp_reduce_2k_setup(P, &mp)) != MP_OKAY) goto LBL_M; + redux = mp_reduce_2k; + } else { + err = MP_VAL; + goto LBL_M; + } + + /* setup result */ + if ((err = mp_init_size(&res, P->alloc)) != MP_OKAY) goto LBL_M; + + /* create M table + * + + * + * The first half of the table is not computed though accept for M[0] and M[1] + */ + + if (redmode == 0) { + if (MP_HAS(MP_MONTGOMERY_CALC_NORMALIZATION)) { + /* now we need R mod m */ + if ((err = mp_montgomery_calc_normalization(&res, P)) != MP_OKAY) goto LBL_RES; + + /* now set M[1] to G * R mod m */ + if ((err = mp_mulmod(G, &res, P, &M[1])) != MP_OKAY) goto LBL_RES; + } else { + err = MP_VAL; + goto LBL_RES; + } + } else { + mp_set(&res, 1uL); + if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) goto LBL_RES; + } + + /* compute the value at M[1<<(winsize-1)] by squaring M[1] (winsize-1) times */ + if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_RES; + + for (x = 0; x < (winsize - 1); x++) { + if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_RES; + if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, mp)) != MP_OKAY) goto LBL_RES; + } + + /* create upper table */ + for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) { + if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY) goto LBL_RES; + if ((err = redux(&M[x], P, mp)) != MP_OKAY) goto LBL_RES; + } + + /* set initial mode and bit cnt */ + mode = 0; + bitcnt = 1; + buf = 0; + digidx = X->used - 1; + bitcpy = 0; + bitbuf = 0; + + for (;;) { + /* grab next digit as required */ + if (--bitcnt == 0) { + /* if digidx == -1 we are out of digits so break */ + if (digidx == -1) { + break; + } + /* read next digit and reset bitcnt */ + buf = X->dp[digidx--]; + bitcnt = (int)MP_DIGIT_BIT; + } + + /* grab the next msb from the exponent */ + y = (mp_digit)(buf >> (MP_DIGIT_BIT - 1)) & 1uL; + buf <<= (mp_digit)1; + + /* if the bit is zero and mode == 0 then we ignore it + * These represent the leading zero bits before the first 1 bit + * in the exponent. Technically this opt is not required but it + * does lower the # of trivial squaring/reductions used + */ + if ((mode == 0) && (y == 0)) { + continue; + } + + /* if the bit is zero and mode == 1 then we square */ + if ((mode == 1) && (y == 0)) { + if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; + continue; + } + + /* else we add it to the window */ + bitbuf |= (y << (winsize - ++bitcpy)); + mode = 2; + + if (bitcpy == winsize) { + /* ok window is filled so square as required and multiply */ + /* square first */ + for (x = 0; x < winsize; x++) { + if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; + } + + /* then multiply */ + if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; + + /* empty window and reset */ + bitcpy = 0; + bitbuf = 0; + mode = 1; + } + } + + /* if bits remain then square/multiply */ + if ((mode == 2) && (bitcpy > 0)) { + /* square then multiply if the bit is set */ + for (x = 0; x < bitcpy; x++) { + if ((err = mp_sqr(&res, &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; + + /* get next bit of the window */ + bitbuf <<= 1; + if ((bitbuf & (1 << winsize)) != 0) { + /* then multiply */ + if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY) goto LBL_RES; + if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; + } + } + } + + if (redmode == 0) { + /* fixup result if Montgomery reduction is used + * recall that any value in a Montgomery system is + * actually multiplied by R mod n. So we have + * to reduce one more time to cancel out the factor + * of R. + */ + if ((err = redux(&res, P, mp)) != MP_OKAY) goto LBL_RES; + } + + /* swap res with Y */ + mp_exch(&res, Y); + err = MP_OKAY; +LBL_RES: + mp_clear(&res); +LBL_M: + mp_clear(&M[1]); + for (x = 1<<(winsize-1); x < (1 << winsize); x++) { + mp_clear(&M[x]); + } + return err; +} +#endif Index: libtommath/bn_s_mp_get_bit.c ================================================================== --- libtommath/bn_s_mp_get_bit.c +++ libtommath/bn_s_mp_get_bit.c @@ -3,19 +3,19 @@ /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Get bit at position b and return MP_YES if the bit is 1, MP_NO if it is 0 */ -mp_bool s_mp_get_bit(const mp_int *a, int b) +mp_bool s_mp_get_bit(const mp_int *a, unsigned int b) { mp_digit bit; - int limb = (int)((unsigned)b / MP_DIGIT_BIT); + int limb = (int)(b / MP_DIGIT_BIT); if (limb >= a->used) { return MP_NO; } - bit = (mp_digit)1 << ((unsigned)b % MP_DIGIT_BIT); + bit = (mp_digit)1 << (b % MP_DIGIT_BIT); return ((a->dp[limb] & bit) != 0u) ? MP_YES : MP_NO; } #endif ADDED libtommath/bn_s_mp_invmod_fast.c Index: libtommath/bn_s_mp_invmod_fast.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_invmod_fast.c @@ -0,0 +1,118 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_INVMOD_FAST_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* computes the modular inverse via binary extended euclidean algorithm, + * that is c = 1/a mod b + * + * Based on slow invmod except this is optimized for the case where b is + * odd as per HAC Note 14.64 on pp. 610 + */ +mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_int x, y, u, v, B, D; + mp_sign neg; + mp_err err; + + /* 2. [modified] b must be odd */ + if (MP_IS_EVEN(b)) { + return MP_VAL; + } + + /* init all our temps */ + if ((err = mp_init_multi(&x, &y, &u, &v, &B, &D, NULL)) != MP_OKAY) { + return err; + } + + /* x == modulus, y == value to invert */ + if ((err = mp_copy(b, &x)) != MP_OKAY) goto LBL_ERR; + + /* we need y = |a| */ + if ((err = mp_mod(a, b, &y)) != MP_OKAY) goto LBL_ERR; + + /* if one of x,y is zero return an error! */ + if (MP_IS_ZERO(&x) || MP_IS_ZERO(&y)) { + err = MP_VAL; + goto LBL_ERR; + } + + /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */ + if ((err = mp_copy(&x, &u)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(&y, &v)) != MP_OKAY) goto LBL_ERR; + mp_set(&D, 1uL); + +top: + /* 4. while u is even do */ + while (MP_IS_EVEN(&u)) { + /* 4.1 u = u/2 */ + if ((err = mp_div_2(&u, &u)) != MP_OKAY) goto LBL_ERR; + + /* 4.2 if B is odd then */ + if (MP_IS_ODD(&B)) { + if ((err = mp_sub(&B, &x, &B)) != MP_OKAY) goto LBL_ERR; + } + /* B = B/2 */ + if ((err = mp_div_2(&B, &B)) != MP_OKAY) goto LBL_ERR; + } + + /* 5. while v is even do */ + while (MP_IS_EVEN(&v)) { + /* 5.1 v = v/2 */ + if ((err = mp_div_2(&v, &v)) != MP_OKAY) goto LBL_ERR; + + /* 5.2 if D is odd then */ + if (MP_IS_ODD(&D)) { + /* D = (D-x)/2 */ + if ((err = mp_sub(&D, &x, &D)) != MP_OKAY) goto LBL_ERR; + } + /* D = D/2 */ + if ((err = mp_div_2(&D, &D)) != MP_OKAY) goto LBL_ERR; + } + + /* 6. if u >= v then */ + if (mp_cmp(&u, &v) != MP_LT) { + /* u = u - v, B = B - D */ + if ((err = mp_sub(&u, &v, &u)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&B, &D, &B)) != MP_OKAY) goto LBL_ERR; + } else { + /* v - v - u, D = D - B */ + if ((err = mp_sub(&v, &u, &v)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&D, &B, &D)) != MP_OKAY) goto LBL_ERR; + } + + /* if not zero goto step 4 */ + if (!MP_IS_ZERO(&u)) { + goto top; + } + + /* now a = C, b = D, gcd == g*v */ + + /* if v != 1 then there is no inverse */ + if (mp_cmp_d(&v, 1uL) != MP_EQ) { + err = MP_VAL; + goto LBL_ERR; + } + + /* b is now the inverse */ + neg = a->sign; + while (D.sign == MP_NEG) { + if ((err = mp_add(&D, b, &D)) != MP_OKAY) goto LBL_ERR; + } + + /* too big */ + while (mp_cmp_mag(&D, b) != MP_LT) { + if ((err = mp_sub(&D, b, &D)) != MP_OKAY) goto LBL_ERR; + } + + mp_exch(&D, c); + c->sign = neg; + err = MP_OKAY; + +LBL_ERR: + mp_clear_multi(&x, &y, &u, &v, &B, &D, NULL); + return err; +} +#endif ADDED libtommath/bn_s_mp_invmod_slow.c Index: libtommath/bn_s_mp_invmod_slow.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_invmod_slow.c @@ -0,0 +1,119 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_INVMOD_SLOW_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* hac 14.61, pp608 */ +mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_int x, y, u, v, A, B, C, D; + mp_err err; + + /* b cannot be negative */ + if ((b->sign == MP_NEG) || MP_IS_ZERO(b)) { + return MP_VAL; + } + + /* init temps */ + if ((err = mp_init_multi(&x, &y, &u, &v, + &A, &B, &C, &D, NULL)) != MP_OKAY) { + return err; + } + + /* x = a, y = b */ + if ((err = mp_mod(a, b, &x)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(b, &y)) != MP_OKAY) goto LBL_ERR; + + /* 2. [modified] if x,y are both even then return an error! */ + if (MP_IS_EVEN(&x) && MP_IS_EVEN(&y)) { + err = MP_VAL; + goto LBL_ERR; + } + + /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */ + if ((err = mp_copy(&x, &u)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_copy(&y, &v)) != MP_OKAY) goto LBL_ERR; + mp_set(&A, 1uL); + mp_set(&D, 1uL); + +top: + /* 4. while u is even do */ + while (MP_IS_EVEN(&u)) { + /* 4.1 u = u/2 */ + if ((err = mp_div_2(&u, &u)) != MP_OKAY) goto LBL_ERR; + + /* 4.2 if A or B is odd then */ + if (MP_IS_ODD(&A) || MP_IS_ODD(&B)) { + /* A = (A+y)/2, B = (B-x)/2 */ + if ((err = mp_add(&A, &y, &A)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_sub(&B, &x, &B)) != MP_OKAY) goto LBL_ERR; + } + /* A = A/2, B = B/2 */ + if ((err = mp_div_2(&A, &A)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_div_2(&B, &B)) != MP_OKAY) goto LBL_ERR; + } + + /* 5. while v is even do */ + while (MP_IS_EVEN(&v)) { + /* 5.1 v = v/2 */ + if ((err = mp_div_2(&v, &v)) != MP_OKAY) goto LBL_ERR; + + /* 5.2 if C or D is odd then */ + if (MP_IS_ODD(&C) || MP_IS_ODD(&D)) { + /* C = (C+y)/2, D = (D-x)/2 */ + if ((err = mp_add(&C, &y, &C)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_sub(&D, &x, &D)) != MP_OKAY) goto LBL_ERR; + } + /* C = C/2, D = D/2 */ + if ((err = mp_div_2(&C, &C)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_div_2(&D, &D)) != MP_OKAY) goto LBL_ERR; + } + + /* 6. if u >= v then */ + if (mp_cmp(&u, &v) != MP_LT) { + /* u = u - v, A = A - C, B = B - D */ + if ((err = mp_sub(&u, &v, &u)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&A, &C, &A)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&B, &D, &B)) != MP_OKAY) goto LBL_ERR; + } else { + /* v - v - u, C = C - A, D = D - B */ + if ((err = mp_sub(&v, &u, &v)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&C, &A, &C)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&D, &B, &D)) != MP_OKAY) goto LBL_ERR; + } + + /* if not zero goto step 4 */ + if (!MP_IS_ZERO(&u)) { + goto top; + } + + /* now a = C, b = D, gcd == g*v */ + + /* if v != 1 then there is no inverse */ + if (mp_cmp_d(&v, 1uL) != MP_EQ) { + err = MP_VAL; + goto LBL_ERR; + } + + /* if its too low */ + while (mp_cmp_d(&C, 0uL) == MP_LT) { + if ((err = mp_add(&C, b, &C)) != MP_OKAY) goto LBL_ERR; + } + + /* too big */ + while (mp_cmp_mag(&C, b) != MP_LT) { + if ((err = mp_sub(&C, b, &C)) != MP_OKAY) goto LBL_ERR; + } + + /* C is now the inverse */ + mp_exch(&C, c); + err = MP_OKAY; +LBL_ERR: + mp_clear_multi(&x, &y, &u, &v, &A, &B, &C, &D, NULL); + return err; +} +#endif ADDED libtommath/bn_s_mp_karatsuba_mul.c Index: libtommath/bn_s_mp_karatsuba_mul.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_karatsuba_mul.c @@ -0,0 +1,174 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_KARATSUBA_MUL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* c = |a| * |b| using Karatsuba Multiplication using + * three half size multiplications + * + * Let B represent the radix [e.g. 2**MP_DIGIT_BIT] and + * let n represent half of the number of digits in + * the min(a,b) + * + * a = a1 * B**n + a0 + * b = b1 * B**n + b0 + * + * Then, a * b => + a1b1 * B**2n + ((a1 + a0)(b1 + b0) - (a0b0 + a1b1)) * B + a0b0 + * + * Note that a1b1 and a0b0 are used twice and only need to be + * computed once. So in total three half size (half # of + * digit) multiplications are performed, a0b0, a1b1 and + * (a1+b1)(a0+b0) + * + * Note that a multiplication of half the digits requires + * 1/4th the number of single precision multiplications so in + * total after one call 25% of the single precision multiplications + * are saved. Note also that the call to mp_mul can end up back + * in this function if the a0, a1, b0, or b1 are above the threshold. + * This is known as divide-and-conquer and leads to the famous + * O(N**lg(3)) or O(N**1.584) work which is asymptopically lower than + * the standard O(N**2) that the baseline/comba methods use. + * Generally though the overhead of this method doesn't pay off + * until a certain size (N ~ 80) is reached. + */ +mp_err s_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_int x0, x1, y0, y1, t1, x0y0, x1y1; + int B; + mp_err err = MP_MEM; /* default the return code to an error */ + + /* min # of digits */ + B = MP_MIN(a->used, b->used); + + /* now divide in two */ + B = B >> 1; + + /* init copy all the temps */ + if (mp_init_size(&x0, B) != MP_OKAY) { + goto LBL_ERR; + } + if (mp_init_size(&x1, a->used - B) != MP_OKAY) { + goto X0; + } + if (mp_init_size(&y0, B) != MP_OKAY) { + goto X1; + } + if (mp_init_size(&y1, b->used - B) != MP_OKAY) { + goto Y0; + } + + /* init temps */ + if (mp_init_size(&t1, B * 2) != MP_OKAY) { + goto Y1; + } + if (mp_init_size(&x0y0, B * 2) != MP_OKAY) { + goto T1; + } + if (mp_init_size(&x1y1, B * 2) != MP_OKAY) { + goto X0Y0; + } + + /* now shift the digits */ + x0.used = y0.used = B; + x1.used = a->used - B; + y1.used = b->used - B; + + { + int x; + mp_digit *tmpa, *tmpb, *tmpx, *tmpy; + + /* we copy the digits directly instead of using higher level functions + * since we also need to shift the digits + */ + tmpa = a->dp; + tmpb = b->dp; + + tmpx = x0.dp; + tmpy = y0.dp; + for (x = 0; x < B; x++) { + *tmpx++ = *tmpa++; + *tmpy++ = *tmpb++; + } + + tmpx = x1.dp; + for (x = B; x < a->used; x++) { + *tmpx++ = *tmpa++; + } + + tmpy = y1.dp; + for (x = B; x < b->used; x++) { + *tmpy++ = *tmpb++; + } + } + + /* only need to clamp the lower words since by definition the + * upper words x1/y1 must have a known number of digits + */ + mp_clamp(&x0); + mp_clamp(&y0); + + /* now calc the products x0y0 and x1y1 */ + /* after this x0 is no longer required, free temp [x0==t2]! */ + if (mp_mul(&x0, &y0, &x0y0) != MP_OKAY) { + goto X1Y1; /* x0y0 = x0*y0 */ + } + if (mp_mul(&x1, &y1, &x1y1) != MP_OKAY) { + goto X1Y1; /* x1y1 = x1*y1 */ + } + + /* now calc x1+x0 and y1+y0 */ + if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) { + goto X1Y1; /* t1 = x1 - x0 */ + } + if (s_mp_add(&y1, &y0, &x0) != MP_OKAY) { + goto X1Y1; /* t2 = y1 - y0 */ + } + if (mp_mul(&t1, &x0, &t1) != MP_OKAY) { + goto X1Y1; /* t1 = (x1 + x0) * (y1 + y0) */ + } + + /* add x0y0 */ + if (mp_add(&x0y0, &x1y1, &x0) != MP_OKAY) { + goto X1Y1; /* t2 = x0y0 + x1y1 */ + } + if (s_mp_sub(&t1, &x0, &t1) != MP_OKAY) { + goto X1Y1; /* t1 = (x1+x0)*(y1+y0) - (x1y1 + x0y0) */ + } + + /* shift by B */ + if (mp_lshd(&t1, B) != MP_OKAY) { + goto X1Y1; /* t1 = (x0y0 + x1y1 - (x1-x0)*(y1-y0))<used; + + /* now divide in two */ + B = B >> 1; + + /* init copy all the temps */ + if (mp_init_size(&x0, B) != MP_OKAY) + goto LBL_ERR; + if (mp_init_size(&x1, a->used - B) != MP_OKAY) + goto X0; + + /* init temps */ + if (mp_init_size(&t1, a->used * 2) != MP_OKAY) + goto X1; + if (mp_init_size(&t2, a->used * 2) != MP_OKAY) + goto T1; + if (mp_init_size(&x0x0, B * 2) != MP_OKAY) + goto T2; + if (mp_init_size(&x1x1, (a->used - B) * 2) != MP_OKAY) + goto X0X0; + + { + int x; + mp_digit *dst, *src; + + src = a->dp; + + /* now shift the digits */ + dst = x0.dp; + for (x = 0; x < B; x++) { + *dst++ = *src++; + } + + dst = x1.dp; + for (x = B; x < a->used; x++) { + *dst++ = *src++; + } + } + + x0.used = B; + x1.used = a->used - B; + + mp_clamp(&x0); + + /* now calc the products x0*x0 and x1*x1 */ + if (mp_sqr(&x0, &x0x0) != MP_OKAY) + goto X1X1; /* x0x0 = x0*x0 */ + if (mp_sqr(&x1, &x1x1) != MP_OKAY) + goto X1X1; /* x1x1 = x1*x1 */ + + /* now calc (x1+x0)**2 */ + if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) + goto X1X1; /* t1 = x1 - x0 */ + if (mp_sqr(&t1, &t1) != MP_OKAY) + goto X1X1; /* t1 = (x1 - x0) * (x1 - x0) */ + + /* add x0y0 */ + if (s_mp_add(&x0x0, &x1x1, &t2) != MP_OKAY) + goto X1X1; /* t2 = x0x0 + x1x1 */ + if (s_mp_sub(&t1, &t2, &t1) != MP_OKAY) + goto X1X1; /* t1 = (x1+x0)**2 - (x0x0 + x1x1) */ + + /* shift by B */ + if (mp_lshd(&t1, B) != MP_OKAY) + goto X1X1; /* t1 = (x0x0 + x1x1 - (x1-x0)*(x1-x0))<used > MP_WARRAY) { + return MP_VAL; + } + + /* get old used count */ + olduse = x->used; + + /* grow a as required */ + if (x->alloc < (n->used + 1)) { + if ((err = mp_grow(x, n->used + 1)) != MP_OKAY) { + return err; + } + } + + /* first we have to get the digits of the input into + * an array of double precision words W[...] + */ + { + mp_word *_W; + mp_digit *tmpx; + + /* alias for the W[] array */ + _W = W; + + /* alias for the digits of x*/ + tmpx = x->dp; + + /* copy the digits of a into W[0..a->used-1] */ + for (ix = 0; ix < x->used; ix++) { + *_W++ = *tmpx++; + } + + /* zero the high words of W[a->used..m->used*2] */ + if (ix < ((n->used * 2) + 1)) { + MP_ZERO_BUFFER(_W, sizeof(mp_word) * (size_t)(((n->used * 2) + 1) - ix)); + } + } + + /* now we proceed to zero successive digits + * from the least significant upwards + */ + for (ix = 0; ix < n->used; ix++) { + /* mu = ai * m' mod b + * + * We avoid a double precision multiplication (which isn't required) + * by casting the value down to a mp_digit. Note this requires + * that W[ix-1] have the carry cleared (see after the inner loop) + */ + mp_digit mu; + mu = ((W[ix] & MP_MASK) * rho) & MP_MASK; + + /* a = a + mu * m * b**i + * + * This is computed in place and on the fly. The multiplication + * by b**i is handled by offseting which columns the results + * are added to. + * + * Note the comba method normally doesn't handle carries in the + * inner loop In this case we fix the carry from the previous + * column since the Montgomery reduction requires digits of the + * result (so far) [see above] to work. This is + * handled by fixing up one carry after the inner loop. The + * carry fixups are done in order so after these loops the + * first m->used words of W[] have the carries fixed + */ + { + int iy; + mp_digit *tmpn; + mp_word *_W; + + /* alias for the digits of the modulus */ + tmpn = n->dp; + + /* Alias for the columns set by an offset of ix */ + _W = W + ix; + + /* inner loop */ + for (iy = 0; iy < n->used; iy++) { + *_W++ += (mp_word)mu * (mp_word)*tmpn++; + } + } + + /* now fix carry for next digit, W[ix+1] */ + W[ix + 1] += W[ix] >> (mp_word)MP_DIGIT_BIT; + } + + /* now we have to propagate the carries and + * shift the words downward [all those least + * significant digits we zeroed]. + */ + { + mp_digit *tmpx; + mp_word *_W, *_W1; + + /* nox fix rest of carries */ + + /* alias for current word */ + _W1 = W + ix; + + /* alias for next word, where the carry goes */ + _W = W + ++ix; + + for (; ix < ((n->used * 2) + 1); ix++) { + *_W++ += *_W1++ >> (mp_word)MP_DIGIT_BIT; + } + + /* copy out, A = A/b**n + * + * The result is A/b**n but instead of converting from an + * array of mp_word to mp_digit than calling mp_rshd + * we just copy them in the right order + */ + + /* alias for destination word */ + tmpx = x->dp; + + /* alias for shifted double precision result */ + _W = W + n->used; + + for (ix = 0; ix < (n->used + 1); ix++) { + *tmpx++ = *_W++ & (mp_word)MP_MASK; + } + + /* zero oldused digits, if the input a was larger than + * m->used+1 we'll have to clear the digits + */ + MP_ZERO_DIGITS(tmpx, olduse - ix); + } + + /* set the max used and clamp */ + x->used = n->used + 1; + mp_clamp(x); + + /* if A >= m then A = A - m */ + if (mp_cmp_mag(x, n) != MP_LT) { + return s_mp_sub(x, n, x); + } + return MP_OKAY; +} +#endif Index: libtommath/bn_s_mp_mul_digs.c ================================================================== --- libtommath/bn_s_mp_mul_digs.c +++ libtommath/bn_s_mp_mul_digs.c @@ -1,40 +1,31 @@ #include "tommath_private.h" #ifdef BN_S_MP_MUL_DIGS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* multiplies |a| * |b| and only computes upto digs digits of result * HAC pp. 595, Algorithm 14.12 Modified so you can control how * many digits of output are created. */ -int s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) +mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) { mp_int t; - int res, pa, pb, ix, iy; + mp_err err; + int pa, pb, ix, iy; mp_digit u; mp_word r; mp_digit tmpx, *tmpt, *tmpy; /* can we use the fast multiplier? */ - if ((digs < (int)MP_WARRAY) && - (MIN(a->used, b->used) < - (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) { - return fast_s_mp_mul_digs(a, b, c, digs); + if ((digs < MP_WARRAY) && + (MP_MIN(a->used, b->used) < MP_MAXFAST)) { + return s_mp_mul_digs_fast(a, b, c, digs); } - if ((res = mp_init_size(&t, digs)) != MP_OKAY) { - return res; + if ((err = mp_init_size(&t, digs)) != MP_OKAY) { + return err; } t.used = digs; /* compute the digits of the product directly */ pa = a->used; @@ -41,11 +32,11 @@ for (ix = 0; ix < pa; ix++) { /* set the carry to zero */ u = 0; /* limit ourselves to making digs digits of output */ - pb = MIN(b->used, digs - ix); + pb = MP_MIN(b->used, digs - ix); /* setup some aliases */ /* copy of the digit from a used within the nested loop */ tmpx = a->dp[ix]; @@ -64,11 +55,11 @@ /* the new column is the lower part of the result */ *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); /* get the carry word from the result */ - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } /* set carry if it is placed below digs */ if ((ix + iy) < digs) { *tmpt = u; } @@ -79,9 +70,5 @@ mp_clear(&t); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_s_mp_mul_digs_fast.c Index: libtommath/bn_s_mp_mul_digs_fast.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_mul_digs_fast.c @@ -0,0 +1,90 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_MUL_DIGS_FAST_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* Fast (comba) multiplier + * + * This is the fast column-array [comba] multiplier. It is + * designed to compute the columns of the product first + * then handle the carries afterwards. This has the effect + * of making the nested loops that compute the columns very + * simple and schedulable on super-scalar processors. + * + * This has been modified to produce a variable number of + * digits of output so if say only a half-product is required + * you don't have to compute the upper half (a feature + * required for fast Barrett reduction). + * + * Based on Algorithm 14.12 on pp.595 of HAC. + * + */ +mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) +{ + int olduse, pa, ix, iz; + mp_err err; + mp_digit W[MP_WARRAY]; + mp_word _W; + + /* grow the destination as required */ + if (c->alloc < digs) { + if ((err = mp_grow(c, digs)) != MP_OKAY) { + return err; + } + } + + /* number of output digits to produce */ + pa = MP_MIN(digs, a->used + b->used); + + /* clear the carry */ + _W = 0; + for (ix = 0; ix < pa; ix++) { + int tx, ty; + int iy; + mp_digit *tmpx, *tmpy; + + /* get offsets into the two bignums */ + ty = MP_MIN(b->used-1, ix); + tx = ix - ty; + + /* setup temp aliases */ + tmpx = a->dp + tx; + tmpy = b->dp + ty; + + /* this is the number of times the loop will iterrate, essentially + while (tx++ < a->used && ty-- >= 0) { ... } + */ + iy = MP_MIN(a->used-tx, ty+1); + + /* execute loop */ + for (iz = 0; iz < iy; ++iz) { + _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; + + } + + /* store term */ + W[ix] = (mp_digit)_W & MP_MASK; + + /* make next carry */ + _W = _W >> (mp_word)MP_DIGIT_BIT; + } + + /* setup dest */ + olduse = c->used; + c->used = pa; + + { + mp_digit *tmpc; + tmpc = c->dp; + for (ix = 0; ix < pa; ix++) { + /* now extract the previous digit [below the carry] */ + *tmpc++ = W[ix]; + } + + /* clear unused digits [that existed in the old copy of c] */ + MP_ZERO_DIGITS(tmpc, olduse - ix); + } + mp_clamp(c); + return MP_OKAY; +} +#endif Index: libtommath/bn_s_mp_mul_high_digs.c ================================================================== --- libtommath/bn_s_mp_mul_high_digs.c +++ libtommath/bn_s_mp_mul_high_digs.c @@ -1,40 +1,31 @@ #include "tommath_private.h" #ifdef BN_S_MP_MUL_HIGH_DIGS_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* multiplies |a| * |b| and does not compute the lower digs digits * [meant to get the higher part of the product] */ -int s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) +mp_err s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) { - mp_int t; - int res, pa, pb, ix, iy; + mp_int t; + int pa, pb, ix, iy; + mp_err err; mp_digit u; - mp_word r; + mp_word r; mp_digit tmpx, *tmpt, *tmpy; /* can we use the fast multiplier? */ -#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C - if (((a->used + b->used + 1) < (int)MP_WARRAY) - && (MIN(a->used, b->used) < (int)(1u << (((size_t)CHAR_BIT * sizeof(mp_word)) - (2u * (size_t)DIGIT_BIT))))) { - return fast_s_mp_mul_high_digs(a, b, c, digs); - } -#endif - - if ((res = mp_init_size(&t, a->used + b->used + 1)) != MP_OKAY) { - return res; + if (MP_HAS(S_MP_MUL_HIGH_DIGS_FAST) + && ((a->used + b->used + 1) < MP_WARRAY) + && (MP_MIN(a->used, b->used) < MP_MAXFAST)) { + return s_mp_mul_high_digs_fast(a, b, c, digs); + } + + if ((err = mp_init_size(&t, a->used + b->used + 1)) != MP_OKAY) { + return err; } t.used = a->used + b->used + 1; pa = a->used; pb = b->used; @@ -59,19 +50,15 @@ /* get the lower part */ *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); /* carry the carry */ - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } *tmpt = u; } mp_clamp(&t); mp_exch(&t, c); mp_clear(&t); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_s_mp_mul_high_digs_fast.c Index: libtommath/bn_s_mp_mul_high_digs_fast.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_mul_high_digs_fast.c @@ -0,0 +1,81 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_MUL_HIGH_DIGS_FAST_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* this is a modified version of s_mp_mul_digs_fast that only produces + * output digits *above* digs. See the comments for s_mp_mul_digs_fast + * to see how it works. + * + * This is used in the Barrett reduction since for one of the multiplications + * only the higher digits were needed. This essentially halves the work. + * + * Based on Algorithm 14.12 on pp.595 of HAC. + */ +mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) +{ + int olduse, pa, ix, iz; + mp_err err; + mp_digit W[MP_WARRAY]; + mp_word _W; + + /* grow the destination as required */ + pa = a->used + b->used; + if (c->alloc < pa) { + if ((err = mp_grow(c, pa)) != MP_OKAY) { + return err; + } + } + + /* number of output digits to produce */ + pa = a->used + b->used; + _W = 0; + for (ix = digs; ix < pa; ix++) { + int tx, ty, iy; + mp_digit *tmpx, *tmpy; + + /* get offsets into the two bignums */ + ty = MP_MIN(b->used-1, ix); + tx = ix - ty; + + /* setup temp aliases */ + tmpx = a->dp + tx; + tmpy = b->dp + ty; + + /* this is the number of times the loop will iterrate, essentially its + while (tx++ < a->used && ty-- >= 0) { ... } + */ + iy = MP_MIN(a->used-tx, ty+1); + + /* execute loop */ + for (iz = 0; iz < iy; iz++) { + _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; + } + + /* store term */ + W[ix] = (mp_digit)_W & MP_MASK; + + /* make next carry */ + _W = _W >> (mp_word)MP_DIGIT_BIT; + } + + /* setup dest */ + olduse = c->used; + c->used = pa; + + { + mp_digit *tmpc; + + tmpc = c->dp + digs; + for (ix = digs; ix < pa; ix++) { + /* now extract the previous digit [below the carry] */ + *tmpc++ = W[ix]; + } + + /* clear unused digits [that existed in the old copy of c] */ + MP_ZERO_DIGITS(tmpc, olduse - ix); + } + mp_clamp(c); + return MP_OKAY; +} +#endif ADDED libtommath/bn_s_mp_prime_is_divisible.c Index: libtommath/bn_s_mp_prime_is_divisible.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_prime_is_divisible.c @@ -0,0 +1,35 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_PRIME_IS_DIVISIBLE_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* determines if an integers is divisible by one + * of the first PRIME_SIZE primes or not + * + * sets result to 0 if not, 1 if yes + */ +mp_err s_mp_prime_is_divisible(const mp_int *a, mp_bool *result) +{ + int ix; + mp_err err; + mp_digit res; + + /* default to not */ + *result = MP_NO; + + for (ix = 0; ix < PRIVATE_MP_PRIME_TAB_SIZE; ix++) { + /* what is a mod LBL_prime_tab[ix] */ + if ((err = mp_mod_d(a, s_mp_prime_tab[ix], &res)) != MP_OKAY) { + return err; + } + + /* is the residue zero? */ + if (res == 0u) { + *result = MP_YES; + return MP_OKAY; + } + } + + return MP_OKAY; +} +#endif ADDED libtommath/bn_s_mp_rand_jenkins.c Index: libtommath/bn_s_mp_rand_jenkins.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_rand_jenkins.c @@ -0,0 +1,52 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_RAND_JENKINS_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* Bob Jenkins' http://burtleburtle.net/bob/rand/smallprng.html */ +/* Chosen for speed and a good "mix" */ +typedef struct { + uint64_t a; + uint64_t b; + uint64_t c; + uint64_t d; +} ranctx; + +static ranctx jenkins_x; + +#define rot(x,k) (((x)<<(k))|((x)>>(64-(k)))) +static uint64_t s_rand_jenkins_val(void) +{ + uint64_t e = jenkins_x.a - rot(jenkins_x.b, 7); + jenkins_x.a = jenkins_x.b ^ rot(jenkins_x.c, 13); + jenkins_x.b = jenkins_x.c + rot(jenkins_x.d, 37); + jenkins_x.c = jenkins_x.d + e; + jenkins_x.d = e + jenkins_x.a; + return jenkins_x.d; +} + +void s_mp_rand_jenkins_init(uint64_t seed) +{ + int i; + jenkins_x.a = 0xf1ea5eedULL; + jenkins_x.b = jenkins_x.c = jenkins_x.d = seed; + for (i = 0; i < 20; ++i) { + (void)s_rand_jenkins_val(); + } +} + +mp_err s_mp_rand_jenkins(void *p, size_t n) +{ + char *q = (char *)p; + while (n > 0u) { + int i; + uint64_t x = s_rand_jenkins_val(); + for (i = 0; (i < 8) && (n > 0u); ++i, --n) { + *q++ = (char)(x & 0xFFuLL); + x >>= 8; + } + } + return MP_OKAY; +} + +#endif ADDED libtommath/bn_s_mp_rand_platform.c Index: libtommath/bn_s_mp_rand_platform.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_rand_platform.c @@ -0,0 +1,148 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_RAND_PLATFORM_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* First the OS-specific special cases + * - *BSD + * - Windows + */ +#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__) +#define BN_S_READ_ARC4RANDOM_C +static mp_err s_read_arc4random(void *p, size_t n) +{ + arc4random_buf(p, n); + return MP_OKAY; +} +#endif + +#if defined(_WIN32) || defined(_WIN32_WCE) +#define BN_S_READ_WINCSP_C + +#ifndef _WIN32_WINNT +#define _WIN32_WINNT 0x0400 +#endif +#ifdef _WIN32_WCE +#define UNDER_CE +#define ARM +#endif + +#define WIN32_LEAN_AND_MEAN +#include +#include + +static mp_err s_read_wincsp(void *p, size_t n) +{ + static HCRYPTPROV hProv = 0; + if (hProv == 0) { + HCRYPTPROV h = 0; + if (!CryptAcquireContext(&h, NULL, MS_DEF_PROV, PROV_RSA_FULL, + (CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET)) && + !CryptAcquireContext(&h, NULL, MS_DEF_PROV, PROV_RSA_FULL, + CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET | CRYPT_NEWKEYSET)) { + return MP_ERR; + } + hProv = h; + } + return CryptGenRandom(hProv, (DWORD)n, (BYTE *)p) == TRUE ? MP_OKAY : MP_ERR; +} +#endif /* WIN32 */ + +#if !defined(BN_S_READ_WINCSP_C) && defined(__linux__) && defined(__GLIBC_PREREQ) +#if __GLIBC_PREREQ(2, 25) +#define BN_S_READ_GETRANDOM_C +#include +#include + +static mp_err s_read_getrandom(void *p, size_t n) +{ + char *q = (char *)p; + while (n > 0u) { + ssize_t ret = getrandom(q, n, 0); + if (ret < 0) { + if (errno == EINTR) { + continue; + } + return MP_ERR; + } + q += ret; + n -= (size_t)ret; + } + return MP_OKAY; +} +#endif +#endif + +/* We assume all platforms besides windows provide "/dev/urandom". + * In case yours doesn't, define MP_NO_DEV_URANDOM at compile-time. + */ +#if !defined(BN_S_READ_WINCSP_C) && !defined(MP_NO_DEV_URANDOM) +#define BN_S_READ_URANDOM_C +#ifndef MP_DEV_URANDOM +#define MP_DEV_URANDOM "/dev/urandom" +#endif +#include +#include +#include + +static mp_err s_read_urandom(void *p, size_t n) +{ + int fd; + char *q = (char *)p; + + do { + fd = open(MP_DEV_URANDOM, O_RDONLY); + } while ((fd == -1) && (errno == EINTR)); + if (fd == -1) return MP_ERR; + + while (n > 0u) { + ssize_t ret = read(fd, p, n); + if (ret < 0) { + if (errno == EINTR) { + continue; + } + close(fd); + return MP_ERR; + } + q += ret; + n -= (size_t)ret; + } + + close(fd); + return MP_OKAY; +} +#endif + +#if defined(MP_PRNG_ENABLE_LTM_RNG) +#define BN_S_READ_LTM_RNG +unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); +void (*ltm_rng_callback)(void); + +static mp_err s_read_ltm_rng(void *p, size_t n) +{ + unsigned long res; + if (ltm_rng == NULL) return MP_ERR; + res = ltm_rng(p, n, ltm_rng_callback); + if (res != n) return MP_ERR; + return MP_OKAY; +} +#endif + +mp_err s_read_arc4random(void *p, size_t n); +mp_err s_read_wincsp(void *p, size_t n); +mp_err s_read_getrandom(void *p, size_t n); +mp_err s_read_urandom(void *p, size_t n); +mp_err s_read_ltm_rng(void *p, size_t n); + +mp_err s_mp_rand_platform(void *p, size_t n) +{ + mp_err err = MP_ERR; + if ((err != MP_OKAY) && MP_HAS(S_READ_ARC4RANDOM)) err = s_read_arc4random(p, n); + if ((err != MP_OKAY) && MP_HAS(S_READ_WINCSP)) err = s_read_wincsp(p, n); + if ((err != MP_OKAY) && MP_HAS(S_READ_GETRANDOM)) err = s_read_getrandom(p, n); + if ((err != MP_OKAY) && MP_HAS(S_READ_URANDOM)) err = s_read_urandom(p, n); + if ((err != MP_OKAY) && MP_HAS(S_READ_LTM_RNG)) err = s_read_ltm_rng(p, n); + return err; +} + +#endif ADDED libtommath/bn_s_mp_reverse.c Index: libtommath/bn_s_mp_reverse.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_reverse.c @@ -0,0 +1,22 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_REVERSE_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* reverse an array, used for radix code */ +void s_mp_reverse(unsigned char *s, size_t len) +{ + size_t ix, iy; + unsigned char t; + + ix = 0u; + iy = len - 1u; + while (ix < iy) { + t = s[ix]; + s[ix] = s[iy]; + s[iy] = t; + ++ix; + --iy; + } +} +#endif Index: libtommath/bn_s_mp_sqr.c ================================================================== --- libtommath/bn_s_mp_sqr.c +++ libtommath/bn_s_mp_sqr.c @@ -1,30 +1,22 @@ #include "tommath_private.h" #ifdef BN_S_MP_SQR_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */ -int s_mp_sqr(const mp_int *a, mp_int *b) +mp_err s_mp_sqr(const mp_int *a, mp_int *b) { - mp_int t; - int res, ix, iy, pa; - mp_word r; + mp_int t; + int ix, iy, pa; + mp_err err; + mp_word r; mp_digit u, tmpx, *tmpt; pa = a->used; - if ((res = mp_init_size(&t, (2 * pa) + 1)) != MP_OKAY) { - return res; + if ((err = mp_init_size(&t, (2 * pa) + 1)) != MP_OKAY) { + return err; } /* default used is maximum possible size */ t.used = (2 * pa) + 1; @@ -36,11 +28,11 @@ /* store lower part in result */ t.dp[ix+ix] = (mp_digit)(r & (mp_word)MP_MASK); /* get the carry */ - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); /* left hand side of A[ix] * A[iy] */ tmpx = a->dp[ix]; /* alias for where to store the results */ @@ -57,25 +49,21 @@ /* store lower part */ *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); /* get carry */ - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } /* propagate upwards */ while (u != 0uL) { r = (mp_word)*tmpt + (mp_word)u; *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK); - u = (mp_digit)(r >> (mp_word)DIGIT_BIT); + u = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT); } } mp_clamp(&t); mp_exch(&t, b); mp_clear(&t); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_s_mp_sqr_fast.c Index: libtommath/bn_s_mp_sqr_fast.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_sqr_fast.c @@ -0,0 +1,97 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_SQR_FAST_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* the jist of squaring... + * you do like mult except the offset of the tmpx [one that + * starts closer to zero] can't equal the offset of tmpy. + * So basically you set up iy like before then you min it with + * (ty-tx) so that it never happens. You double all those + * you add in the inner loop + +After that loop you do the squares and add them in. +*/ + +mp_err s_mp_sqr_fast(const mp_int *a, mp_int *b) +{ + int olduse, pa, ix, iz; + mp_digit W[MP_WARRAY], *tmpx; + mp_word W1; + mp_err err; + + /* grow the destination as required */ + pa = a->used + a->used; + if (b->alloc < pa) { + if ((err = mp_grow(b, pa)) != MP_OKAY) { + return err; + } + } + + /* number of output digits to produce */ + W1 = 0; + for (ix = 0; ix < pa; ix++) { + int tx, ty, iy; + mp_word _W; + mp_digit *tmpy; + + /* clear counter */ + _W = 0; + + /* get offsets into the two bignums */ + ty = MP_MIN(a->used-1, ix); + tx = ix - ty; + + /* setup temp aliases */ + tmpx = a->dp + tx; + tmpy = a->dp + ty; + + /* this is the number of times the loop will iterrate, essentially + while (tx++ < a->used && ty-- >= 0) { ... } + */ + iy = MP_MIN(a->used-tx, ty+1); + + /* now for squaring tx can never equal ty + * we halve the distance since they approach at a rate of 2x + * and we have to round because odd cases need to be executed + */ + iy = MP_MIN(iy, ((ty-tx)+1)>>1); + + /* execute loop */ + for (iz = 0; iz < iy; iz++) { + _W += (mp_word)*tmpx++ * (mp_word)*tmpy--; + } + + /* double the inner product and add carry */ + _W = _W + _W + W1; + + /* even columns have the square term in them */ + if (((unsigned)ix & 1u) == 0u) { + _W += (mp_word)a->dp[ix>>1] * (mp_word)a->dp[ix>>1]; + } + + /* store it */ + W[ix] = (mp_digit)_W & MP_MASK; + + /* make next carry */ + W1 = _W >> (mp_word)MP_DIGIT_BIT; + } + + /* setup dest */ + olduse = b->used; + b->used = a->used+a->used; + + { + mp_digit *tmpb; + tmpb = b->dp; + for (ix = 0; ix < pa; ix++) { + *tmpb++ = W[ix] & MP_MASK; + } + + /* clear unused digits [that existed in the old copy of c] */ + MP_ZERO_DIGITS(tmpb, olduse - ix); + } + mp_clamp(b); + return MP_OKAY; +} +#endif Index: libtommath/bn_s_mp_sub.c ================================================================== --- libtommath/bn_s_mp_sub.c +++ libtommath/bn_s_mp_sub.c @@ -1,32 +1,24 @@ #include "tommath_private.h" #ifdef BN_S_MP_SUB_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */ -int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) +mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) { - int olduse, res, min, max; + int olduse, min, max; + mp_err err; /* find sizes */ min = b->used; max = a->used; /* init result */ if (c->alloc < max) { - if ((res = mp_grow(c, max)) != MP_OKAY) { - return res; + if ((err = mp_grow(c, max)) != MP_OKAY) { + return err; } } olduse = c->used; c->used = max; @@ -48,11 +40,11 @@ /* U = carry bit of T[i] * Note this saves performing an AND operation since * if a carry does occur it will propagate all the way to the * MSB. As a result a single shift is enough to get the carry */ - u = *tmpc >> (((size_t)CHAR_BIT * sizeof(mp_digit)) - 1u); + u = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u); /* Clear carry from T[i] */ *tmpc++ &= MP_MASK; } @@ -60,26 +52,20 @@ for (; i < max; i++) { /* T[i] = A[i] - U */ *tmpc = *tmpa++ - u; /* U = carry bit of T[i] */ - u = *tmpc >> (((size_t)CHAR_BIT * sizeof(mp_digit)) - 1u); + u = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u); /* Clear carry from T[i] */ *tmpc++ &= MP_MASK; } /* clear digits above used (since we may not have grown result above) */ - for (i = c->used; i < olduse; i++) { - *tmpc++ = 0; - } + MP_ZERO_DIGITS(tmpc, olduse - c->used); } mp_clamp(c); return MP_OKAY; } #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/bn_s_mp_toom_mul.c Index: libtommath/bn_s_mp_toom_mul.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_toom_mul.c @@ -0,0 +1,215 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_TOOM_MUL_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* multiplication using the Toom-Cook 3-way algorithm + * + * Much more complicated than Karatsuba but has a lower + * asymptotic running time of O(N**1.464). This algorithm is + * only particularly useful on VERY large inputs + * (we're talking 1000s of digits here...). +*/ + +/* + This file contains code from J. Arndt's book "Matters Computational" + and the accompanying FXT-library with permission of the author. +*/ + +/* + Setup from + + Chung, Jaewook, and M. Anwar Hasan. "Asymmetric squaring formulae." + 18th IEEE Symposium on Computer Arithmetic (ARITH'07). IEEE, 2007. + + The interpolation from above needed one temporary variable more + than the interpolation here: + + Bodrato, Marco, and Alberto Zanoni. "What about Toom-Cook matrices optimality." + Centro Vito Volterra Universita di Roma Tor Vergata (2006) +*/ + +mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) +{ + mp_int S1, S2, T1, a0, a1, a2, b0, b1, b2; + int B, count; + mp_err err; + + /* init temps */ + if ((err = mp_init_multi(&S1, &S2, &T1, NULL)) != MP_OKAY) { + return err; + } + + /* B */ + B = MP_MIN(a->used, b->used) / 3; + + /** a = a2 * x^2 + a1 * x + a0; */ + if ((err = mp_init_size(&a0, B)) != MP_OKAY) goto LBL_ERRa0; + + for (count = 0; count < B; count++) { + a0.dp[count] = a->dp[count]; + a0.used++; + } + mp_clamp(&a0); + if ((err = mp_init_size(&a1, B)) != MP_OKAY) goto LBL_ERRa1; + for (; count < (2 * B); count++) { + a1.dp[count - B] = a->dp[count]; + a1.used++; + } + mp_clamp(&a1); + if ((err = mp_init_size(&a2, B + (a->used - (3 * B)))) != MP_OKAY) goto LBL_ERRa2; + for (; count < a->used; count++) { + a2.dp[count - (2 * B)] = a->dp[count]; + a2.used++; + } + mp_clamp(&a2); + + /** b = b2 * x^2 + b1 * x + b0; */ + if ((err = mp_init_size(&b0, B)) != MP_OKAY) goto LBL_ERRb0; + for (count = 0; count < B; count++) { + b0.dp[count] = b->dp[count]; + b0.used++; + } + mp_clamp(&b0); + if ((err = mp_init_size(&b1, B)) != MP_OKAY) goto LBL_ERRb1; + for (; count < (2 * B); count++) { + b1.dp[count - B] = b->dp[count]; + b1.used++; + } + mp_clamp(&b1); + if ((err = mp_init_size(&b2, B + (b->used - (3 * B)))) != MP_OKAY) goto LBL_ERRb2; + for (; count < b->used; count++) { + b2.dp[count - (2 * B)] = b->dp[count]; + b2.used++; + } + mp_clamp(&b2); + + /** \\ S1 = (a2+a1+a0) * (b2+b1+b0); */ + /** T1 = a2 + a1; */ + if ((err = mp_add(&a2, &a1, &T1)) != MP_OKAY) goto LBL_ERR; + + /** S2 = T1 + a0; */ + if ((err = mp_add(&T1, &a0, &S2)) != MP_OKAY) goto LBL_ERR; + + /** c = b2 + b1; */ + if ((err = mp_add(&b2, &b1, c)) != MP_OKAY) goto LBL_ERR; + + /** S1 = c + b0; */ + if ((err = mp_add(c, &b0, &S1)) != MP_OKAY) goto LBL_ERR; + + /** S1 = S1 * S2; */ + if ((err = mp_mul(&S1, &S2, &S1)) != MP_OKAY) goto LBL_ERR; + + /** \\S2 = (4*a2+2*a1+a0) * (4*b2+2*b1+b0); */ + /** T1 = T1 + a2; */ + if ((err = mp_add(&T1, &a2, &T1)) != MP_OKAY) goto LBL_ERR; + + /** T1 = T1 << 1; */ + if ((err = mp_mul_2(&T1, &T1)) != MP_OKAY) goto LBL_ERR; + + /** T1 = T1 + a0; */ + if ((err = mp_add(&T1, &a0, &T1)) != MP_OKAY) goto LBL_ERR; + + /** c = c + b2; */ + if ((err = mp_add(c, &b2, c)) != MP_OKAY) goto LBL_ERR; + + /** c = c << 1; */ + if ((err = mp_mul_2(c, c)) != MP_OKAY) goto LBL_ERR; + + /** c = c + b0; */ + if ((err = mp_add(c, &b0, c)) != MP_OKAY) goto LBL_ERR; + + /** S2 = T1 * c; */ + if ((err = mp_mul(&T1, c, &S2)) != MP_OKAY) goto LBL_ERR; + + /** \\S3 = (a2-a1+a0) * (b2-b1+b0); */ + /** a1 = a2 - a1; */ + if ((err = mp_sub(&a2, &a1, &a1)) != MP_OKAY) goto LBL_ERR; + + /** a1 = a1 + a0; */ + if ((err = mp_add(&a1, &a0, &a1)) != MP_OKAY) goto LBL_ERR; + + /** b1 = b2 - b1; */ + if ((err = mp_sub(&b2, &b1, &b1)) != MP_OKAY) goto LBL_ERR; + + /** b1 = b1 + b0; */ + if ((err = mp_add(&b1, &b0, &b1)) != MP_OKAY) goto LBL_ERR; + + /** a1 = a1 * b1; */ + if ((err = mp_mul(&a1, &b1, &a1)) != MP_OKAY) goto LBL_ERR; + + /** b1 = a2 * b2; */ + if ((err = mp_mul(&a2, &b2, &b1)) != MP_OKAY) goto LBL_ERR; + + /** \\S2 = (S2 - S3)/3; */ + /** S2 = S2 - a1; */ + if ((err = mp_sub(&S2, &a1, &S2)) != MP_OKAY) goto LBL_ERR; + + /** S2 = S2 / 3; \\ this is an exact division */ + if ((err = mp_div_3(&S2, &S2, NULL)) != MP_OKAY) goto LBL_ERR; + + /** a1 = S1 - a1; */ + if ((err = mp_sub(&S1, &a1, &a1)) != MP_OKAY) goto LBL_ERR; + + /** a1 = a1 >> 1; */ + if ((err = mp_div_2(&a1, &a1)) != MP_OKAY) goto LBL_ERR; + + /** a0 = a0 * b0; */ + if ((err = mp_mul(&a0, &b0, &a0)) != MP_OKAY) goto LBL_ERR; + + /** S1 = S1 - a0; */ + if ((err = mp_sub(&S1, &a0, &S1)) != MP_OKAY) goto LBL_ERR; + + /** S2 = S2 - S1; */ + if ((err = mp_sub(&S2, &S1, &S2)) != MP_OKAY) goto LBL_ERR; + + /** S2 = S2 >> 1; */ + if ((err = mp_div_2(&S2, &S2)) != MP_OKAY) goto LBL_ERR; + + /** S1 = S1 - a1; */ + if ((err = mp_sub(&S1, &a1, &S1)) != MP_OKAY) goto LBL_ERR; + + /** S1 = S1 - b1; */ + if ((err = mp_sub(&S1, &b1, &S1)) != MP_OKAY) goto LBL_ERR; + + /** T1 = b1 << 1; */ + if ((err = mp_mul_2(&b1, &T1)) != MP_OKAY) goto LBL_ERR; + + /** S2 = S2 - T1; */ + if ((err = mp_sub(&S2, &T1, &S2)) != MP_OKAY) goto LBL_ERR; + + /** a1 = a1 - S2; */ + if ((err = mp_sub(&a1, &S2, &a1)) != MP_OKAY) goto LBL_ERR; + + + /** P = b1*x^4+ S2*x^3+ S1*x^2+ a1*x + a0; */ + if ((err = mp_lshd(&b1, 4 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_lshd(&S2, 3 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&b1, &S2, &b1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_lshd(&S1, 2 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&b1, &S1, &b1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_lshd(&a1, 1 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&b1, &a1, &b1)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&b1, &a0, c)) != MP_OKAY) goto LBL_ERR; + + /** a * b - P */ + + +LBL_ERR: + mp_clear(&b2); +LBL_ERRb2: + mp_clear(&b1); +LBL_ERRb1: + mp_clear(&b0); +LBL_ERRb0: + mp_clear(&a2); +LBL_ERRa2: + mp_clear(&a1); +LBL_ERRa1: + mp_clear(&a0); +LBL_ERRa0: + mp_clear_multi(&S1, &S2, &T1, NULL); + return err; +} + +#endif ADDED libtommath/bn_s_mp_toom_sqr.c Index: libtommath/bn_s_mp_toom_sqr.c ================================================================== --- /dev/null +++ libtommath/bn_s_mp_toom_sqr.c @@ -0,0 +1,147 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_TOOM_SQR_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* squaring using Toom-Cook 3-way algorithm */ + +/* + This file contains code from J. Arndt's book "Matters Computational" + and the accompanying FXT-library with permission of the author. +*/ + +/* squaring using Toom-Cook 3-way algorithm */ +/* + Setup and interpolation from algorithm SQR_3 in + + Chung, Jaewook, and M. Anwar Hasan. "Asymmetric squaring formulae." + 18th IEEE Symposium on Computer Arithmetic (ARITH'07). IEEE, 2007. + +*/ +mp_err s_mp_toom_sqr(const mp_int *a, mp_int *b) +{ + mp_int S0, a0, a1, a2; + mp_digit *tmpa, *tmpc; + int B, count; + mp_err err; + + + /* init temps */ + if ((err = mp_init(&S0)) != MP_OKAY) { + return err; + } + + /* B */ + B = a->used / 3; + + /** a = a2 * x^2 + a1 * x + a0; */ + if ((err = mp_init_size(&a0, B)) != MP_OKAY) goto LBL_ERRa0; + + a0.used = B; + if ((err = mp_init_size(&a1, B)) != MP_OKAY) goto LBL_ERRa1; + a1.used = B; + if ((err = mp_init_size(&a2, B + (a->used - (3 * B)))) != MP_OKAY) goto LBL_ERRa2; + + tmpa = a->dp; + tmpc = a0.dp; + for (count = 0; count < B; count++) { + *tmpc++ = *tmpa++; + } + tmpc = a1.dp; + for (; count < (2 * B); count++) { + *tmpc++ = *tmpa++; + } + tmpc = a2.dp; + for (; count < a->used; count++) { + *tmpc++ = *tmpa++; + a2.used++; + } + mp_clamp(&a0); + mp_clamp(&a1); + mp_clamp(&a2); + + /** S0 = a0^2; */ + if ((err = mp_sqr(&a0, &S0)) != MP_OKAY) goto LBL_ERR; + + /** \\S1 = (a2 + a1 + a0)^2 */ + /** \\S2 = (a2 - a1 + a0)^2 */ + /** \\S1 = a0 + a2; */ + /** a0 = a0 + a2; */ + if ((err = mp_add(&a0, &a2, &a0)) != MP_OKAY) goto LBL_ERR; + /** \\S2 = S1 - a1; */ + /** b = a0 - a1; */ + if ((err = mp_sub(&a0, &a1, b)) != MP_OKAY) goto LBL_ERR; + /** \\S1 = S1 + a1; */ + /** a0 = a0 + a1; */ + if ((err = mp_add(&a0, &a1, &a0)) != MP_OKAY) goto LBL_ERR; + /** \\S1 = S1^2; */ + /** a0 = a0^2; */ + if ((err = mp_sqr(&a0, &a0)) != MP_OKAY) goto LBL_ERR; + /** \\S2 = S2^2; */ + /** b = b^2; */ + if ((err = mp_sqr(b, b)) != MP_OKAY) goto LBL_ERR; + + /** \\ S3 = 2 * a1 * a2 */ + /** \\S3 = a1 * a2; */ + /** a1 = a1 * a2; */ + if ((err = mp_mul(&a1, &a2, &a1)) != MP_OKAY) goto LBL_ERR; + /** \\S3 = S3 << 1; */ + /** a1 = a1 << 1; */ + if ((err = mp_mul_2(&a1, &a1)) != MP_OKAY) goto LBL_ERR; + + /** \\S4 = a2^2; */ + /** a2 = a2^2; */ + if ((err = mp_sqr(&a2, &a2)) != MP_OKAY) goto LBL_ERR; + + /** \\ tmp = (S1 + S2)/2 */ + /** \\tmp = S1 + S2; */ + /** b = a0 + b; */ + if ((err = mp_add(&a0, b, b)) != MP_OKAY) goto LBL_ERR; + /** \\tmp = tmp >> 1; */ + /** b = b >> 1; */ + if ((err = mp_div_2(b, b)) != MP_OKAY) goto LBL_ERR; + + /** \\ S1 = S1 - tmp - S3 */ + /** \\S1 = S1 - tmp; */ + /** a0 = a0 - b; */ + if ((err = mp_sub(&a0, b, &a0)) != MP_OKAY) goto LBL_ERR; + /** \\S1 = S1 - S3; */ + /** a0 = a0 - a1; */ + if ((err = mp_sub(&a0, &a1, &a0)) != MP_OKAY) goto LBL_ERR; + + /** \\S2 = tmp - S4 -S0 */ + /** \\S2 = tmp - S4; */ + /** b = b - a2; */ + if ((err = mp_sub(b, &a2, b)) != MP_OKAY) goto LBL_ERR; + /** \\S2 = S2 - S0; */ + /** b = b - S0; */ + if ((err = mp_sub(b, &S0, b)) != MP_OKAY) goto LBL_ERR; + + + /** \\P = S4*x^4 + S3*x^3 + S2*x^2 + S1*x + S0; */ + /** P = a2*x^4 + a1*x^3 + b*x^2 + a0*x + S0; */ + + if ((err = mp_lshd(&a2, 4 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_lshd(&a1, 3 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_lshd(b, 2 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_lshd(&a0, 1 * B)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&a2, &a1, &a2)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(&a2, b, b)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(b, &a0, b)) != MP_OKAY) goto LBL_ERR; + if ((err = mp_add(b, &S0, b)) != MP_OKAY) goto LBL_ERR; + /** a^2 - P */ + + +LBL_ERR: + mp_clear(&a2); +LBL_ERRa2: + mp_clear(&a1); +LBL_ERRa1: + mp_clear(&a0); +LBL_ERRa0: + mp_clear(&S0); + + return err; +} + +#endif DELETED libtommath/bncore.c Index: libtommath/bncore.c ================================================================== --- libtommath/bncore.c +++ /dev/null @@ -1,33 +0,0 @@ -#include "tommath_private.h" -#ifdef BNCORE_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ - -/* Known optimal configurations - - CPU /Compiler /MUL CUTOFF/SQR CUTOFF -------------------------------------------------------------- - Intel P4 Northwood /GCC v3.4.1 / 88/ 128/LTM 0.32 ;-) - AMD Athlon64 /GCC v3.4.4 / 80/ 120/LTM 0.35 - -*/ - -int KARATSUBA_MUL_CUTOFF = 80, /* Min. number of digits before Karatsuba multiplication is used. */ - KARATSUBA_SQR_CUTOFF = 120, /* Min. number of digits before Karatsuba squaring is used. */ - - TOOM_MUL_CUTOFF = 350, /* no optimal values of these are known yet so set em high */ - TOOM_SQR_CUTOFF = 400; -#endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/changes.txt ================================================================== --- libtommath/changes.txt +++ libtommath/changes.txt @@ -1,5 +1,42 @@ +Oct 22nd, 2019 +v1.2.0 + -- A huge refactoring of the library happened - renaming, + deprecating and replacing existing functions by improved API's. + + All deprecated functions, macros and symbols are only marked as such + so this version is still API and ABI compatible to v1.x. + + -- Daniel Mendler was pushing for those changes and contributing a load of patches, + refactorings, code reviews and whatnotelse. + -- Christoph Zurnieden re-worked internals of the library, improved the performance, + did code reviews and wrote documentation. + -- Francois Perrad did some refactoring and took again care of linting the sources and + provided all fixes. + -- Jan Nijtmans, Karel Miko and Joachim Breitner contributed various patches. + + -- Private symbols can now be hidden for the shared library builds, disabled by default. + -- All API's follow a single code style, are prefixed the same etc. + -- Unified, safer and improved API's + -- Less magic numbers - return values (where appropriate) and most flags are now enums, + this was implemented in a backwards compatible way where return values were int. + -- API's with return values are now by default marked as "warn on unsused result", this + can be disabled if required (which will most likely hide bugs), c.f. MP_WUR in tommath.h + -- Provide a whole set of setters&getters for different primitive types (long, uint32_t, etc.) + -- All those primitive setters are now optimized. + -- It's possible to automatically tune the cutoff values for Karatsuba&Toom-Cook + -- The custom allocators which were formerly known as XMALLOC(), XFREE() etc. are now available + as MP_MALLOC(), MP_REALLOC(), MP_CALLOC() and MP_FREE(). MP_REALLOC() and MP_FREE() now also + provide the allocated size to ease the usage of simple allocators without tracking. + -- Building is now also possible with MSVC 2015, 2017 and 2019 (use makefile.msvc) + -- Added mp_decr() and mp_incr() + -- Added mp_log_u32() + -- Improved prime-checking + -- Improved Toom-Cook multiplication + -- Removed the LTM book (`make docs` now builds the user manual) + + Jan 28th, 2019 v1.1.0 -- Christoph Zurnieden contributed FIPS 186.4 compliant prime-checking (PR #113), several other fixes and a load of documentation -- Daniel Mendler provided two's-complement functions (PR #124) ADDED libtommath/helper.pl Index: libtommath/helper.pl ================================================================== --- /dev/null +++ libtommath/helper.pl @@ -0,0 +1,482 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Getopt::Long; +use File::Find 'find'; +use File::Basename 'basename'; +use File::Glob 'bsd_glob'; + +sub read_file { + my $f = shift; + open my $fh, "<", $f or die "FATAL: read_rawfile() cannot open file '$f': $!"; + binmode $fh; + return do { local $/; <$fh> }; +} + +sub write_file { + my ($f, $data) = @_; + die "FATAL: write_file() no data" unless defined $data; + open my $fh, ">", $f or die "FATAL: write_file() cannot open file '$f': $!"; + binmode $fh; + print $fh $data or die "FATAL: write_file() cannot write to '$f': $!"; + close $fh or die "FATAL: write_file() cannot close '$f': $!"; + return; +} + +sub sanitize_comments { + my($content) = @_; + $content =~ s{/\*(.*?)\*/}{my $x=$1; $x =~ s/\w/x/g; "/*$x*/";}egs; + return $content; +} + +sub check_source { + my @all_files = ( + bsd_glob("makefile*"), + bsd_glob("*.{h,c,sh,pl}"), + bsd_glob("*/*.{h,c,sh,pl}"), + ); + + my $fails = 0; + for my $file (sort @all_files) { + my $troubles = {}; + my $lineno = 1; + my $content = read_file($file); + $content = sanitize_comments $content; + push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/; + for my $l (split /\n/, $content) { + push @{$troubles->{merge_conflict}}, $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/; + push @{$troubles->{trailing_space}}, $lineno if $l =~ / $/; + push @{$troubles->{tab}}, $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i; + push @{$troubles->{non_ascii_char}}, $lineno if $l =~ /[^[:ascii:]]/; + push @{$troubles->{cpp_comment}}, $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/); + # we prefer using MP_MALLOC, MP_FREE, MP_REALLOC, MP_CALLOC ... + push @{$troubles->{unwanted_malloc}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmalloc\s*\(/; + push @{$troubles->{unwanted_realloc}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\brealloc\s*\(/; + push @{$troubles->{unwanted_calloc}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bcalloc\s*\(/; + push @{$troubles->{unwanted_free}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bfree\s*\(/; + # and we probably want to also avoid the following + push @{$troubles->{unwanted_memcpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/; + push @{$troubles->{unwanted_memset}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemset\s*\(/; + push @{$troubles->{unwanted_memcpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/; + push @{$troubles->{unwanted_memmove}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemmove\s*\(/; + push @{$troubles->{unwanted_memcmp}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcmp\s*\(/; + push @{$troubles->{unwanted_strcmp}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcmp\s*\(/; + push @{$troubles->{unwanted_strcpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcpy\s*\(/; + push @{$troubles->{unwanted_strncpy}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrncpy\s*\(/; + push @{$troubles->{unwanted_clock}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bclock\s*\(/; + push @{$troubles->{unwanted_qsort}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bqsort\s*\(/; + push @{$troubles->{sizeof_no_brackets}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bsizeof\s*[^\(]/; + if ($file =~ m|^[^\/]+\.c$| && $l =~ /^static(\s+[a-zA-Z0-9_]+)+\s+([a-zA-Z0-9_]+)\s*\(/) { + my $funcname = $2; + # static functions should start with s_ + push @{$troubles->{staticfunc_name}}, "$lineno($funcname)" if $funcname !~ /^s_/; + } + $lineno++; + } + for my $k (sort keys %$troubles) { + warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n"; + $fails++; + } + } + + warn( $fails > 0 ? "check-source: FAIL $fails\n" : "check-source: PASS\n" ); + return $fails; +} + +sub check_comments { + my $fails = 0; + my $first_comment = <<'MARKER'; +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ +MARKER + #my @all_files = (bsd_glob("*.{h,c}"), bsd_glob("*/*.{h,c}")); + my @all_files = (bsd_glob("*.{h,c}")); + for my $f (@all_files) { + my $txt = read_file($f); + if ($txt !~ /\Q$first_comment\E/s) { + warn "[first_comment] $f\n"; + $fails++; + } + } + warn( $fails > 0 ? "check-comments: FAIL $fails\n" : "check-comments: PASS\n" ); + return $fails; +} + +sub check_doc { + my $fails = 0; + my $tex = read_file('doc/bn.tex'); + my $tmh = read_file('tommath.h'); + my @functions = $tmh =~ /\n\s*[a-zA-Z0-9_* ]+?(mp_[a-z0-9_]+)\s*$[^$]+\)\s*;/sg; + my @macros = $tmh =~ /\n\s*#define\s+([a-z0-9_]+)\s*$[^$]+\)/sg; + for my $n (sort @functions) { + (my $nn = $n) =~ s/_/\\_/g; # mp_sub_d >> mp\_sub\_d + if ($tex !~ /index\Q{$nn}\E/) { + warn "[missing_doc_for_function] $n\n"; + $fails++ + } + } + for my $n (sort @macros) { + (my $nn = $n) =~ s/_/\\_/g; # mp_iszero >> mp\_iszero + if ($tex !~ /index\Q{$nn}\E/) { + warn "[missing_doc_for_macro] $n\n"; + $fails++ + } + } + warn( $fails > 0 ? "check_doc: FAIL $fails\n" : "check-doc: PASS\n" ); + return $fails; +} + +sub prepare_variable { + my ($varname, @list) = @_; + my $output = "$varname="; + my $len = length($output); + foreach my $obj (sort @list) { + $len = $len + length $obj; + $obj =~ s/\*/\$/; + if ($len > 100) { + $output .= "\\\n"; + $len = length $obj; + } + $output .= $obj . ' '; + } + $output =~ s/ $//; + return $output; +} + +sub prepare_msvc_files_xml { + my ($all, $exclude_re, $targets) = @_; + my $last = []; + my $depth = 2; + + # sort files in the same order as visual studio (ugly, I know) + my @parts = (); + for my $orig (@$all) { + my $p = $orig; + $p =~ s|/|/~|g; + $p =~ s|/~([^/]+)$|/$1|g; + my @l = map { sprintf "% -99s", $_ } split /\//, $p; + push @parts, [ $orig, join(':', @l) ]; + } + my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts; + + my $files = "\r\n"; + for my $full (@sorted) { + my @items = split /\//, $full; # split by '/' + $full =~ s|/|\\|g; # replace '/' bt '\' + shift @items; # drop first one (src) + pop @items; # drop last one (filename.ext) + my $current = \@items; + if (join(':', @$current) ne join(':', @$last)) { + my $common = 0; + $common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]); + my $back = @$last - $common; + if ($back > 0) { + $files .= ("\t" x --$depth) . "\r\n" for (1..$back); + } + my $fwd = [ @$current ]; splice(@$fwd, 0, $common); + for my $i (0..scalar(@$fwd) - 1) { + $files .= ("\t" x $depth) . "[$i]\"\r\n"; + $files .= ("\t" x $depth) . "\t>\r\n"; + $depth++; + } + $last = $current; + } + $files .= ("\t" x $depth) . "\r\n"; + if ($full =~ $exclude_re) { + for (@$targets) { + $files .= ("\t" x $depth) . "\t\r\n"; + $files .= ("\t" x $depth) . "\t\t\r\n"; + $files .= ("\t" x $depth) . "\t\r\n"; + } + } + $files .= ("\t" x $depth) . "\r\n"; + } + $files .= ("\t" x --$depth) . "\r\n" for (@$last); + $files .= "\t"; + return $files; +} + +sub patch_file { + my ($content, @variables) = @_; + for my $v (@variables) { + if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) { + my $name = $1; + $content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s; + } + else { + die "patch_file failed: " . substr($v, 0, 30) . ".."; + } + } + return $content; +} + +sub process_makefiles { + my $write = shift; + my $changed_count = 0; + my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } bsd_glob("*.c"); + my @all = bsd_glob("*.{c,h}"); + + my $var_o = prepare_variable("OBJECTS", @o); + (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg; + + # update MSVC project files + my $msvc_files = prepare_msvc_files_xml(\@all, qr/NOT_USED_HERE/, ['Debug|Win32', 'Release|Win32', 'Debug|x64', 'Release|x64']); + for my $m (qw/libtommath_VS2008.vcproj/) { + my $old = read_file($m); + my $new = $old; + $new =~ s|.*|$msvc_files|s; + if ($old ne $new) { + write_file($m, $new) if $write; + warn "changed: $m\n"; + $changed_count++; + } + } + + # update OBJECTS + HEADERS in makefile* + for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw /) { + my $old = read_file($m); + my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj) + : patch_file($old, $var_o); + if ($old ne $new) { + write_file($m, $new) if $write; + warn "changed: $m\n"; + $changed_count++; + } + } + + if ($write) { + return 0; # no failures + } + else { + warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" ); + return $changed_count; + } +} + +sub draw_func +{ + my ($deplist, $depmap, $out, $indent, $funcslist) = @_; + my @funcs = split ',', $funcslist; + # try this if you want to have a look at a minimized version of the callgraph without all the trivial functions + #if ($deplist =~ /$funcs[0]/ || $funcs[0] =~ /BN_MP_(ADD|SUB|CLEAR|CLEAR_\S+|DIV|MUL|COPY|ZERO|GROW|CLAMP|INIT|INIT_\S+|SET|ABS|CMP|CMP_D|EXCH)_C/) { + if ($deplist =~ /$funcs[0]/) { + return $deplist; + } else { + $deplist = $deplist . $funcs[0]; + } + if ($indent == 0) { + } elsif ($indent >= 1) { + print {$out} '| ' x ($indent - 1) . '+--->'; + } + print {$out} $funcs[0] . "\n"; + shift @funcs; + my $olddeplist = $deplist; + foreach my $i (@funcs) { + $deplist = draw_func($deplist, $depmap, $out, $indent + 1, ${$depmap}{$i}) if exists ${$depmap}{$i}; + } + return $olddeplist; +} + +sub update_dep +{ + #open class file and write preamble + open(my $class, '>', 'tommath_class.h') or die "Couldn't open tommath_class.h for writing\n"; + print {$class} << 'EOS'; +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#if !(defined(LTM1) && defined(LTM2) && defined(LTM3)) +#define LTM_INSIDE +#if defined(LTM2) +# define LTM3 +#endif +#if defined(LTM1) +# define LTM2 +#endif +#define LTM1 +#if defined(LTM_ALL) +EOS + + foreach my $filename (glob 'bn*.c') { + my $define = $filename; + + print "Processing $filename\n"; + + # convert filename to upper case so we can use it as a define + $define =~ tr/[a-z]/[A-Z]/; + $define =~ tr/\./_/; + print {$class} "# define $define\n"; + + # now copy text and apply #ifdef as required + my $apply = 0; + open(my $src, '<', $filename); + open(my $out, '>', 'tmp'); + + # first line will be the #ifdef + my $line = <$src>; + if ($line =~ /include/) { + print {$out} $line; + } else { + print {$out} << "EOS"; +#include "tommath_private.h" +#ifdef $define +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ +$line +EOS + $apply = 1; + } + while (<$src>) { + if ($_ !~ /tommath\.h/) { + print {$out} $_; + } + } + if ($apply == 1) { + print {$out} "#endif\n"; + } + close $src; + close $out; + + unlink $filename; + rename 'tmp', $filename; + } + print {$class} "#endif\n#endif\n"; + + # now do classes + my %depmap; + foreach my $filename (glob 'bn*.c') { + my $content; + if ($filename =~ "bn_deprecated.c") { + open(my $src, '<', $filename) or die "Can't open source file!\n"; + read $src, $content, -s $src; + close $src; + } else { + my $cc = $ENV{'CC'} || 'gcc'; + $content = `$cc -E -x c -DLTM_ALL $filename`; + $content =~ s/^# 1 "$filename".*?^# 2 "$filename"//ms; + } + + # convert filename to upper case so we can use it as a define + $filename =~ tr/[a-z]/[A-Z]/; + $filename =~ tr/\./_/; + + print {$class} "#if defined($filename)\n"; + my $list = $filename; + + # strip comments + $content =~ s{/\*.*?\*/}{}gs; + + # scan for mp_* and make classes + my @deps = (); + foreach my $line (split /\n/, $content) { + while ($line =~ /(fast_)?(s_)?mp\_[a-z_0-9]*((?=\;)|(?=\())|(?<=\()mp\_[a-z_0-9]*(?=\()/g) { + my $a = $&; + next if $a eq "mp_err"; + $a =~ tr/[a-z]/[A-Z]/; + $a = 'BN_' . $a . '_C'; + push @deps, $a; + } + } + @deps = sort(@deps); + foreach my $a (@deps) { + if ($list !~ /$a/) { + print {$class} "# define $a\n"; + } + $list = $list . ',' . $a; + } + $depmap{$filename} = $list; + + print {$class} "#endif\n\n"; + } + + print {$class} << 'EOS'; +#ifdef LTM_INSIDE +#undef LTM_INSIDE +#ifdef LTM3 +# define LTM_LAST +#endif + +#include "tommath_superclass.h" +#include "tommath_class.h" +#else +# define LTM_LAST +#endif +EOS + close $class; + + #now let's make a cool call graph... + + open(my $out, '>', 'callgraph.txt'); + foreach (sort keys %depmap) { + draw_func("", \%depmap, $out, 0, $depmap{$_}); + print {$out} "\n\n"; + } + close $out; + + return 0; +} + +sub generate_def { + my @files = split /\n/, `git ls-files`; + @files = grep(/\.c/, @files); + @files = map { my $x = $_; $x =~ s/^bn_|\.c$//g; $x; } @files; + @files = grep(!/mp_radix_smap/, @files); + + push(@files, qw(mp_set_int mp_set_long mp_set_long_long mp_get_int mp_get_long mp_get_long_long mp_init_set_int)); + + my $files = join("\n ", sort(grep(/^mp_/, @files))); + write_file "tommath.def", "; libtommath +; +; Use this command to produce a 32-bit .lib file, for use in any MSVC version +; lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib +; Use this command to produce a 64-bit .lib file, for use in any MSVC version +; lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib +; +EXPORTS + $files +"; + return 0; +} + +sub die_usage { + die <<"MARKER"; +usage: $0 -s OR $0 --check-source + $0 -o OR $0 --check-comments + $0 -m OR $0 --check-makefiles + $0 -a OR $0 --check-all + $0 -u OR $0 --update-files +MARKER +} + +GetOptions( "s|check-source" => \my $check_source, + "o|check-comments" => \my $check_comments, + "m|check-makefiles" => \my $check_makefiles, + "d|check-doc" => \my $check_doc, + "a|check-all" => \my $check_all, + "u|update-files" => \my $update_files, + "h|help" => \my $help + ) or die_usage; + +my $failure; +$failure ||= check_source() if $check_all || $check_source; +$failure ||= check_comments() if $check_all || $check_comments; +$failure ||= check_doc() if $check_doc; # temporarily excluded from --check-all +$failure ||= process_makefiles(0) if $check_all || $check_makefiles; +$failure ||= process_makefiles(1) if $update_files; +$failure ||= update_dep() if $update_files; +$failure ||= generate_def() if $update_files; + +die_usage unless defined $failure; +exit $failure ? 1 : 0; Index: libtommath/libtommath_VS2008.vcproj ================================================================== --- libtommath/libtommath_VS2008.vcproj +++ libtommath/libtommath_VS2008.vcproj @@ -311,31 +311,15 @@ - - - - - - - - @@ -397,10 +381,14 @@ > + + @@ -429,134 +417,174 @@ > + + - - - - - - + + + + - - + + + + + + + + + + + + + + + + + + - - + + + + + + - - + + @@ -601,38 +629,34 @@ > - - - - + + + + - - @@ -647,11 +671,11 @@ @@ -669,18 +693,10 @@ > - - - - @@ -709,14 +725,22 @@ > + + + + @@ -723,27 +747,47 @@ + + + + + + + + + + @@ -771,59 +815,27 @@ - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + @@ -833,50 +845,114 @@ > - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Index: libtommath/makefile ================================================================== --- libtommath/makefile +++ libtommath/makefile @@ -15,50 +15,51 @@ coverage: LIBNAME:=-Wl,--whole-archive $(LIBNAME) -Wl,--no-whole-archive include makefile_include.mk -%.o: %.c +%.o: %.c $(HEADERS) ifneq ($V,1) @echo " * ${CC} $@" endif - ${silent} ${CC} -c ${CFLAGS} $< -o $@ + ${silent} ${CC} -c ${LTM_CFLAGS} $< -o $@ LCOV_ARGS=--directory . #START_INS -OBJECTS=bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \ -bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \ -bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \ -bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div.o \ -bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \ -bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \ -bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_bit.o \ -bn_mp_get_double.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o \ -bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o \ -bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o \ -bn_mp_karatsuba_sqr.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o \ -bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o \ -bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_divisible.o \ +OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ +bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ +bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ +bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ +bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ +bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ +bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ +bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ +bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ +bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ +bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o \ -bn_mp_read_unsigned_bin.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ -bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o \ -bn_mp_set.o bn_mp_set_double.o bn_mp_set_int.o bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \ -bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o \ -bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o \ -bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ -bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o \ -bn_mp_zero.o bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o bncore.o +bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ +bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ +bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ +bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ +bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ +bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ +bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ +bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ +bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ +bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ +bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ +bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ +bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ +bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o #END_INS -$(OBJECTS): $(HEADERS) - $(LIBNAME): $(OBJECTS) $(AR) $(ARFLAGS) $@ $(OBJECTS) $(RANLIB) $@ #make a profiled library (takes a while!!!) @@ -74,15 +75,15 @@ make CFLAGS="$(CFLAGS) -fbranch-probabilities" #make a single object profiled library profiled_single: perl gen.pl - $(CC) $(CFLAGS) -fprofile-arcs -DTESTING -c mpi.c -o mpi.o - $(CC) $(CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -lgcov -o timing + $(CC) $(LTM_CFLAGS) -fprofile-arcs -DTESTING -c mpi.c -o mpi.o + $(CC) $(LTM_CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -lgcov -o timing ./timing rm -f *.o timing - $(CC) $(CFLAGS) -fbranch-probabilities -DTESTING -c mpi.c -o mpi.o + $(CC) $(LTM_CFLAGS) -fbranch-probabilities -DTESTING -c mpi.c -o mpi.o $(AR) $(ARFLAGS) $(LIBNAME) mpi.o ranlib $(LIBNAME) install: $(LIBNAME) install -d $(DESTDIR)$(LIBPATH) @@ -92,42 +93,49 @@ uninstall: rm $(DESTDIR)$(LIBPATH)/$(LIBNAME) rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%) -test: $(LIBNAME) demo/demo.o - $(CC) $(CFLAGS) demo/demo.o $(LIBNAME) $(LFLAGS) -o test +test_standalone: test + @echo "test_standalone is deprecated, please use make-target 'test'" + +DEMOS=test mtest_opponent + +define DEMO_template +$(1): demo/$(1).o demo/shared.o $$(LIBNAME) + $$(CC) $$(LTM_CFLAGS) $$(LTM_LFLAGS) $$^ -o $$@ +endef -test_standalone: $(LIBNAME) demo/demo.o - $(CC) $(CFLAGS) demo/demo.o $(LIBNAME) $(LFLAGS) -o test +$(foreach demo, $(strip $(DEMOS)), $(eval $(call DEMO_template,$(demo)))) .PHONY: mtest mtest: - cd mtest ; $(CC) $(CFLAGS) -O0 mtest.c $(LFLAGS) -o mtest + cd mtest ; $(CC) $(LTM_CFLAGS) -O0 mtest.c $(LTM_LFLAGS) -o mtest timing: $(LIBNAME) demo/timing.c - $(CC) $(CFLAGS) -DTIMER demo/timing.c $(LIBNAME) $(LFLAGS) -o timing + $(CC) $(LTM_CFLAGS) -DTIMER demo/timing.c $(LIBNAME) $(LTM_LFLAGS) -o timing + +tune: $(LIBNAME) + $(MAKE) -C etc tune CFLAGS="$(LTM_CFLAGS)" + $(MAKE) # You have to create a file .coveralls.yml with the content "repo_token: " # in the base folder to be able to submit to coveralls coveralls: lcov coveralls-lcov -docdvi poster docs mandvi manual: +docs manual: $(MAKE) -C doc/ $@ V=$(V) -pretty: - perl pretty.build - .PHONY: pre_gen pre_gen: mkdir -p pre_gen perl gen.pl sed -e 's/[[:blank:]]*$$//' mpi.c > pre_gen/mpi.c rm mpi.c -zipup: clean astyle new_file manual poster docs +zipup: clean astyle new_file docs @# Update the index, so diff-index won't fail in case the pdf has been created. @# As the pdf creation modifies the tex files, git sometimes detects the @# modified files, but misses that it's put back to its original version. @git update-index --refresh @git diff-index --quiet HEAD -- || ( echo "FAILURE: uncommited changes or not a git" && exit 1 ) @@ -135,24 +143,23 @@ @# files/dirs excluded from "git archive" are defined in .gitattributes git archive --format=tar --prefix=libtommath-$(VERSION)/ HEAD | tar x @echo 'fixme check' -@(find libtommath-$(VERSION)/ -type f | xargs grep 'FIXM[E]') && echo '############## BEWARE: the "fixme" marker was found !!! ##############' || true mkdir -p libtommath-$(VERSION)/doc - cp doc/bn.pdf doc/tommath.pdf doc/poster.pdf libtommath-$(VERSION)/doc/ + cp doc/bn.pdf libtommath-$(VERSION)/doc/ $(MAKE) -C libtommath-$(VERSION)/ pre_gen tar -c libtommath-$(VERSION)/ | xz -6e -c - > ltm-$(VERSION).tar.xz zip -9rq ltm-$(VERSION).zip libtommath-$(VERSION) cp doc/bn.pdf bn-$(VERSION).pdf - cp doc/tommath.pdf tommath-$(VERSION).pdf rm -rf libtommath-$(VERSION) gpg -b -a ltm-$(VERSION).tar.xz gpg -b -a ltm-$(VERSION).zip new_file: - bash updatemakes.sh - perl dep.pl + perl helper.pl --update-files perlcritic: perlcritic *.pl doc/*.pl astyle: - astyle --options=astylerc $(OBJECTS:.o=.c) tommath*.h demo/*.c etc/*.c mtest/mtest.c + @echo " * run astyle on all sources" + @astyle --options=astylerc --formatted $(OBJECTS:.o=.c) tommath*.h demo/*.c etc/*.c mtest/mtest.c Index: libtommath/makefile.mingw ================================================================== --- libtommath/makefile.mingw +++ libtommath/makefile.mingw @@ -1,8 +1,8 @@ # MAKEFILE for MS Windows (mingw + gcc + gmake) # -# BEWARE: variable OBJECTS is updated via ./updatemakes.sh +# BEWARE: variable OBJECTS is updated via helper.pl ### USAGE: # Open a command prompt with gcc + gmake in PATH and start: # # gmake -f makefile.mingw all @@ -19,48 +19,50 @@ CFLAGS = -O2 LDFLAGS = #Compilation flags LTM_CFLAGS = -I. $(CFLAGS) -LTM_LDFLAGS = $(LDFLAGS) +LTM_LDFLAGS = $(LDFLAGS) -static-libgcc #Libraries to be created LIBMAIN_S =libtommath.a LIBMAIN_I =libtommath.dll.a LIBMAIN_D =libtommath.dll #List of objects to compile (all goes to libtommath.a) -OBJECTS=bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \ -bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \ -bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \ -bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div.o \ -bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \ -bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \ -bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_bit.o \ -bn_mp_get_double.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o \ -bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o \ -bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o \ -bn_mp_karatsuba_sqr.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o \ -bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o \ -bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_divisible.o \ +OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ +bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ +bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ +bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ +bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ +bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ +bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ +bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ +bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ +bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ +bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o \ -bn_mp_read_unsigned_bin.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ -bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o \ -bn_mp_set.o bn_mp_set_double.o bn_mp_set_int.o bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \ -bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o \ -bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o \ -bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ -bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o \ -bn_mp_zero.o bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o bncore.o - -HEADERS_PUB=tommath.h tommath_class.h tommath_superclass.h - -HEADERS=tommath_private.h $(HEADERS_PUB) +bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ +bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ +bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ +bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ +bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ +bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ +bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ +bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ +bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ +bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ +bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ +bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ +bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ +bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o + +HEADERS_PUB=tommath.h +HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) #The default rule for make builds the libtommath.a library (static) default: $(LIBMAIN_S) #Dependencies on *.h @@ -77,18 +79,23 @@ #Create DLL + import library libtommath.dll.a $(LIBMAIN_D) $(LIBMAIN_I): $(OBJECTS) $(CC) -s -shared -o $(LIBMAIN_D) $^ -Wl,--enable-auto-import,--export-all -Wl,--out-implib=$(LIBMAIN_I) $(LTM_LDFLAGS) $(STRIP) -S $(LIBMAIN_D) -#Build test_standalone suite -test.exe: $(LIBMAIN_S) demo/demo.c - $(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) demo/demo.c $(LIBMAIN_S) -DLTM_DEMO_TEST_VS_MTEST=0 -o $@ +#Build test suite +test.exe: demo/shared.o demo/test.o $(LIBMAIN_S) + $(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) $^ -o $@ @echo NOTICE: start the tests by launching test.exe test_standalone: test.exe + @echo test_standalone is deprecated, please use make-target 'test.exe' + +all: $(LIBMAIN_S) test.exe -all: $(LIBMAIN_S) test_standalone +tune: $(LIBNAME_S) + $(MAKE) -C etc tune + $(MAKE) clean: @-cmd /c del /Q /S *.o *.a *.exe *.dll 2>nul #Install the library + headers @@ -98,9 +105,5 @@ cmd /c if not exist "$(PREFIX)\include" mkdir "$(PREFIX)\include" copy /Y $(LIBMAIN_S) "$(PREFIX)\lib" copy /Y $(LIBMAIN_I) "$(PREFIX)\lib" copy /Y $(LIBMAIN_D) "$(PREFIX)\bin" copy /Y tommath*.h "$(PREFIX)\include" - -# ref: $Format:%D$ -# git commit: $Format:%H$ -# commit time: $Format:%ai$ Index: libtommath/makefile.msvc ================================================================== --- libtommath/makefile.msvc +++ libtommath/makefile.msvc @@ -1,8 +1,8 @@ # MAKEFILE for MS Windows (nmake + Windows SDK) # -# BEWARE: variable OBJECTS is updated via ./updatemakes.sh +# BEWARE: variable OBJECTS is updated via helper.pl ### USAGE: # Open a command prompt with WinSDK variables set and start: # # nmake -f makefile.msvc all @@ -12,47 +12,49 @@ #The following can be overridden from command line e.g. make -f makefile.msvc CC=gcc ARFLAGS=rcs PREFIX = c:\devel CFLAGS = /Ox #Compilation flags -LTM_CFLAGS = /nologo /I./ /D_CRT_SECURE_NO_WARNINGS /D_CRT_NONSTDC_NO_DEPRECATE /W3 $(CFLAGS) +LTM_CFLAGS = /nologo /I./ /D_CRT_SECURE_NO_WARNINGS /D_CRT_NONSTDC_NO_DEPRECATE /D__STDC_WANT_SECURE_LIB__=1 /D_CRT_HAS_CXX17=0 /Wall /wd4146 /wd4127 /wd4668 /wd4710 /wd4711 /wd4820 /wd5045 /WX $(CFLAGS) LTM_LDFLAGS = advapi32.lib #Libraries to be created (this makefile builds only static libraries) LIBMAIN_S =tommath.lib #List of objects to compile (all goes to tommath.lib) -OBJECTS=bn_error.obj bn_fast_mp_invmod.obj bn_fast_mp_montgomery_reduce.obj bn_fast_s_mp_mul_digs.obj \ -bn_fast_s_mp_mul_high_digs.obj bn_fast_s_mp_sqr.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj \ -bn_mp_addmod.obj bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj \ -bn_mp_cmp_mag.obj bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_div.obj \ -bn_mp_div_2.obj bn_mp_div_2d.obj bn_mp_div_3.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj \ -bn_mp_dr_setup.obj bn_mp_exch.obj bn_mp_export.obj bn_mp_expt_d.obj bn_mp_expt_d_ex.obj bn_mp_exptmod.obj \ -bn_mp_exptmod_fast.obj bn_mp_exteuclid.obj bn_mp_fread.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_bit.obj \ -bn_mp_get_double.obj bn_mp_get_int.obj bn_mp_get_long.obj bn_mp_get_long_long.obj bn_mp_grow.obj bn_mp_import.obj \ -bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_set_int.obj bn_mp_init_size.obj \ -bn_mp_invmod.obj bn_mp_invmod_slow.obj bn_mp_is_square.obj bn_mp_jacobi.obj bn_mp_karatsuba_mul.obj \ -bn_mp_karatsuba_sqr.obj bn_mp_kronecker.obj bn_mp_lcm.obj bn_mp_lshd.obj bn_mp_mod.obj bn_mp_mod_2d.obj bn_mp_mod_d.obj \ -bn_mp_montgomery_calc_normalization.obj bn_mp_montgomery_reduce.obj bn_mp_montgomery_setup.obj bn_mp_mul.obj \ -bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul_d.obj bn_mp_mulmod.obj bn_mp_n_root.obj bn_mp_n_root_ex.obj bn_mp_neg.obj \ -bn_mp_or.obj bn_mp_prime_fermat.obj bn_mp_prime_frobenius_underwood.obj bn_mp_prime_is_divisible.obj \ +OBJECTS=bn_cutoffs.obj bn_deprecated.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj bn_mp_addmod.obj \ +bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj bn_mp_cmp_mag.obj \ +bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_decr.obj bn_mp_div.obj bn_mp_div_2.obj \ +bn_mp_div_2d.obj bn_mp_div_3.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj \ +bn_mp_error_to_string.obj bn_mp_exch.obj bn_mp_expt_u32.obj bn_mp_exptmod.obj bn_mp_exteuclid.obj bn_mp_fread.obj \ +bn_mp_from_sbin.obj bn_mp_from_ubin.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_double.obj bn_mp_get_i32.obj \ +bn_mp_get_i64.obj bn_mp_get_l.obj bn_mp_get_ll.obj bn_mp_get_mag_u32.obj bn_mp_get_mag_u64.obj bn_mp_get_mag_ul.obj \ +bn_mp_get_mag_ull.obj bn_mp_grow.obj bn_mp_incr.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_i32.obj \ +bn_mp_init_i64.obj bn_mp_init_l.obj bn_mp_init_ll.obj bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_size.obj \ +bn_mp_init_u32.obj bn_mp_init_u64.obj bn_mp_init_ul.obj bn_mp_init_ull.obj bn_mp_invmod.obj bn_mp_is_square.obj \ +bn_mp_iseven.obj bn_mp_isodd.obj bn_mp_kronecker.obj bn_mp_lcm.obj bn_mp_log_u32.obj bn_mp_lshd.obj bn_mp_mod.obj \ +bn_mp_mod_2d.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj bn_mp_montgomery_reduce.obj \ +bn_mp_montgomery_setup.obj bn_mp_mul.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul_d.obj bn_mp_mulmod.obj bn_mp_neg.obj \ +bn_mp_or.obj bn_mp_pack.obj bn_mp_pack_count.obj bn_mp_prime_fermat.obj bn_mp_prime_frobenius_underwood.obj \ bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \ -bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_random_ex.obj bn_mp_prime_strong_lucas_selfridge.obj \ -bn_mp_radix_size.obj bn_mp_radix_smap.obj bn_mp_rand.obj bn_mp_read_radix.obj bn_mp_read_signed_bin.obj \ -bn_mp_read_unsigned_bin.obj bn_mp_reduce.obj bn_mp_reduce_2k.obj bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj \ -bn_mp_reduce_2k_setup_l.obj bn_mp_reduce_is_2k.obj bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj bn_mp_rshd.obj \ -bn_mp_set.obj bn_mp_set_double.obj bn_mp_set_int.obj bn_mp_set_long.obj bn_mp_set_long_long.obj bn_mp_shrink.obj \ -bn_mp_signed_bin_size.obj bn_mp_sqr.obj bn_mp_sqrmod.obj bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj \ -bn_mp_sub_d.obj bn_mp_submod.obj bn_mp_tc_and.obj bn_mp_tc_div_2d.obj bn_mp_tc_or.obj bn_mp_tc_xor.obj \ -bn_mp_to_signed_bin.obj bn_mp_to_signed_bin_n.obj bn_mp_to_unsigned_bin.obj bn_mp_to_unsigned_bin_n.obj \ -bn_mp_toom_mul.obj bn_mp_toom_sqr.obj bn_mp_toradix.obj bn_mp_toradix_n.obj bn_mp_unsigned_bin_size.obj bn_mp_xor.obj \ -bn_mp_zero.obj bn_prime_tab.obj bn_reverse.obj bn_s_mp_add.obj bn_s_mp_exptmod.obj bn_s_mp_mul_digs.obj \ -bn_s_mp_mul_high_digs.obj bn_s_mp_sqr.obj bn_s_mp_sub.obj bncore.obj - -HEADERS_PUB=tommath.h tommath_class.h tommath_superclass.h - -HEADERS=tommath_private.h $(HEADERS_PUB) +bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_rand.obj bn_mp_prime_strong_lucas_selfridge.obj \ +bn_mp_radix_size.obj bn_mp_radix_smap.obj bn_mp_rand.obj bn_mp_read_radix.obj bn_mp_reduce.obj bn_mp_reduce_2k.obj \ +bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj bn_mp_reduce_2k_setup_l.obj bn_mp_reduce_is_2k.obj \ +bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj bn_mp_root_u32.obj bn_mp_rshd.obj bn_mp_sbin_size.obj bn_mp_set.obj \ +bn_mp_set_double.obj bn_mp_set_i32.obj bn_mp_set_i64.obj bn_mp_set_l.obj bn_mp_set_ll.obj bn_mp_set_u32.obj \ +bn_mp_set_u64.obj bn_mp_set_ul.obj bn_mp_set_ull.obj bn_mp_shrink.obj bn_mp_signed_rsh.obj bn_mp_sqr.obj \ +bn_mp_sqrmod.obj bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj \ +bn_mp_to_radix.obj bn_mp_to_sbin.obj bn_mp_to_ubin.obj bn_mp_ubin_size.obj bn_mp_unpack.obj bn_mp_xor.obj bn_mp_zero.obj \ +bn_prime_tab.obj bn_s_mp_add.obj bn_s_mp_balance_mul.obj bn_s_mp_exptmod.obj bn_s_mp_exptmod_fast.obj \ +bn_s_mp_get_bit.obj bn_s_mp_invmod_fast.obj bn_s_mp_invmod_slow.obj bn_s_mp_karatsuba_mul.obj \ +bn_s_mp_karatsuba_sqr.obj bn_s_mp_montgomery_reduce_fast.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_digs_fast.obj \ +bn_s_mp_mul_high_digs.obj bn_s_mp_mul_high_digs_fast.obj bn_s_mp_prime_is_divisible.obj \ +bn_s_mp_rand_jenkins.obj bn_s_mp_rand_platform.obj bn_s_mp_reverse.obj bn_s_mp_sqr.obj bn_s_mp_sqr_fast.obj \ +bn_s_mp_sub.obj bn_s_mp_toom_mul.obj bn_s_mp_toom_sqr.obj + +HEADERS_PUB=tommath.h +HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) #The default rule for make builds the tommath.lib library (static) default: $(LIBMAIN_S) #Dependencies on *.h @@ -59,22 +61,27 @@ $(OBJECTS): $(HEADERS) .c.obj: $(CC) $(LTM_CFLAGS) /c $< /Fo$@ -#Create tomcrypt.lib +#Create tommath.lib $(LIBMAIN_S): $(OBJECTS) lib /out:$(LIBMAIN_S) $(OBJECTS) -#Build test_standalone suite -test.exe: $(LIBMAIN_S) demo/demo.c - cl $(LTM_CFLAGS) $(TOBJECTS) $(LIBMAIN_S) $(LTM_LDFLAGS) demo/demo.c /DLTM_DEMO_TEST_VS_MTEST=0 /Fe$@ +#Build test suite +test.exe: $(LIBMAIN_S) demo/shared.obj demo/test.obj + cl $(LTM_CFLAGS) $(TOBJECTS) $(LIBMAIN_S) $(LTM_LDFLAGS) demo/shared.c demo/test.c /Fe$@ @echo NOTICE: start the tests by launching test.exe test_standalone: test.exe + @echo test_standalone is deprecated, please use make-target 'test.exe' + +all: $(LIBMAIN_S) test.exe -all: $(LIBMAIN_S) test_standalone +tune: $(LIBMAIN_S) + $(MAKE) -C etc tune + $(MAKE) clean: @-cmd /c del /Q /S *.OBJ *.LIB *.EXE *.DLL 2>nul #Install the library + headers @@ -82,9 +89,5 @@ cmd /c if not exist "$(PREFIX)\bin" mkdir "$(PREFIX)\bin" cmd /c if not exist "$(PREFIX)\lib" mkdir "$(PREFIX)\lib" cmd /c if not exist "$(PREFIX)\include" mkdir "$(PREFIX)\include" copy /Y $(LIBMAIN_S) "$(PREFIX)\lib" copy /Y tommath*.h "$(PREFIX)\include" - -# ref: $Format:%D$ -# git commit: $Format:%H$ -# commit time: $Format:%ai$ Index: libtommath/makefile.shared ================================================================== --- libtommath/makefile.shared +++ libtommath/makefile.shared @@ -16,52 +16,56 @@ else LIBTOOL:=libtool endif endif LTCOMPILE = $(LIBTOOL) --mode=compile --tag=CC $(CC) +LTLINK = $(LIBTOOL) --mode=link --tag=CC $(CC) LCOV_ARGS=--directory .libs --directory . #START_INS -OBJECTS=bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \ -bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \ -bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \ -bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div.o \ -bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \ -bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \ -bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_bit.o \ -bn_mp_get_double.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o \ -bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o \ -bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o \ -bn_mp_karatsuba_sqr.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o \ -bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o \ -bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_divisible.o \ +OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ +bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ +bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ +bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ +bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ +bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ +bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ +bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ +bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ +bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ +bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o \ -bn_mp_read_unsigned_bin.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ -bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o \ -bn_mp_set.o bn_mp_set_double.o bn_mp_set_int.o bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \ -bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o \ -bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o \ -bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ -bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o \ -bn_mp_zero.o bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o bncore.o +bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ +bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ +bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ +bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ +bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ +bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ +bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ +bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ +bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ +bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ +bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ +bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ +bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ +bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o #END_INS objs: $(OBJECTS) -.c.o: - $(LTCOMPILE) $(CFLAGS) $(LDFLAGS) -o $@ -c $< +.c.o: $(HEADERS) + $(LTCOMPILE) $(LTM_CFLAGS) $(LTM_LDFLAGS) -o $@ -c $< LOBJECTS = $(OBJECTS:.o=.lo) $(LIBNAME): $(OBJECTS) - $(LIBTOOL) --mode=link --tag=CC $(CC) $(LDFLAGS) $(LOBJECTS) -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION_SO) $(LIBTOOLFLAGS) + $(LTLINK) $(LTM_LDFLAGS) $(LOBJECTS) -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION_SO) $(LTM_LIBTOOLFLAGS) install: $(LIBNAME) install -d $(DESTDIR)$(LIBPATH) install -d $(DESTDIR)$(INCPATH) $(LIBTOOL) --mode=install install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME) @@ -73,19 +77,23 @@ uninstall: $(LIBTOOL) --mode=uninstall rm $(DESTDIR)$(LIBPATH)/$(LIBNAME) rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%) rm $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc -test: $(LIBNAME) demo/demo.o - $(CC) $(CFLAGS) -c demo/demo.c -o demo/demo.o - $(LIBTOOL) --mode=link $(CC) $(LDFLAGS) -o test demo/demo.o $(LIBNAME) +test_standalone: test + @echo "test_standalone is deprecated, please use make-target 'test'" -test_standalone: $(LIBNAME) demo/demo.o - $(CC) $(CFLAGS) -c demo/demo.c -o demo/demo.o - $(LIBTOOL) --mode=link $(CC) $(LDFLAGS) -o test demo/demo.o $(LIBNAME) +test mtest_opponent: demo/shared.o $(LIBNAME) | demo/test.o demo/mtest_opponent.o + $(LTLINK) $(LTM_LDFLAGS) demo/$@.o $^ -o $@ .PHONY: mtest mtest: - cd mtest ; $(CC) $(CFLAGS) $(LDFLAGS) mtest.c -o mtest + cd mtest ; $(CC) $(LTM_CFLAGS) -O0 mtest.c $(LTM_LDFLAGS) -o mtest timing: $(LIBNAME) demo/timing.c - $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o timing + $(LTLINK) $(LTM_CFLAGS) $(LTM_LDFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o timing + +tune: $(LIBNAME) + $(LTCOMPILE) $(LTM_CFLAGS) -c etc/tune.c -o etc/tune.o + $(LTLINK) $(LTM_LDFLAGS) -o etc/tune etc/tune.o $(LIBNAME) + cd etc/; /bin/sh tune_it.sh; cd .. + $(MAKE) -f makefile.shared Index: libtommath/makefile.unix ================================================================== --- libtommath/makefile.unix +++ libtommath/makefile.unix @@ -19,49 +19,51 @@ ARFLAGS = r RANLIB = ranlib CFLAGS = -O2 LDFLAGS = -VERSION = 1.1.0 +VERSION = 1.2.0 #Compilation flags LTM_CFLAGS = -I. $(CFLAGS) LTM_LDFLAGS = $(LDFLAGS) #Library to be created (this makefile builds only static library) LIBMAIN_S = libtommath.a -OBJECTS=bn_error.o bn_fast_mp_invmod.o bn_fast_mp_montgomery_reduce.o bn_fast_s_mp_mul_digs.o \ -bn_fast_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o \ -bn_mp_addmod.o bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o \ -bn_mp_cmp_mag.o bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_div.o \ -bn_mp_div_2.o bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o \ -bn_mp_dr_setup.o bn_mp_exch.o bn_mp_export.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_exptmod.o \ -bn_mp_exptmod_fast.o bn_mp_exteuclid.o bn_mp_fread.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_bit.o \ -bn_mp_get_double.o bn_mp_get_int.o bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_import.o \ -bn_mp_init.o bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_set_int.o bn_mp_init_size.o \ -bn_mp_invmod.o bn_mp_invmod_slow.o bn_mp_is_square.o bn_mp_jacobi.o bn_mp_karatsuba_mul.o \ -bn_mp_karatsuba_sqr.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o \ -bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o \ -bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_n_root.o bn_mp_n_root_ex.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_divisible.o \ +OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ +bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ +bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ +bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ +bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ +bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ +bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ +bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ +bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ +bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ +bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_random_ex.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_read_signed_bin.o \ -bn_mp_read_unsigned_bin.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ -bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_rshd.o \ -bn_mp_set.o bn_mp_set_double.o bn_mp_set_int.o bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \ -bn_mp_signed_bin_size.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o \ -bn_mp_sub_d.o bn_mp_submod.o bn_mp_tc_and.o bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o \ -bn_mp_to_signed_bin.o bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ -bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix.o bn_mp_toradix_n.o bn_mp_unsigned_bin_size.o bn_mp_xor.o \ -bn_mp_zero.o bn_prime_tab.o bn_reverse.o bn_s_mp_add.o bn_s_mp_exptmod.o bn_s_mp_mul_digs.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o bncore.o - -HEADERS_PUB=tommath.h tommath_class.h tommath_superclass.h - -HEADERS=tommath_private.h $(HEADERS_PUB) +bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ +bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ +bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ +bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ +bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ +bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ +bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ +bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ +bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ +bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ +bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ +bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ +bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ +bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o + +HEADERS_PUB=tommath.h +HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) #The default rule for make builds the libtommath.a library (static) default: $(LIBMAIN_S) #Dependencies on *.h @@ -76,28 +78,29 @@ $(LIBMAIN_S): $(OBJECTS) $(AR) $(ARFLAGS) $@ $(OBJECTS) $(RANLIB) $@ #Build test_standalone suite -test: $(LIBMAIN_S) demo/demo.c - $(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) demo/demo.c $(LIBMAIN_S) -DLTM_DEMO_TEST_VS_MTEST=0 -o $@ +test: demo/shared.o demo/test.o $(LIBMAIN_S) + $(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) $^ -o $@ @echo "NOTICE: start the tests by: ./test" test_standalone: test + @echo "test_standalone is deprecated, please use make-target 'test'" + +all: $(LIBMAIN_S) test -all: $(LIBMAIN_S) test_standalone +tune: $(LIBMAIN_S) + $(MAKE) -C etc tune + $(MAKE) #NOTE: this makefile works also on cygwin, thus we need to delete *.exe clean: -@rm -f $(OBJECTS) $(LIBMAIN_S) - -@rm -f demo/demo.o test test.exe + -@rm -f demo/main.o demo/opponent.o demo/test.o test test.exe #Install the library + headers install: $(LIBMAIN_S) @mkdir -p $(DESTDIR)$(INCPATH) $(DESTDIR)$(LIBPATH)/pkgconfig @cp $(LIBMAIN_S) $(DESTDIR)$(LIBPATH)/ @cp $(HEADERS_PUB) $(DESTDIR)$(INCPATH)/ @sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION),' libtommath.pc.in > $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc - -# ref: $Format:%D$ -# git commit: $Format:%H$ -# commit time: $Format:%ai$ Index: libtommath/makefile_include.mk ================================================================== --- libtommath/makefile_include.mk +++ libtommath/makefile_include.mk @@ -1,13 +1,13 @@ # # Include makefile for libtommath # #version of library -VERSION=1.1.0 -VERSION_PC=1.1.0 -VERSION_SO=2:0:1 +VERSION=1.2.0 +VERSION_PC=1.2.0 +VERSION_SO=3:0:2 PLATFORM := $(shell uname | sed -e 's/_.*//') # default make target default: ${LIBNAME} @@ -45,86 +45,107 @@ else MAKE=make endif endif -CFLAGS += -I./ -Wall -Wsign-compare -Wextra -Wshadow +LTM_CFLAGS += -I./ -Wall -Wsign-compare -Wextra -Wshadow + +ifdef SANITIZER +LTM_CFLAGS += -fsanitize=undefined -fno-sanitize-recover=all -fno-sanitize=float-divide-by-zero +endif ifndef NO_ADDTL_WARNINGS # additional warnings -CFLAGS += -Wsystem-headers -Wdeclaration-after-statement -Wbad-function-cast -Wcast-align -CFLAGS += -Wstrict-prototypes -Wpointer-arith +LTM_CFLAGS += -Wdeclaration-after-statement -Wbad-function-cast -Wcast-align +LTM_CFLAGS += -Wstrict-prototypes -Wpointer-arith +endif + +ifdef CONV_WARNINGS +LTM_CFLAGS += -std=c89 -Wconversion -Wsign-conversion +ifeq ($(CONV_WARNINGS), strict) +LTM_CFLAGS += -DMP_USE_ENUMS -Wc++-compat +endif +else +LTM_CFLAGS += -Wsystem-headers endif ifdef COMPILE_DEBUG #debug -CFLAGS += -g3 -else +LTM_CFLAGS += -g3 +endif ifdef COMPILE_SIZE #for size -CFLAGS += -Os +LTM_CFLAGS += -Os else ifndef IGNORE_SPEED #for speed -CFLAGS += -O3 -funroll-loops +LTM_CFLAGS += -O3 -funroll-loops #x86 optimizations [should be valid for any GCC install though] -CFLAGS += -fomit-frame-pointer +LTM_CFLAGS += -fomit-frame-pointer endif endif # COMPILE_SIZE -endif # COMPILE_DEBUG ifneq ($(findstring clang,$(CC)),) -CFLAGS += -Wno-typedef-redefinition -Wno-tautological-compare -Wno-builtin-requires-header +LTM_CFLAGS += -Wno-typedef-redefinition -Wno-tautological-compare -Wno-builtin-requires-header endif ifneq ($(findstring mingw,$(CC)),) -CFLAGS += -Wno-shadow +LTM_CFLAGS += -Wno-shadow endif ifeq ($(PLATFORM), Darwin) -CFLAGS += -Wno-nullability-completeness +LTM_CFLAGS += -Wno-nullability-completeness endif ifeq ($(PLATFORM), CYGWIN) LIBTOOLFLAGS += -no-undefined endif + +# add in the standard FLAGS +LTM_CFLAGS += $(CFLAGS) +LTM_LFLAGS += $(LFLAGS) +LTM_LDFLAGS += $(LDFLAGS) +LTM_LIBTOOLFLAGS += $(LIBTOOLFLAGS) + ifeq ($(PLATFORM),FreeBSD) _ARCH := $(shell sysctl -b hw.machine_arch) else - _ARCH := $(shell arch) + _ARCH := $(shell uname -m) endif # adjust coverage set ifneq ($(filter $(_ARCH), i386 i686 x86_64 amd64 ia64),) - COVERAGE = test_standalone timing + COVERAGE = test timing COVERAGE_APP = ./test && ./timing else - COVERAGE = test_standalone + COVERAGE = test COVERAGE_APP = ./test endif -HEADERS_PUB=tommath.h tommath_class.h tommath_superclass.h -HEADERS=tommath_private.h $(HEADERS_PUB) - -test_standalone: CFLAGS+=-DLTM_DEMO_TEST_VS_MTEST=0 +HEADERS_PUB=tommath.h +HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) #LIBPATH The directory for libtommath to be installed to. #INCPATH The directory to install the header files for libtommath. #DATAPATH The directory to install the pdf docs. DESTDIR ?= PREFIX ?= /usr/local LIBPATH ?= $(PREFIX)/lib INCPATH ?= $(PREFIX)/include DATAPATH ?= $(PREFIX)/share/doc/libtommath/pdf + +# build & run test-suite +check: test + ./test #make the code coverage of the library # -coverage: CFLAGS += -fprofile-arcs -ftest-coverage -DTIMING_NO_LOGS -coverage: LFLAGS += -lgcov -coverage: LDFLAGS += -lgcov +coverage: LTM_CFLAGS += -fprofile-arcs -ftest-coverage -DTIMING_NO_LOGS +coverage: LTM_LFLAGS += -lgcov +coverage: LTM_LDFLAGS += -lgcov coverage: $(COVERAGE) $(COVERAGE_APP) lcov: coverage @@ -139,10 +160,11 @@ # cleans everything - coverage output and standard 'clean' cleancov: cleancov-clean clean clean: - rm -f *.gcda *.gcno *.gcov *.bat *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test timing mpitest mtest/mtest mtest/mtest.exe \ - *.idx *.toc *.log *.aux *.dvi *.lof *.ind *.ilg *.ps *.log *.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la - rm -rf .libs/ + rm -f *.gcda *.gcno *.gcov *.bat *.o *.a *.obj *.lib *.exe *.dll etclib/*.o \ + demo/*.o test timing mtest_opponent mtest/mtest mtest/mtest.exe tuning_list \ + *.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la + rm -rf .libs/ demo/.libs ${MAKE} -C etc/ clean MAKE=${MAKE} ${MAKE} -C doc/ clean MAKE=${MAKE} ADDED libtommath/tommath.def Index: libtommath/tommath.def ================================================================== --- /dev/null +++ libtommath/tommath.def @@ -0,0 +1,145 @@ +; libtommath +; +; Use this command to produce a 32-bit .lib file, for use in any MSVC version +; lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib +; Use this command to produce a 64-bit .lib file, for use in any MSVC version +; lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib +; +EXPORTS + mp_2expt + mp_abs + mp_add + mp_add_d + mp_addmod + mp_and + mp_clamp + mp_clear + mp_clear_multi + mp_cmp + mp_cmp_d + mp_cmp_mag + mp_cnt_lsb + mp_complement + mp_copy + mp_count_bits + mp_decr + mp_div + mp_div_2 + mp_div_2d + mp_div_3 + mp_div_d + mp_dr_is_modulus + mp_dr_reduce + mp_dr_setup + mp_error_to_string + mp_exch + mp_expt_u32 + mp_exptmod + mp_exteuclid + mp_fread + mp_from_sbin + mp_from_ubin + mp_fwrite + mp_gcd + mp_get_double + mp_get_i32 + mp_get_i64 + mp_get_int + mp_get_l + mp_get_ll + mp_get_long + mp_get_long_long + mp_get_mag_u32 + mp_get_mag_u64 + mp_get_mag_ul + mp_get_mag_ull + mp_grow + mp_incr + mp_init + mp_init_copy + mp_init_i32 + mp_init_i64 + mp_init_l + mp_init_ll + mp_init_multi + mp_init_set + mp_init_set_int + mp_init_size + mp_init_u32 + mp_init_u64 + mp_init_ul + mp_init_ull + mp_invmod + mp_is_square + mp_iseven + mp_isodd + mp_kronecker + mp_lcm + mp_log_u32 + mp_lshd + mp_mod + mp_mod_2d + mp_mod_d + mp_montgomery_calc_normalization + mp_montgomery_reduce + mp_montgomery_setup + mp_mul + mp_mul_2 + mp_mul_2d + mp_mul_d + mp_mulmod + mp_neg + mp_or + mp_pack + mp_pack_count + mp_prime_fermat + mp_prime_frobenius_underwood + mp_prime_is_prime + mp_prime_miller_rabin + mp_prime_next_prime + mp_prime_rabin_miller_trials + mp_prime_rand + mp_prime_strong_lucas_selfridge + mp_radix_size + mp_rand + mp_read_radix + mp_reduce + mp_reduce_2k + mp_reduce_2k_l + mp_reduce_2k_setup + mp_reduce_2k_setup_l + mp_reduce_is_2k + mp_reduce_is_2k_l + mp_reduce_setup + mp_root_u32 + mp_rshd + mp_sbin_size + mp_set + mp_set_double + mp_set_i32 + mp_set_i64 + mp_set_int + mp_set_l + mp_set_ll + mp_set_long + mp_set_long_long + mp_set_u32 + mp_set_u64 + mp_set_ul + mp_set_ull + mp_shrink + mp_signed_rsh + mp_sqr + mp_sqrmod + mp_sqrt + mp_sqrtmod_prime + mp_sub + mp_sub_d + mp_submod + mp_to_radix + mp_to_sbin + mp_to_ubin + mp_ubin_size + mp_unpack + mp_xor + mp_zero Index: libtommath/tommath.h ================================================================== --- libtommath/tommath.h +++ libtommath/tommath.h @@ -2,22 +2,40 @@ /* SPDX-License-Identifier: Unlicense */ #ifndef BN_H_ #define BN_H_ -#include -#include +#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \ + && !defined(__CLANG_STDINT_H) && !defined(_STDINT) +# include +#endif +#include #include -#include "tommath_class.h" +#ifdef LTM_NO_FILE +# warning LTM_NO_FILE has been deprecated, use MP_NO_FILE. +# define MP_NO_FILE +#endif + +#ifndef MP_NO_FILE +# include +#endif + +#ifdef MP_8BIT +# ifdef _MSC_VER +# pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.") +# else +# warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version." +# endif +#endif #ifdef __cplusplus extern "C" { #endif /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */ -#if defined(_WIN32) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__) +#if (defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_32BIT) && !defined(MP_64BIT) # define MP_32BIT #endif /* detect 64-bit mode if possible */ #if defined(__x86_64__) || defined(_M_X64) || defined(_M_AMD64) || \ @@ -24,472 +42,666 @@ defined(__powerpc64__) || defined(__ppc64__) || defined(__PPC64__) || \ defined(__s390x__) || defined(__arch64__) || defined(__aarch64__) || \ defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \ defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \ defined(__LP64__) || defined(_LP64) || defined(__64BIT__) -# if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT)) -# if defined(__GNUC__) +# if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT)) +# if defined(__GNUC__) && !defined(__hppa) /* we support 128bit integers only via: __attribute__((mode(TI))) */ # define MP_64BIT # else /* otherwise we fall back to MP_32BIT even on 64bit platforms */ # define MP_32BIT # endif # endif #endif -typedef unsigned long long Tcl_WideUInt; +#ifdef MP_DIGIT_BIT +# error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT +#endif /* some default configurations. * - * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits - * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits + * A "mp_digit" must be able to hold MP_DIGIT_BIT + 1 bits + * A "mp_word" must be able to hold 2*MP_DIGIT_BIT + 1 bits * * At the very least a mp_digit must be able to hold 7 bits * [any size beyond that is ok provided it doesn't overflow the data type] */ + #ifdef MP_8BIT -typedef unsigned char mp_digit; -typedef unsigned short mp_word; -# define MP_SIZEOF_MP_DIGIT 1 -# ifdef DIGIT_BIT -# error You must not define DIGIT_BIT when using MP_8BIT -# endif +typedef uint8_t mp_digit; +typedef uint16_t private_mp_word; +# define MP_DIGIT_BIT 7 #elif defined(MP_16BIT) -typedef unsigned short mp_digit; -typedef unsigned int mp_word; -# define MP_SIZEOF_MP_DIGIT 2 -# ifdef DIGIT_BIT -# error You must not define DIGIT_BIT when using MP_16BIT -# endif +typedef uint16_t mp_digit; +typedef uint32_t private_mp_word; +# define MP_DIGIT_BIT 15 #elif defined(MP_64BIT) /* for GCC only on supported platforms */ -typedef unsigned long long mp_digit; -typedef unsigned long mp_word __attribute__((mode(TI))); -# define DIGIT_BIT 60 +typedef uint64_t mp_digit; +#if defined(__GNUC__) +typedef unsigned long private_mp_word __attribute__((mode(TI))); +#endif +# define MP_DIGIT_BIT 60 #else -/* this is the default case, 28-bit digits */ - -/* this is to make porting into LibTomCrypt easier :-) */ -typedef unsigned int mp_digit; -typedef unsigned long long mp_word; - +typedef uint32_t mp_digit; +typedef uint64_t private_mp_word; # ifdef MP_31BIT -/* this is an extension that uses 31-bit digits */ -# define DIGIT_BIT 31 +/* + * This is an extension that uses 31-bit digits. + * Please be aware that not all functions support this size, especially s_mp_mul_digs_fast + * will be reduced to work on small numbers only: + * Up to 8 limbs, 248 bits instead of up to 512 limbs, 15872 bits with MP_28BIT. + */ +# define MP_DIGIT_BIT 31 # else /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */ -# define DIGIT_BIT 28 +# define MP_DIGIT_BIT 28 # define MP_28BIT # endif #endif -#define MP_MASK ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1)) +/* mp_word is a private type */ +#define mp_word MP_DEPRECATED_PRAGMA("mp_word has been made private") private_mp_word -/* equalities */ +#define MP_SIZEOF_MP_DIGIT (MP_DEPRECATED_PRAGMA("MP_SIZEOF_MP_DIGIT has been deprecated, use sizeof (mp_digit)") sizeof (mp_digit)) + +#define MP_MASK ((((mp_digit)1)<<((mp_digit)MP_DIGIT_BIT))-((mp_digit)1)) +#define MP_DIGIT_MAX MP_MASK + +/* Primality generation flags */ +#define MP_PRIME_BBS 0x0001 /* BBS style prime */ +#define MP_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ +#define MP_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */ + +#define LTM_PRIME_BBS (MP_DEPRECATED_PRAGMA("LTM_PRIME_BBS has been deprecated, use MP_PRIME_BBS") MP_PRIME_BBS) +#define LTM_PRIME_SAFE (MP_DEPRECATED_PRAGMA("LTM_PRIME_SAFE has been deprecated, use MP_PRIME_SAFE") MP_PRIME_SAFE) +#define LTM_PRIME_2MSB_ON (MP_DEPRECATED_PRAGMA("LTM_PRIME_2MSB_ON has been deprecated, use MP_PRIME_2MSB_ON") MP_PRIME_2MSB_ON) + +#ifdef MP_USE_ENUMS +typedef enum { + MP_ZPOS = 0, /* positive */ + MP_NEG = 1 /* negative */ +} mp_sign; +typedef enum { + MP_LT = -1, /* less than */ + MP_EQ = 0, /* equal */ + MP_GT = 1 /* greater than */ +} mp_ord; +typedef enum { + MP_NO = 0, + MP_YES = 1 +} mp_bool; +typedef enum { + MP_OKAY = 0, /* no error */ + MP_ERR = -1, /* unknown error */ + MP_MEM = -2, /* out of mem */ + MP_VAL = -3, /* invalid input */ + MP_ITER = -4, /* maximum iterations reached */ + MP_BUF = -5 /* buffer overflow, supplied buffer too small */ +} mp_err; +typedef enum { + MP_LSB_FIRST = -1, + MP_MSB_FIRST = 1 +} mp_order; +typedef enum { + MP_LITTLE_ENDIAN = -1, + MP_NATIVE_ENDIAN = 0, + MP_BIG_ENDIAN = 1 +} mp_endian; +#else +typedef int mp_sign; +#define MP_ZPOS 0 /* positive integer */ +#define MP_NEG 1 /* negative */ +typedef int mp_ord; #define MP_LT -1 /* less than */ #define MP_EQ 0 /* equal to */ #define MP_GT 1 /* greater than */ - -#define MP_ZPOS 0 /* positive integer */ -#define MP_NEG 1 /* negative */ - -#define MP_OKAY 0 /* ok result */ +typedef int mp_bool; +#define MP_YES 1 +#define MP_NO 0 +typedef int mp_err; +#define MP_OKAY 0 /* no error */ +#define MP_ERR -1 /* unknown error */ #define MP_MEM -2 /* out of mem */ #define MP_VAL -3 /* invalid input */ -#define MP_RANGE MP_VAL -#define MP_ITER -4 /* Max. iterations reached */ - -#define MP_YES 1 /* yes response */ -#define MP_NO 0 /* no response */ - -/* Primality generation flags */ -#define LTM_PRIME_BBS 0x0001 /* BBS style prime */ -#define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ -#define LTM_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */ - -typedef int mp_err; +#define MP_RANGE (MP_DEPRECATED_PRAGMA("MP_RANGE has been deprecated in favor of MP_VAL") MP_VAL) +#define MP_ITER -4 /* maximum iterations reached */ +#define MP_BUF -5 /* buffer overflow, supplied buffer too small */ +typedef int mp_order; +#define MP_LSB_FIRST -1 +#define MP_MSB_FIRST 1 +typedef int mp_endian; +#define MP_LITTLE_ENDIAN -1 +#define MP_NATIVE_ENDIAN 0 +#define MP_BIG_ENDIAN 1 +#endif + +/* tunable cutoffs */ + +#ifndef MP_FIXED_CUTOFFS +extern int +KARATSUBA_MUL_CUTOFF, +KARATSUBA_SQR_CUTOFF, +TOOM_MUL_CUTOFF, +TOOM_SQR_CUTOFF; +#endif /* define this to use lower memory usage routines (exptmods mostly) */ /* #define MP_LOW_MEM */ /* default precision */ #ifndef MP_PREC # ifndef MP_LOW_MEM -# define MP_PREC 32 /* default digits of precision */ +# define PRIVATE_MP_PREC 32 /* default digits of precision */ +# elif defined(MP_8BIT) +# define PRIVATE_MP_PREC 16 /* default digits of precision */ # else -# define MP_PREC 8 /* default digits of precision */ +# define PRIVATE_MP_PREC 8 /* default digits of precision */ # endif +# define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC) +#endif + +/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */ +#define PRIVATE_MP_WARRAY (int)(1 << (((CHAR_BIT * (int)sizeof(private_mp_word)) - (2 * MP_DIGIT_BIT)) + 1)) +#define MP_WARRAY (MP_DEPRECATED_PRAGMA("MP_WARRAY is an internal macro") PRIVATE_MP_WARRAY) + +#if defined(__GNUC__) && __GNUC__ >= 4 +# define MP_NULL_TERMINATED __attribute__((sentinel)) +#else +# define MP_NULL_TERMINATED +#endif + +/* + * MP_WUR - warn unused result + * --------------------------- + * + * The result of functions annotated with MP_WUR must be + * checked and cannot be ignored. + * + * Most functions in libtommath return an error code. + * This error code must be checked in order to prevent crashes or invalid + * results. + * + * If you still want to avoid the error checks for quick and dirty programs + * without robustness guarantees, you can `#define MP_WUR` before including + * tommath.h, disabling the warnings. + */ +#ifndef MP_WUR +# if defined(__GNUC__) && __GNUC__ >= 4 +# define MP_WUR __attribute__((warn_unused_result)) +# else +# define MP_WUR +# endif +#endif + +#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405) +# define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) +#elif defined(_MSC_VER) && _MSC_VER >= 1500 +# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) +#else +# define MP_DEPRECATED(x) +#endif + +#ifndef MP_NO_DEPRECATED_PRAGMA +#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301) +# define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s) +# define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s) +#elif defined(_MSC_VER) && _MSC_VER >= 1500 +# define MP_DEPRECATED_PRAGMA(s) __pragma(message(s)) +#endif +#endif + +#ifndef MP_DEPRECATED_PRAGMA +# define MP_DEPRECATED_PRAGMA(s) #endif + +#define DIGIT_BIT (MP_DEPRECATED_PRAGMA("DIGIT_BIT macro is deprecated, MP_DIGIT_BIT instead") MP_DIGIT_BIT) +#define USED(m) (MP_DEPRECATED_PRAGMA("USED macro is deprecated, use z->used instead") (m)->used) +#define DIGIT(m, k) (MP_DEPRECATED_PRAGMA("DIGIT macro is deprecated, use z->dp instead") (m)->dp[(k)]) +#define SIGN(m) (MP_DEPRECATED_PRAGMA("SIGN macro is deprecated, use z->sign instead") (m)->sign) /* the infamous mp_int structure */ -typedef struct { - int used, alloc, sign; +#ifndef MP_INT_DECLARED +#define MP_INT_DECLARED +typedef struct mp_int mp_int; +#endif +struct mp_int { + int used, alloc; + mp_sign sign; mp_digit *dp; -} mp_int; +}; /* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */ -typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat); - +typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat); +typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source) ltm_prime_callback; /* error code to char* string */ -const char *mp_error_to_string(int code); +const char *mp_error_to_string(mp_err code) MP_WUR; /* ---> init and deinit bignum functions <--- */ /* init a bignum */ -int mp_init(mp_int *a); +mp_err mp_init(mp_int *a) MP_WUR; /* free a bignum */ void mp_clear(mp_int *a); /* init a null terminated series of arguments */ -int mp_init_multi(mp_int *mp, ...); +mp_err mp_init_multi(mp_int *mp, ...) MP_NULL_TERMINATED MP_WUR; /* clear a null terminated series of arguments */ -void mp_clear_multi(mp_int *mp, ...); +void mp_clear_multi(mp_int *mp, ...) MP_NULL_TERMINATED; /* exchange two ints */ void mp_exch(mp_int *a, mp_int *b); /* shrink ram required for a bignum */ -mp_err mp_shrink(mp_int *a); +mp_err mp_shrink(mp_int *a) MP_WUR; /* grow an int to a given size */ -mp_err mp_grow(mp_int *a, int size); +mp_err mp_grow(mp_int *a, int size) MP_WUR; /* init to a given number of digits */ -mp_err mp_init_size(mp_int *a, int size); +mp_err mp_init_size(mp_int *a, int size) MP_WUR; /* ---> Basic Manipulations <--- */ #define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO) -#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO) -#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO) +mp_bool mp_iseven(const mp_int *a) MP_WUR; +mp_bool mp_isodd(const mp_int *a) MP_WUR; #define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO) /* set to zero */ void mp_zero(mp_int *a); -/* set to a digit */ +/* get and set doubles */ +double mp_get_double(const mp_int *a) MP_WUR; +mp_err mp_set_double(mp_int *a, double b) MP_WUR; + +/* get integer, set integer and init with integer (int32_t) */ +int32_t mp_get_i32(const mp_int *a) MP_WUR; +void mp_set_i32(mp_int *a, int32_t b); +mp_err mp_init_i32(mp_int *a, int32_t b) MP_WUR; + +/* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint32_t) */ +#define mp_get_u32(a) ((uint32_t)mp_get_i32(a)) +void mp_set_u32(mp_int *a, uint32_t b); +mp_err mp_init_u32(mp_int *a, uint32_t b) MP_WUR; + +/* get integer, set integer and init with integer (int64_t) */ +int64_t mp_get_i64(const mp_int *a) MP_WUR; +void mp_set_i64(mp_int *a, int64_t b); +mp_err mp_init_i64(mp_int *a, int64_t b) MP_WUR; + +/* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint64_t) */ +#define mp_get_u64(a) ((uint64_t)mp_get_i64(a)) +void mp_set_u64(mp_int *a, uint64_t b); +mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR; + +/* get magnitude */ +uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR; +uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR; +unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR; +#ifdef _MSC_VER +#define mp_get_mag_ull(a) ((unsigned __int64)mp_get_mag_u64(a)) +#else +unsigned long long mp_get_mag_ull(const mp_int *a) MP_WUR; +#endif + +/* get integer, set integer (long) */ +long mp_get_l(const mp_int *a) MP_WUR; +void mp_set_l(mp_int *a, long b); +mp_err mp_init_l(mp_int *a, long b) MP_WUR; + +/* get integer, set integer (unsigned long) */ +#define mp_get_ul(a) ((unsigned long)mp_get_l(a)) +void mp_set_ul(mp_int *a, unsigned long b); +mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR; + +#ifdef _MSC_VER +/* get integer, set integer (long long) */ +#define mp_get_ll(a) ((__int64)mp_get_i64(a)) +#define mp_set_ll(a,b) mp_set_i64(a,b) +#define mp_init_ll(a,b) mp_init_i64(a,b) + +/* get integer, set integer (unsigned long long) */ +#define mp_get_ull(a) ((unsigned __int64)mp_get_i64(a)) +#define mp_set_ull(a,b) mp_set_u64(a,b) +#define mp_init_ull(a,b) mp_init_u64(a,b) +#else +/* get integer, set integer (long long) */ +long long mp_get_ll(const mp_int *a) MP_WUR; +void mp_set_ll(mp_int *a, long long b); +mp_err mp_init_ll(mp_int *a, long long b) MP_WUR; + +/* get integer, set integer (unsigned long long) */ +#define mp_get_ull(a) ((unsigned long long)mp_get_ll(a)) +void mp_set_ull(mp_int *a, unsigned long long b); +mp_err mp_init_ull(mp_int *a, unsigned long long b) MP_WUR; +#endif + +/* set to single unsigned digit, up to MP_DIGIT_MAX */ void mp_set(mp_int *a, mp_digit b); - -/* set a double */ -int mp_set_double(mp_int *a, double b); - -/* set a 32-bit const */ -int mp_set_int(mp_int *a, unsigned long b); - -/* set a platform dependent unsigned long value */ -int mp_set_long(mp_int *a, unsigned long b); - -/* set a platform dependent unsigned long long value */ -int mp_set_long_long(mp_int *a, unsigned long long b); - -/* get a double */ -double mp_get_double(const mp_int *a); - -/* get a 32-bit value */ -unsigned long mp_get_int(const mp_int *a); - -/* get a platform dependent unsigned long value */ -unsigned long mp_get_long(const mp_int *a); - -/* get a platform dependent unsigned long long value */ -unsigned long long mp_get_long_long(const mp_int *a); - -/* initialize and set a digit */ -int mp_init_set(mp_int *a, mp_digit b); - -/* initialize and set 32-bit value */ -int mp_init_set_int(mp_int *a, unsigned long b); +mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR; + +/* get integer, set integer and init with integer (deprecated) */ +MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR; +MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR; +#ifdef _MSC_VER +MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned __int64 mp_get_long_long(const mp_int *a) MP_WUR; +#endif +MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b); +MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b); +#ifdef _MSC_VER +MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned __int64 b); +#endif +MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR; /* copy, b = a */ -int mp_copy(const mp_int *a, mp_int *b); +mp_err mp_copy(const mp_int *a, mp_int *b) MP_WUR; /* inits and copies, a = b */ -int mp_init_copy(mp_int *a, const mp_int *b); +mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR; /* trim unused digits */ void mp_clamp(mp_int *a); -/* import binary data */ -int mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op); /* export binary data */ -int mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op); +MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order, size_t size, + int endian, size_t nails, const mp_int *op) MP_WUR; + +/* import binary data */ +MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int *rop, size_t count, int order, + size_t size, int endian, size_t nails, + const void *op) MP_WUR; + +/* unpack binary data */ +mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, + size_t nails, const void *op) MP_WUR; + +/* pack binary data */ +size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) MP_WUR; +mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, + mp_endian endian, size_t nails, const mp_int *op) MP_WUR; /* ---> digit manipulation <--- */ /* right shift by "b" digits */ void mp_rshd(mp_int *a, int b); /* left shift by "b" digits */ -int mp_lshd(mp_int *a, int b); +mp_err mp_lshd(mp_int *a, int b) MP_WUR; /* c = a / 2**b, implemented as c = a >> b */ -int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d); +mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR; /* b = a/2 */ -int mp_div_2(const mp_int *a, mp_int *b); +mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR; + +/* a/3 => 3c + d == a */ +mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR; /* c = a * 2**b, implemented as c = a << b */ -int mp_mul_2d(const mp_int *a, int b, mp_int *c); +mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR; /* b = a*2 */ -int mp_mul_2(const mp_int *a, mp_int *b); +mp_err mp_mul_2(const mp_int *a, mp_int *b) MP_WUR; /* c = a mod 2**b */ -int mp_mod_2d(const mp_int *a, int b, mp_int *c); +mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) MP_WUR; /* computes a = 2**b */ -int mp_2expt(mp_int *a, int b); +mp_err mp_2expt(mp_int *a, int b) MP_WUR; /* Counts the number of lsbs which are zero before the first zero bit */ -int mp_cnt_lsb(const mp_int *a); +int mp_cnt_lsb(const mp_int *a) MP_WUR; /* I Love Earth! */ /* makes a pseudo-random mp_int of a given size */ -int mp_rand(mp_int *a, int digits); +mp_err mp_rand(mp_int *a, int digits) MP_WUR; /* makes a pseudo-random small int of a given size */ -int mp_rand_digit(mp_digit *r); +MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit *r) MP_WUR; +/* use custom random data source instead of source provided the platform */ +void mp_rand_source(mp_err(*source)(void *out, size_t size)); #ifdef MP_PRNG_ENABLE_LTM_RNG +# warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead. /* A last resort to provide random data on systems without any of the other * implemented ways to gather entropy. * It is compatible with `rng_get_bytes()` from libtomcrypt so you could * provide that one and then set `ltm_rng = rng_get_bytes;` */ extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); extern void (*ltm_rng_callback)(void); #endif /* ---> binary operations <--- */ -/* c = a XOR b */ -int mp_xor(const mp_int *a, const mp_int *b, mp_int *c); - -/* c = a OR b */ -int mp_or(const mp_int *a, const mp_int *b, mp_int *c); - -/* c = a AND b */ -int mp_and(const mp_int *a, const mp_int *b, mp_int *c); /* Checks the bit at position b and returns MP_YES - if the bit is 1, MP_NO if it is 0 and MP_VAL - in case of error */ -int mp_get_bit(const mp_int *a, int b); + * if the bit is 1, MP_NO if it is 0 and MP_VAL + * in case of error + */ +MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int *a, int b) MP_WUR; /* c = a XOR b (two complement) */ -int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a OR b (two complement) */ -int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a AND b (two complement) */ -int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; -/* right shift (two complement) */ -int mp_signed_rsh(const mp_int *a, int b, mp_int *c); +/* b = ~a (bitwise not, two complement) */ +mp_err mp_complement(const mp_int *a, mp_int *b) MP_WUR; + +/* right shift with sign extension */ +MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) MP_WUR; +mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR; /* ---> Basic arithmetic <--- */ -/* b = ~a */ -int mp_complement(const mp_int *a, mp_int *b); - /* b = -a */ -int mp_neg(const mp_int *a, mp_int *b); +mp_err mp_neg(const mp_int *a, mp_int *b) MP_WUR; /* b = |a| */ -int mp_abs(const mp_int *a, mp_int *b); +mp_err mp_abs(const mp_int *a, mp_int *b) MP_WUR; /* compare a to b */ -int mp_cmp(const mp_int *a, const mp_int *b); +mp_ord mp_cmp(const mp_int *a, const mp_int *b) MP_WUR; /* compare |a| to |b| */ -int mp_cmp_mag(const mp_int *a, const mp_int *b); +mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR; /* c = a + b */ -int mp_add(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a - b */ -int mp_sub(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = a * b */ -int mp_mul(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* b = a*a */ -int mp_sqr(const mp_int *a, mp_int *b); +mp_err mp_sqr(const mp_int *a, mp_int *b) MP_WUR; /* a/b => cb + d == a */ -int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d); +mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) MP_WUR; /* c = a mod b, 0 <= c < b */ -int mp_mod(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; + +/* Increment "a" by one like "a++". Changes input! */ +mp_err mp_incr(mp_int *a) MP_WUR; + +/* Decrement "a" by one like "a--". Changes input! */ +mp_err mp_decr(mp_int *a) MP_WUR; /* ---> single digit functions <--- */ /* compare against a single digit */ -int mp_cmp_d(const mp_int *a, mp_digit b); +mp_ord mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR; /* c = a + b */ -int mp_add_d(const mp_int *a, mp_digit b, mp_int *c); +mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* c = a - b */ -int mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); +mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* c = a * b */ -int mp_mul_d(const mp_int *a, mp_digit b, mp_int *c); +mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* a/b => cb + d == a */ -int mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d); - -/* a/3 => 3c + d == a */ -int mp_div_3(const mp_int *a, mp_int *c, mp_digit *d); - -/* c = a**b */ -int mp_expt_d(const mp_int *a, mp_digit b, mp_int *c); -int mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); +mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) MP_WUR; /* c = a mod b, 0 <= c number theory <--- */ /* d = a + b (mod c) */ -int mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d); +mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; /* d = a - b (mod c) */ -int mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d); +mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; /* d = a * b (mod c) */ -int mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d); +mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR; /* c = a * a (mod b) */ -int mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = 1/a (mod b) */ -int mp_invmod(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* c = (a, b) */ -int mp_gcd(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* produces value such that U1*a + U2*b = U3 */ -int mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3); +mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) MP_WUR; /* c = [a, b] or (a*b)/(a, b) */ -int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c); +mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* finds one of the b'th root of a, such that |c|**b <= |a| * * returns error if a < 0 and b is even */ -int mp_n_root(const mp_int *a, mp_digit b, mp_int *c); -int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); +mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; /* special sqrt algo */ -int mp_sqrt(const mp_int *arg, mp_int *ret); +mp_err mp_sqrt(const mp_int *arg, mp_int *ret) MP_WUR; /* special sqrt (mod prime) */ -int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret); +mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) MP_WUR; /* is number a square? */ -int mp_is_square(const mp_int *arg, int *ret); +mp_err mp_is_square(const mp_int *arg, mp_bool *ret) MP_WUR; /* computes the jacobi c = (a | n) (or Legendre if b is prime) */ -int mp_jacobi(const mp_int *a, const mp_int *n, int *c); +MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) MP_WUR; /* computes the Kronecker symbol c = (a | p) (like jacobi() but with {a,p} in Z */ -int mp_kronecker(const mp_int *a, const mp_int *p, int *c); +mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c) MP_WUR; /* used to setup the Barrett reduction for a given modulus b */ -int mp_reduce_setup(mp_int *a, const mp_int *b); +mp_err mp_reduce_setup(mp_int *a, const mp_int *b) MP_WUR; /* Barrett Reduction, computes a (mod b) with a precomputed value c * * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code]. */ -int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu); +mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) MP_WUR; /* setups the montgomery reduction */ -int mp_montgomery_setup(const mp_int *n, mp_digit *rho); +mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR; /* computes a = B**n mod b without division or multiplication useful for * normalizing numbers in a Montgomery system. */ -int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b); +mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) MP_WUR; /* computes x/R == x (mod N) via Montgomery Reduction */ -int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho); +mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR; /* returns 1 if a is a valid DR modulus */ -int mp_dr_is_modulus(const mp_int *a); +mp_bool mp_dr_is_modulus(const mp_int *a) MP_WUR; /* sets the value of "d" required for mp_dr_reduce */ void mp_dr_setup(const mp_int *a, mp_digit *d); /* reduces a modulo n using the Diminished Radix method */ -int mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k); +mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) MP_WUR; /* returns true if a can be reduced with mp_reduce_2k */ -int mp_reduce_is_2k(const mp_int *a); +mp_bool mp_reduce_is_2k(const mp_int *a) MP_WUR; /* determines k value for 2k reduction */ -int mp_reduce_2k_setup(const mp_int *a, mp_digit *d); +mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) MP_WUR; /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ -int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d); +mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) MP_WUR; /* returns true if a can be reduced with mp_reduce_2k_l */ -int mp_reduce_is_2k_l(const mp_int *a); +mp_bool mp_reduce_is_2k_l(const mp_int *a) MP_WUR; /* determines k value for 2k reduction */ -int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d); +mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR; /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */ -int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d); +mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) MP_WUR; /* Y = G**X (mod P) */ -int mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y); +mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) MP_WUR; /* ---> Primes <--- */ /* number of primes */ #ifdef MP_8BIT -# define PRIME_SIZE 31 +# define PRIVATE_MP_PRIME_TAB_SIZE 31 #else -# define PRIME_SIZE 256 +# define PRIVATE_MP_PRIME_TAB_SIZE 256 #endif +#define PRIME_SIZE (MP_DEPRECATED_PRAGMA("PRIME_SIZE has been made internal") PRIVATE_MP_PRIME_TAB_SIZE) /* table of first PRIME_SIZE primes */ -extern const mp_digit ltm_prime_tab[PRIME_SIZE]; +MP_DEPRECATED(internal) extern const mp_digit ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE]; /* result=1 if a is divisible by one of the first PRIME_SIZE primes */ -int mp_prime_is_divisible(const mp_int *a, int *result); +MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) MP_WUR; /* performs one Fermat test of "a" using base "b". * Sets result to 0 if composite or 1 if probable prime */ -int mp_prime_fermat(const mp_int *a, const mp_int *b, int *result); +mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR; /* performs one Miller-Rabin test of "a" using base "b". * Sets result to 0 if composite or 1 if probable prime */ -int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result); +mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR; /* This gives [for a given bit size] the number of trials required * such that Miller-Rabin gives a prob of failure lower than 2^-96 */ -int mp_prime_rabin_miller_trials(int size); +int mp_prime_rabin_miller_trials(int size) MP_WUR; /* performs one strong Lucas-Selfridge test of "a". * Sets result to 0 if composite or 1 if probable prime */ -int mp_prime_strong_lucas_selfridge(const mp_int *a, int *result); +mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) MP_WUR; /* performs one Frobenius test of "a" as described by Paul Underwood. * Sets result to 0 if composite or 1 if probable prime */ -int mp_prime_frobenius_underwood(const mp_int *N, int *result); +mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR; /* performs t random rounds of Miller-Rabin on "a" additional to * bases 2 and 3. Also performs an initial sieve of trial * division. Determines if "a" is prime with probability * of error no more than (1/4)**t. @@ -501,18 +713,18 @@ * Is Fips 186.4 compliant if called with t as computed by * mp_prime_rabin_miller_trials(); * * Sets result to 1 if probably prime, 0 otherwise */ -int mp_prime_is_prime(const mp_int *a, int t, int *result); +mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) MP_WUR; /* finds the next prime after the number "a" using "t" trials * of Miller-Rabin. * * bbs_style = 1 means the prime must be congruent to 3 mod 4 */ -int mp_prime_next_prime(mp_int *a, int t, int bbs_style); +mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR; /* makes a truly random prime of a given size (bytes), * call with bbs = 1 if you want it to be congruent to 3 mod 4 * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can @@ -519,67 +731,87 @@ * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * * The prime generated will be larger than 2^(8*size). */ -#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat) +#define mp_prime_random(a, t, size, bbs, cb, dat) (MP_DEPRECATED_PRAGMA("mp_prime_random has been deprecated, use mp_prime_rand instead") mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?MP_PRIME_BBS:0, cb, dat)) /* makes a truly random prime of a given size (bits), * * Flags are as follows: * - * LTM_PRIME_BBS - make prime congruent to 3 mod 4 - * LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS) - * LTM_PRIME_2MSB_ON - make the 2nd highest bit one + * MP_PRIME_BBS - make prime congruent to 3 mod 4 + * MP_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS) + * MP_PRIME_2MSB_ON - make the 2nd highest bit one * * You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can * have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself * so it can be NULL * */ -int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat); +MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, + private_mp_prime_callback cb, void *dat) MP_WUR; +mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) MP_WUR; + +/* Integer logarithm to integer base */ +mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR; + +/* c = a**b */ +mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; /* ---> radix conversion <--- */ -int mp_count_bits(const mp_int *a); - -int mp_unsigned_bin_size(const mp_int *a); -int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c); -int mp_to_unsigned_bin(const mp_int *a, unsigned char *b); -int mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen); - -int mp_signed_bin_size(const mp_int *a); -int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c); -int mp_to_signed_bin(const mp_int *a, unsigned char *b); -int mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen); - -int mp_read_radix(mp_int *a, const char *str, int radix); -int mp_toradix(const mp_int *a, char *str, int radix); -int mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen); -int mp_radix_size(const mp_int *a, int radix, int *size); - -#ifndef LTM_NO_FILE -int mp_fread(mp_int *a, int radix, FILE *stream); -int mp_fwrite(const mp_int *a, int radix, FILE *stream); +int mp_count_bits(const mp_int *a) MP_WUR; + + +MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *a) MP_WUR; +MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) MP_WUR; +MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) MP_WUR; +MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR; + +MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int *a) MP_WUR; +MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) MP_WUR; +MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b) MP_WUR; +MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR; + +size_t mp_ubin_size(const mp_int *a) MP_WUR; +mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR; +mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; + +size_t mp_sbin_size(const mp_int *a) MP_WUR; +mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR; +mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; + +mp_err mp_read_radix(mp_int *a, const char *str, int radix) MP_WUR; +MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int *a, char *str, int radix) MP_WUR; +MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) MP_WUR; +mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; +mp_err mp_radix_size(const mp_int *a, int radix, int *size) MP_WUR; + +#ifndef MP_NO_FILE +mp_err mp_fread(mp_int *a, int radix, FILE *stream) MP_WUR; +mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR; #endif -#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len)) -#define mp_raw_size(mp) mp_signed_bin_size(mp) -#define mp_toraw(mp, str) mp_to_signed_bin((mp), (str)) -#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len)) -#define mp_mag_size(mp) mp_unsigned_bin_size(mp) -#define mp_tomag(mp, str) mp_to_unsigned_bin((mp), (str)) - -#define mp_tobinary(M, S) mp_toradix((M), (S), 2) -#define mp_tooctal(M, S) mp_toradix((M), (S), 8) -#define mp_todecimal(M, S) mp_toradix((M), (S), 10) -#define mp_tohex(M, S) mp_toradix((M), (S), 16) +#define mp_read_raw(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_signed_bin") mp_read_signed_bin((mp), (str), (len))) +#define mp_raw_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_signed_bin_size") mp_signed_bin_size(mp)) +#define mp_toraw(mp, str) (MP_DEPRECATED_PRAGMA("replaced by mp_to_signed_bin") mp_to_signed_bin((mp), (str))) +#define mp_read_mag(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_unsigned_bin") mp_read_unsigned_bin((mp), (str), (len)) +#define mp_mag_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_unsigned_bin_size") mp_unsigned_bin_size(mp)) +#define mp_tomag(mp, str) (MP_DEPRECATED_PRAGMA("replaced by mp_to_unsigned_bin") mp_to_unsigned_bin((mp), (str))) + +#define mp_tobinary(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_binary") mp_toradix((M), (S), 2)) +#define mp_tooctal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_octal") mp_toradix((M), (S), 8)) +#define mp_todecimal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_decimal") mp_toradix((M), (S), 10)) +#define mp_tohex(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_hex") mp_toradix((M), (S), 16)) + +#define mp_to_binary(M, S, N) mp_to_radix((M), (S), (N), NULL, 2) +#define mp_to_octal(M, S, N) mp_to_radix((M), (S), (N), NULL, 8) +#define mp_to_decimal(M, S, N) mp_to_radix((M), (S), (N), NULL, 10) +#define mp_to_hex(M, S, N) mp_to_radix((M), (S), (N), NULL, 16) #ifdef __cplusplus } #endif #endif - - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ Index: libtommath/tommath_class.h ================================================================== --- libtommath/tommath_class.h +++ libtommath/tommath_class.h @@ -1,32 +1,20 @@ -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ #if !(defined(LTM1) && defined(LTM2) && defined(LTM3)) +#define LTM_INSIDE #if defined(LTM2) # define LTM3 #endif #if defined(LTM1) # define LTM2 #endif #define LTM1 #if defined(LTM_ALL) -# define BN_ERROR_C -# define BN_FAST_MP_INVMOD_C -# define BN_FAST_MP_MONTGOMERY_REDUCE_C -# define BN_FAST_S_MP_MUL_DIGS_C -# define BN_FAST_S_MP_MUL_HIGH_DIGS_C -# define BN_FAST_S_MP_SQR_C +# define BN_CUTOFFS_C +# define BN_DEPRECATED_C # define BN_MP_2EXPT_C # define BN_MP_ABS_C # define BN_MP_ADD_C # define BN_MP_ADD_D_C # define BN_MP_ADDMOD_C @@ -39,49 +27,60 @@ # define BN_MP_CMP_MAG_C # define BN_MP_CNT_LSB_C # define BN_MP_COMPLEMENT_C # define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C +# define BN_MP_DECR_C # define BN_MP_DIV_C # define BN_MP_DIV_2_C # define BN_MP_DIV_2D_C # define BN_MP_DIV_3_C # define BN_MP_DIV_D_C # define BN_MP_DR_IS_MODULUS_C # define BN_MP_DR_REDUCE_C # define BN_MP_DR_SETUP_C +# define BN_MP_ERROR_TO_STRING_C # define BN_MP_EXCH_C -# define BN_MP_EXPORT_C -# define BN_MP_EXPT_D_C -# define BN_MP_EXPT_D_EX_C +# define BN_MP_EXPT_U32_C # define BN_MP_EXPTMOD_C -# define BN_MP_EXPTMOD_FAST_C # define BN_MP_EXTEUCLID_C # define BN_MP_FREAD_C +# define BN_MP_FROM_SBIN_C +# define BN_MP_FROM_UBIN_C # define BN_MP_FWRITE_C # define BN_MP_GCD_C -# define BN_S_MP_GET_BIT_C # define BN_MP_GET_DOUBLE_C -# define BN_MP_GET_INT_C -# define BN_MP_GET_LONG_C -# define BN_MP_GET_LONG_LONG_C +# define BN_MP_GET_I32_C +# define BN_MP_GET_I64_C +# define BN_MP_GET_L_C +# define BN_MP_GET_LL_C +# define BN_MP_GET_MAG_U32_C +# define BN_MP_GET_MAG_U64_C +# define BN_MP_GET_MAG_UL_C +# define BN_MP_GET_MAG_ULL_C # define BN_MP_GROW_C -# define BN_MP_IMPORT_C +# define BN_MP_INCR_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C +# define BN_MP_INIT_I32_C +# define BN_MP_INIT_I64_C +# define BN_MP_INIT_L_C +# define BN_MP_INIT_LL_C # define BN_MP_INIT_MULTI_C # define BN_MP_INIT_SET_C -# define BN_MP_INIT_SET_INT_C # define BN_MP_INIT_SIZE_C +# define BN_MP_INIT_U32_C +# define BN_MP_INIT_U64_C +# define BN_MP_INIT_UL_C +# define BN_MP_INIT_ULL_C # define BN_MP_INVMOD_C -# define BN_MP_INVMOD_SLOW_C # define BN_MP_IS_SQUARE_C -# define BN_MP_JACOBI_C -# define BN_MP_KARATSUBA_MUL_C -# define BN_MP_KARATSUBA_SQR_C +# define BN_MP_ISEVEN_C +# define BN_MP_ISODD_C # define BN_MP_KRONECKER_C # define BN_MP_LCM_C +# define BN_MP_LOG_U32_C # define BN_MP_LSHD_C # define BN_MP_MOD_C # define BN_MP_MOD_2D_C # define BN_MP_MOD_D_C # define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C @@ -90,155 +89,210 @@ # define BN_MP_MUL_C # define BN_MP_MUL_2_C # define BN_MP_MUL_2D_C # define BN_MP_MUL_D_C # define BN_MP_MULMOD_C -# define BN_MP_N_ROOT_C -# define BN_MP_N_ROOT_EX_C # define BN_MP_NEG_C # define BN_MP_OR_C +# define BN_MP_PACK_C +# define BN_MP_PACK_COUNT_C # define BN_MP_PRIME_FERMAT_C # define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C -# define BN_MP_PRIME_IS_DIVISIBLE_C # define BN_MP_PRIME_IS_PRIME_C # define BN_MP_PRIME_MILLER_RABIN_C # define BN_MP_PRIME_NEXT_PRIME_C # define BN_MP_PRIME_RABIN_MILLER_TRIALS_C -# define BN_MP_PRIME_RANDOM_EX_C +# define BN_MP_PRIME_RAND_C # define BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C # define BN_MP_RADIX_SIZE_C # define BN_MP_RADIX_SMAP_C # define BN_MP_RAND_C # define BN_MP_READ_RADIX_C -# define BN_MP_READ_SIGNED_BIN_C -# define BN_MP_READ_UNSIGNED_BIN_C # define BN_MP_REDUCE_C # define BN_MP_REDUCE_2K_C # define BN_MP_REDUCE_2K_L_C # define BN_MP_REDUCE_2K_SETUP_C # define BN_MP_REDUCE_2K_SETUP_L_C # define BN_MP_REDUCE_IS_2K_C # define BN_MP_REDUCE_IS_2K_L_C # define BN_MP_REDUCE_SETUP_C +# define BN_MP_ROOT_U32_C # define BN_MP_RSHD_C +# define BN_MP_SBIN_SIZE_C # define BN_MP_SET_C # define BN_MP_SET_DOUBLE_C -# define BN_MP_SET_INT_C -# define BN_MP_SET_LONG_C -# define BN_MP_SET_LONG_LONG_C +# define BN_MP_SET_I32_C +# define BN_MP_SET_I64_C +# define BN_MP_SET_L_C +# define BN_MP_SET_LL_C +# define BN_MP_SET_U32_C +# define BN_MP_SET_U64_C +# define BN_MP_SET_UL_C +# define BN_MP_SET_ULL_C # define BN_MP_SHRINK_C -# define BN_MP_SIGNED_BIN_SIZE_C +# define BN_MP_SIGNED_RSH_C # define BN_MP_SQR_C # define BN_MP_SQRMOD_C # define BN_MP_SQRT_C # define BN_MP_SQRTMOD_PRIME_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C # define BN_MP_SUBMOD_C -# define BN_MP_TC_AND_C +# define BN_MP_TO_RADIX_C +# define BN_MP_TO_SBIN_C +# define BN_MP_TO_UBIN_C +# define BN_MP_UBIN_SIZE_C +# define BN_MP_UNPACK_C +# define BN_MP_XOR_C +# define BN_MP_ZERO_C +# define BN_PRIME_TAB_C +# define BN_S_MP_ADD_C +# define BN_S_MP_BALANCE_MUL_C +# define BN_S_MP_EXPTMOD_C +# define BN_S_MP_EXPTMOD_FAST_C +# define BN_S_MP_GET_BIT_C +# define BN_S_MP_INVMOD_FAST_C +# define BN_S_MP_INVMOD_SLOW_C +# define BN_S_MP_KARATSUBA_MUL_C +# define BN_S_MP_KARATSUBA_SQR_C +# define BN_S_MP_MONTGOMERY_REDUCE_FAST_C +# define BN_S_MP_MUL_DIGS_C +# define BN_S_MP_MUL_DIGS_FAST_C +# define BN_S_MP_MUL_HIGH_DIGS_C +# define BN_S_MP_MUL_HIGH_DIGS_FAST_C +# define BN_S_MP_PRIME_IS_DIVISIBLE_C +# define BN_S_MP_RAND_JENKINS_C +# define BN_S_MP_RAND_PLATFORM_C +# define BN_S_MP_REVERSE_C +# define BN_S_MP_SQR_C +# define BN_S_MP_SQR_FAST_C +# define BN_S_MP_SUB_C +# define BN_S_MP_TOOM_MUL_C +# define BN_S_MP_TOOM_SQR_C +#endif +#endif +#if defined(BN_CUTOFFS_C) +#endif + +#if defined(BN_DEPRECATED_C) +# define BN_FAST_MP_INVMOD_C +# define BN_FAST_MP_MONTGOMERY_REDUCE_C +# define BN_FAST_S_MP_MUL_DIGS_C +# define BN_FAST_S_MP_MUL_HIGH_DIGS_C +# define BN_FAST_S_MP_SQR_C +# define BN_MP_AND_C +# define BN_MP_BALANCE_MUL_C +# define BN_MP_CMP_D_C +# define BN_MP_EXPORT_C +# define BN_MP_EXPTMOD_FAST_C +# define BN_MP_EXPT_D_C +# define BN_MP_EXPT_D_EX_C +# define BN_MP_EXPT_U32_C +# define BN_MP_FROM_SBIN_C +# define BN_MP_FROM_UBIN_C +# define BN_MP_GET_BIT_C +# define BN_MP_GET_INT_C +# define BN_MP_GET_LONG_C +# define BN_MP_GET_LONG_LONG_C +# define BN_MP_GET_MAG_U32_C +# define BN_MP_GET_MAG_ULL_C +# define BN_MP_GET_MAG_UL_C +# define BN_MP_IMPORT_C +# define BN_MP_INIT_SET_INT_C +# define BN_MP_INIT_U32_C +# define BN_MP_INVMOD_SLOW_C +# define BN_MP_JACOBI_C +# define BN_MP_KARATSUBA_MUL_C +# define BN_MP_KARATSUBA_SQR_C +# define BN_MP_KRONECKER_C +# define BN_MP_N_ROOT_C +# define BN_MP_N_ROOT_EX_C +# define BN_MP_OR_C +# define BN_MP_PACK_C +# define BN_MP_PRIME_IS_DIVISIBLE_C +# define BN_MP_PRIME_RANDOM_EX_C +# define BN_MP_RAND_DIGIT_C +# define BN_MP_READ_SIGNED_BIN_C +# define BN_MP_READ_UNSIGNED_BIN_C +# define BN_MP_ROOT_U32_C +# define BN_MP_SBIN_SIZE_C +# define BN_MP_SET_INT_C +# define BN_MP_SET_LONG_C +# define BN_MP_SET_LONG_LONG_C +# define BN_MP_SET_U32_C +# define BN_MP_SET_U64_C +# define BN_MP_SIGNED_BIN_SIZE_C # define BN_MP_SIGNED_RSH_C +# define BN_MP_TC_AND_C +# define BN_MP_TC_DIV_2D_C # define BN_MP_TC_OR_C # define BN_MP_TC_XOR_C -# define BN_MP_TO_SIGNED_BIN_C -# define BN_MP_TO_SIGNED_BIN_N_C -# define BN_MP_TO_UNSIGNED_BIN_C -# define BN_MP_TO_UNSIGNED_BIN_N_C # define BN_MP_TOOM_MUL_C # define BN_MP_TOOM_SQR_C # define BN_MP_TORADIX_C # define BN_MP_TORADIX_N_C +# define BN_MP_TO_RADIX_C +# define BN_MP_TO_SBIN_C +# define BN_MP_TO_SIGNED_BIN_C +# define BN_MP_TO_SIGNED_BIN_N_C +# define BN_MP_TO_UBIN_C +# define BN_MP_TO_UNSIGNED_BIN_C +# define BN_MP_TO_UNSIGNED_BIN_N_C +# define BN_MP_UBIN_SIZE_C +# define BN_MP_UNPACK_C # define BN_MP_UNSIGNED_BIN_SIZE_C # define BN_MP_XOR_C -# define BN_MP_ZERO_C -# define BN_PRIME_TAB_C -# define BN_REVERSE_C -# define BN_S_MP_ADD_C -# define BN_S_MP_EXPTMOD_C -# define BN_S_MP_MUL_DIGS_C -# define BN_S_MP_MUL_HIGH_DIGS_C -# define BN_S_MP_SQR_C -# define BN_S_MP_SUB_C -# define BNCORE_C -#endif -#if defined(BN_ERROR_C) -# define BN_MP_ERROR_TO_STRING_C -#endif - -#if defined(BN_FAST_MP_INVMOD_C) -# define BN_MP_ISEVEN_C -# define BN_MP_INIT_MULTI_C -# define BN_MP_COPY_C -# define BN_MP_MOD_C -# define BN_MP_ISZERO_C -# define BN_MP_SET_C -# define BN_MP_DIV_2_C -# define BN_MP_ISODD_C -# define BN_MP_SUB_C -# define BN_MP_CMP_C -# define BN_MP_CMP_D_C -# define BN_MP_ADD_C -# define BN_MP_CMP_MAG_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_MULTI_C -#endif - -#if defined(BN_FAST_MP_MONTGOMERY_REDUCE_C) -# define BN_MP_GROW_C -# define BN_MP_RSHD_C -# define BN_MP_CLAMP_C -# define BN_MP_CMP_MAG_C -# define BN_S_MP_SUB_C -#endif - -#if defined(BN_FAST_S_MP_MUL_DIGS_C) -# define BN_MP_GROW_C -# define BN_MP_CLAMP_C -#endif - -#if defined(BN_FAST_S_MP_MUL_HIGH_DIGS_C) -# define BN_MP_GROW_C -# define BN_MP_CLAMP_C -#endif - -#if defined(BN_FAST_S_MP_SQR_C) -# define BN_MP_GROW_C -# define BN_MP_CLAMP_C +# define BN_S_MP_BALANCE_MUL_C +# define BN_S_MP_EXPTMOD_FAST_C +# define BN_S_MP_GET_BIT_C +# define BN_S_MP_INVMOD_FAST_C +# define BN_S_MP_INVMOD_SLOW_C +# define BN_S_MP_KARATSUBA_MUL_C +# define BN_S_MP_KARATSUBA_SQR_C +# define BN_S_MP_MONTGOMERY_REDUCE_FAST_C +# define BN_S_MP_MUL_DIGS_FAST_C +# define BN_S_MP_MUL_HIGH_DIGS_FAST_C +# define BN_S_MP_PRIME_IS_DIVISIBLE_C +# define BN_S_MP_PRIME_RANDOM_EX_C +# define BN_S_MP_RAND_SOURCE_C +# define BN_S_MP_REVERSE_C +# define BN_S_MP_SQR_FAST_C +# define BN_S_MP_TOOM_MUL_C +# define BN_S_MP_TOOM_SQR_C #endif #if defined(BN_MP_2EXPT_C) -# define BN_MP_ZERO_C # define BN_MP_GROW_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_ABS_C) # define BN_MP_COPY_C #endif #if defined(BN_MP_ADD_C) -# define BN_S_MP_ADD_C # define BN_MP_CMP_MAG_C +# define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_ADD_D_C) +# define BN_MP_CLAMP_C # define BN_MP_GROW_C # define BN_MP_SUB_D_C -# define BN_MP_CLAMP_C #endif #if defined(BN_MP_ADDMOD_C) -# define BN_MP_INIT_C # define BN_MP_ADD_C # define BN_MP_CLEAR_C +# define BN_MP_INIT_C # define BN_MP_MOD_C #endif #if defined(BN_MP_AND_C) -# define BN_MP_INIT_COPY_C # define BN_MP_CLAMP_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_GROW_C #endif #if defined(BN_MP_CLAMP_C) #endif @@ -258,11 +312,10 @@ #if defined(BN_MP_CMP_MAG_C) #endif #if defined(BN_MP_CNT_LSB_C) -# define BN_MP_ISZERO_C #endif #if defined(BN_MP_COMPLEMENT_C) # define BN_MP_NEG_C # define BN_MP_SUB_D_C @@ -272,647 +325,601 @@ # define BN_MP_GROW_C #endif #if defined(BN_MP_COUNT_BITS_C) #endif + +#if defined(BN_MP_DECR_C) +# define BN_MP_INCR_C +# define BN_MP_SET_C +# define BN_MP_SUB_D_C +# define BN_MP_ZERO_C +#endif #if defined(BN_MP_DIV_C) -# define BN_MP_ISZERO_C +# define BN_MP_ADD_C +# define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_C # define BN_MP_CMP_MAG_C # define BN_MP_COPY_C -# define BN_MP_ZERO_C -# define BN_MP_INIT_MULTI_C -# define BN_MP_SET_C # define BN_MP_COUNT_BITS_C -# define BN_MP_ABS_C -# define BN_MP_MUL_2D_C -# define BN_MP_CMP_C -# define BN_MP_SUB_C -# define BN_MP_ADD_C # define BN_MP_DIV_2D_C # define BN_MP_EXCH_C -# define BN_MP_CLEAR_MULTI_C -# define BN_MP_INIT_SIZE_C # define BN_MP_INIT_C # define BN_MP_INIT_COPY_C +# define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C -# define BN_MP_RSHD_C +# define BN_MP_MUL_2D_C # define BN_MP_MUL_D_C -# define BN_MP_CLAMP_C -# define BN_MP_CLEAR_C +# define BN_MP_RSHD_C +# define BN_MP_SUB_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_DIV_2_C) -# define BN_MP_GROW_C # define BN_MP_CLAMP_C +# define BN_MP_GROW_C #endif #if defined(BN_MP_DIV_2D_C) +# define BN_MP_CLAMP_C # define BN_MP_COPY_C -# define BN_MP_ZERO_C # define BN_MP_MOD_2D_C # define BN_MP_RSHD_C -# define BN_MP_CLAMP_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_DIV_3_C) -# define BN_MP_INIT_SIZE_C # define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C # define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_DIV_D_C) -# define BN_MP_ISZERO_C +# define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C # define BN_MP_COPY_C # define BN_MP_DIV_2D_C # define BN_MP_DIV_3_C -# define BN_MP_INIT_SIZE_C -# define BN_MP_CLAMP_C # define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_DR_IS_MODULUS_C) #endif #if defined(BN_MP_DR_REDUCE_C) -# define BN_MP_GROW_C # define BN_MP_CLAMP_C # define BN_MP_CMP_MAG_C +# define BN_MP_GROW_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_DR_SETUP_C) #endif + +#if defined(BN_MP_ERROR_TO_STRING_C) +#endif #if defined(BN_MP_EXCH_C) #endif -#if defined(BN_MP_EXPORT_C) -# define BN_MP_INIT_COPY_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_DIV_2D_C -# define BN_MP_CLEAR_C -#endif - -#if defined(BN_MP_EXPT_D_C) -# define BN_MP_EXPT_D_EX_C -#endif - -#if defined(BN_MP_EXPT_D_EX_C) -# define BN_MP_INIT_COPY_C -# define BN_MP_SET_C -# define BN_MP_MUL_C -# define BN_MP_CLEAR_C +#if defined(BN_MP_EXPT_U32_C) +# define BN_MP_CLEAR_C +# define BN_MP_INIT_COPY_C +# define BN_MP_MUL_C +# define BN_MP_SET_C # define BN_MP_SQR_C #endif #if defined(BN_MP_EXPTMOD_C) -# define BN_MP_INIT_C -# define BN_MP_INVMOD_C -# define BN_MP_CLEAR_C # define BN_MP_ABS_C # define BN_MP_CLEAR_MULTI_C +# define BN_MP_DR_IS_MODULUS_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_INVMOD_C +# define BN_MP_REDUCE_IS_2K_C # define BN_MP_REDUCE_IS_2K_L_C # define BN_S_MP_EXPTMOD_C -# define BN_MP_DR_IS_MODULUS_C -# define BN_MP_REDUCE_IS_2K_C -# define BN_MP_ISODD_C -# define BN_MP_EXPTMOD_FAST_C -#endif - -#if defined(BN_MP_EXPTMOD_FAST_C) -# define BN_MP_COUNT_BITS_C -# define BN_MP_INIT_SIZE_C -# define BN_MP_CLEAR_C -# define BN_MP_MONTGOMERY_SETUP_C -# define BN_FAST_MP_MONTGOMERY_REDUCE_C -# define BN_MP_MONTGOMERY_REDUCE_C -# define BN_MP_DR_SETUP_C -# define BN_MP_DR_REDUCE_C -# define BN_MP_REDUCE_2K_SETUP_C -# define BN_MP_REDUCE_2K_C -# define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C -# define BN_MP_MULMOD_C -# define BN_MP_SET_C -# define BN_MP_MOD_C -# define BN_MP_COPY_C -# define BN_MP_SQR_C -# define BN_MP_MUL_C -# define BN_MP_EXCH_C +# define BN_S_MP_EXPTMOD_FAST_C #endif #if defined(BN_MP_EXTEUCLID_C) -# define BN_MP_INIT_MULTI_C -# define BN_MP_SET_C +# define BN_MP_CLEAR_MULTI_C # define BN_MP_COPY_C -# define BN_MP_ISZERO_C # define BN_MP_DIV_C +# define BN_MP_EXCH_C +# define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C -# define BN_MP_SUB_C # define BN_MP_NEG_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_MULTI_C +# define BN_MP_SET_C +# define BN_MP_SUB_C #endif #if defined(BN_MP_FREAD_C) -# define BN_MP_ZERO_C -# define BN_MP_S_RMAP_REVERSE_SZ_C -# define BN_MP_S_RMAP_REVERSE_C +# define BN_MP_ADD_D_C # define BN_MP_MUL_D_C -# define BN_MP_ADD_D_C -# define BN_MP_CMP_D_C +# define BN_MP_ZERO_C +#endif + +#if defined(BN_MP_FROM_SBIN_C) +# define BN_MP_FROM_UBIN_C +#endif + +#if defined(BN_MP_FROM_UBIN_C) +# define BN_MP_CLAMP_C +# define BN_MP_GROW_C +# define BN_MP_MUL_2D_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_FWRITE_C) # define BN_MP_RADIX_SIZE_C -# define BN_MP_TORADIX_C +# define BN_MP_TO_RADIX_C #endif #if defined(BN_MP_GCD_C) -# define BN_MP_ISZERO_C # define BN_MP_ABS_C -# define BN_MP_INIT_COPY_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_MAG_C # define BN_MP_CNT_LSB_C # define BN_MP_DIV_2D_C -# define BN_MP_CMP_MAG_C # define BN_MP_EXCH_C -# define BN_S_MP_SUB_C +# define BN_MP_INIT_COPY_C # define BN_MP_MUL_2D_C -# define BN_MP_CLEAR_C -#endif - -#if defined(BN_S_MP_GET_BIT_C) -# define BN_MP_ISZERO_C +# define BN_S_MP_SUB_C #endif #if defined(BN_MP_GET_DOUBLE_C) -# define BN_MP_ISNEG_C #endif -#if defined(BN_MP_GET_INT_C) +#if defined(BN_MP_GET_I32_C) +# define BN_MP_GET_MAG_U32_C #endif -#if defined(BN_MP_GET_LONG_C) +#if defined(BN_MP_GET_I64_C) +# define BN_MP_GET_MAG_U64_C #endif -#if defined(BN_MP_GET_LONG_LONG_C) +#if defined(BN_MP_GET_L_C) +# define BN_MP_GET_MAG_UL_C +#endif + +#if defined(BN_MP_GET_LL_C) +# define BN_MP_GET_MAG_ULL_C +#endif + +#if defined(BN_MP_GET_MAG_U32_C) +#endif + +#if defined(BN_MP_GET_MAG_U64_C) +#endif + +#if defined(BN_MP_GET_MAG_UL_C) +#endif + +#if defined(BN_MP_GET_MAG_ULL_C) #endif #if defined(BN_MP_GROW_C) #endif -#if defined(BN_MP_IMPORT_C) -# define BN_MP_ZERO_C -# define BN_MP_MUL_2D_C -# define BN_MP_CLAMP_C +#if defined(BN_MP_INCR_C) +# define BN_MP_ADD_D_C +# define BN_MP_DECR_C +# define BN_MP_SET_C #endif #if defined(BN_MP_INIT_C) #endif #if defined(BN_MP_INIT_COPY_C) -# define BN_MP_INIT_SIZE_C +# define BN_MP_CLEAR_C # define BN_MP_COPY_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C +#endif + +#if defined(BN_MP_INIT_I32_C) +# define BN_MP_INIT_C +# define BN_MP_SET_I32_C +#endif + +#if defined(BN_MP_INIT_I64_C) +# define BN_MP_INIT_C +# define BN_MP_SET_I64_C +#endif + +#if defined(BN_MP_INIT_L_C) +# define BN_MP_INIT_C +# define BN_MP_SET_L_C +#endif + +#if defined(BN_MP_INIT_LL_C) +# define BN_MP_INIT_C +# define BN_MP_SET_LL_C #endif #if defined(BN_MP_INIT_MULTI_C) -# define BN_MP_ERR_C -# define BN_MP_INIT_C # define BN_MP_CLEAR_C +# define BN_MP_INIT_C #endif #if defined(BN_MP_INIT_SET_C) # define BN_MP_INIT_C # define BN_MP_SET_C #endif -#if defined(BN_MP_INIT_SET_INT_C) -# define BN_MP_INIT_C -# define BN_MP_SET_INT_C -#endif - #if defined(BN_MP_INIT_SIZE_C) +#endif + +#if defined(BN_MP_INIT_U32_C) +# define BN_MP_INIT_C +# define BN_MP_SET_U32_C +#endif + +#if defined(BN_MP_INIT_U64_C) +# define BN_MP_INIT_C +# define BN_MP_SET_U64_C +#endif + +#if defined(BN_MP_INIT_UL_C) +# define BN_MP_INIT_C +# define BN_MP_SET_UL_C +#endif + +#if defined(BN_MP_INIT_ULL_C) # define BN_MP_INIT_C +# define BN_MP_SET_ULL_C #endif #if defined(BN_MP_INVMOD_C) # define BN_MP_CMP_D_C -# define BN_MP_ISODD_C -# define BN_FAST_MP_INVMOD_C -# define BN_MP_INVMOD_SLOW_C -#endif - -#if defined(BN_MP_INVMOD_SLOW_C) -# define BN_MP_ISZERO_C -# define BN_MP_INIT_MULTI_C -# define BN_MP_MOD_C -# define BN_MP_COPY_C -# define BN_MP_ISEVEN_C -# define BN_MP_SET_C -# define BN_MP_DIV_2_C -# define BN_MP_ISODD_C -# define BN_MP_ADD_C -# define BN_MP_SUB_C -# define BN_MP_CMP_C -# define BN_MP_CMP_D_C -# define BN_MP_CMP_MAG_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_MULTI_C +# define BN_S_MP_INVMOD_FAST_C +# define BN_S_MP_INVMOD_SLOW_C #endif #if defined(BN_MP_IS_SQUARE_C) -# define BN_MP_MOD_D_C -# define BN_MP_INIT_SET_INT_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_MAG_C +# define BN_MP_GET_I32_C +# define BN_MP_INIT_U32_C # define BN_MP_MOD_C -# define BN_MP_GET_INT_C +# define BN_MP_MOD_D_C # define BN_MP_SQRT_C # define BN_MP_SQR_C -# define BN_MP_CMP_MAG_C -# define BN_MP_CLEAR_C -#endif - -#if defined(BN_MP_JACOBI_C) -# define BN_MP_KRONECKER_C -# define BN_MP_ISNEG_C -# define BN_MP_CMP_D_C -#endif - -#if defined(BN_MP_KARATSUBA_MUL_C) -# define BN_MP_MUL_C -# define BN_MP_INIT_SIZE_C -# define BN_MP_CLAMP_C -# define BN_S_MP_ADD_C -# define BN_MP_ADD_C -# define BN_S_MP_SUB_C -# define BN_MP_LSHD_C -# define BN_MP_CLEAR_C -#endif - -#if defined(BN_MP_KARATSUBA_SQR_C) -# define BN_MP_INIT_SIZE_C -# define BN_MP_CLAMP_C -# define BN_MP_SQR_C -# define BN_S_MP_ADD_C -# define BN_S_MP_SUB_C -# define BN_MP_LSHD_C -# define BN_MP_ADD_C -# define BN_MP_CLEAR_C +#endif + +#if defined(BN_MP_ISEVEN_C) +#endif + +#if defined(BN_MP_ISODD_C) #endif #if defined(BN_MP_KRONECKER_C) -# define BN_MP_ISZERO_C -# define BN_MP_ISEVEN_C -# define BN_MP_INIT_COPY_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_D_C # define BN_MP_CNT_LSB_C -# define BN_MP_DIV_2D_C -# define BN_MP_CMP_D_C # define BN_MP_COPY_C +# define BN_MP_DIV_2D_C +# define BN_MP_INIT_C +# define BN_MP_INIT_COPY_C # define BN_MP_MOD_C -# define BN_MP_CLEAR_C #endif #if defined(BN_MP_LCM_C) -# define BN_MP_INIT_MULTI_C -# define BN_MP_GCD_C +# define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_MAG_C # define BN_MP_DIV_C +# define BN_MP_GCD_C +# define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C +#endif + +#if defined(BN_MP_LOG_U32_C) # define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_CMP_D_C +# define BN_MP_COPY_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_EXCH_C +# define BN_MP_EXPT_U32_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_MUL_C +# define BN_MP_SET_C +# define BN_MP_SQR_C #endif #if defined(BN_MP_LSHD_C) -# define BN_MP_ISZERO_C # define BN_MP_GROW_C -# define BN_MP_RSHD_C #endif #if defined(BN_MP_MOD_C) -# define BN_MP_INIT_SIZE_C +# define BN_MP_ADD_C +# define BN_MP_CLEAR_C # define BN_MP_DIV_C -# define BN_MP_CLEAR_C -# define BN_MP_ISZERO_C # define BN_MP_EXCH_C -# define BN_MP_ADD_C +# define BN_MP_INIT_SIZE_C #endif #if defined(BN_MP_MOD_2D_C) -# define BN_MP_ZERO_C +# define BN_MP_CLAMP_C # define BN_MP_COPY_C -# define BN_MP_CLAMP_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_MOD_D_C) # define BN_MP_DIV_D_C #endif #if defined(BN_MP_MONTGOMERY_CALC_NORMALIZATION_C) -# define BN_MP_COUNT_BITS_C # define BN_MP_2EXPT_C -# define BN_MP_SET_C +# define BN_MP_CMP_MAG_C +# define BN_MP_COUNT_BITS_C # define BN_MP_MUL_2_C -# define BN_MP_CMP_MAG_C +# define BN_MP_SET_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_MONTGOMERY_REDUCE_C) -# define BN_FAST_MP_MONTGOMERY_REDUCE_C -# define BN_MP_GROW_C # define BN_MP_CLAMP_C +# define BN_MP_CMP_MAG_C +# define BN_MP_GROW_C # define BN_MP_RSHD_C -# define BN_MP_CMP_MAG_C +# define BN_S_MP_MONTGOMERY_REDUCE_FAST_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_MONTGOMERY_SETUP_C) #endif #if defined(BN_MP_MUL_C) -# define BN_MP_TOOM_MUL_C -# define BN_MP_KARATSUBA_MUL_C -# define BN_FAST_S_MP_MUL_DIGS_C -# define BN_S_MP_MUL_C +# define BN_S_MP_BALANCE_MUL_C +# define BN_S_MP_KARATSUBA_MUL_C # define BN_S_MP_MUL_DIGS_C +# define BN_S_MP_MUL_DIGS_FAST_C +# define BN_S_MP_TOOM_MUL_C #endif #if defined(BN_MP_MUL_2_C) # define BN_MP_GROW_C #endif #if defined(BN_MP_MUL_2D_C) +# define BN_MP_CLAMP_C # define BN_MP_COPY_C # define BN_MP_GROW_C # define BN_MP_LSHD_C -# define BN_MP_CLAMP_C #endif #if defined(BN_MP_MUL_D_C) -# define BN_MP_GROW_C # define BN_MP_CLAMP_C +# define BN_MP_GROW_C #endif #if defined(BN_MP_MULMOD_C) -# define BN_MP_INIT_SIZE_C -# define BN_MP_MUL_C # define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C # define BN_MP_MOD_C -#endif - -#if defined(BN_MP_N_ROOT_C) -# define BN_MP_N_ROOT_EX_C -#endif - -#if defined(BN_MP_N_ROOT_EX_C) -# define BN_MP_INIT_C -# define BN_MP_SET_C -# define BN_MP_COPY_C -# define BN_MP_EXPT_D_EX_C # define BN_MP_MUL_C -# define BN_MP_SUB_C -# define BN_MP_MUL_D_C -# define BN_MP_DIV_C -# define BN_MP_CMP_C -# define BN_MP_SUB_D_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_C #endif #if defined(BN_MP_NEG_C) # define BN_MP_COPY_C -# define BN_MP_ISZERO_C #endif #if defined(BN_MP_OR_C) -# define BN_MP_INIT_COPY_C # define BN_MP_CLAMP_C -# define BN_MP_EXCH_C +# define BN_MP_GROW_C +#endif + +#if defined(BN_MP_PACK_C) # define BN_MP_CLEAR_C +# define BN_MP_DIV_2D_C +# define BN_MP_INIT_COPY_C +# define BN_MP_PACK_COUNT_C +#endif + +#if defined(BN_MP_PACK_COUNT_C) +# define BN_MP_COUNT_BITS_C #endif #if defined(BN_MP_PRIME_FERMAT_C) +# define BN_MP_CLEAR_C +# define BN_MP_CMP_C # define BN_MP_CMP_D_C -# define BN_MP_INIT_C # define BN_MP_EXPTMOD_C -# define BN_MP_CMP_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_C #endif #if defined(BN_MP_PRIME_FROBENIUS_UNDERWOOD_C) -# define BN_MP_PRIME_IS_PRIME_C -# define BN_MP_INIT_MULTI_C -# define BN_MP_SET_LONG_C -# define BN_MP_SQR_C -# define BN_MP_SUB_D_C -# define BN_MP_KRONECKER_C +# define BN_MP_ADD_C +# define BN_MP_ADD_D_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_EXCH_C # define BN_MP_GCD_C -# define BN_MP_ADD_D_C -# define BN_MP_SET_C -# define BN_MP_COUNT_BITS_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_KRONECKER_C +# define BN_MP_MOD_C # define BN_MP_MUL_2_C +# define BN_MP_MUL_C # define BN_MP_MUL_D_C -# define BN_MP_ADD_C -# define BN_MP_MUL_C +# define BN_MP_SET_C +# define BN_MP_SET_U32_C +# define BN_MP_SQR_C # define BN_MP_SUB_C -# define BN_MP_MOD_C +# define BN_MP_SUB_D_C # define BN_S_MP_GET_BIT_C -# define BN_MP_EXCH_C -# define BN_MP_ISZERO_C -# define BN_MP_CMP_C -# define BN_MP_CLEAR_MULTI_C -#endif - -#if defined(BN_MP_PRIME_IS_DIVISIBLE_C) -# define BN_MP_MOD_D_C #endif #if defined(BN_MP_PRIME_IS_PRIME_C) -# define BN_MP_ISEVEN_C -# define BN_MP_IS_SQUARE_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_C # define BN_MP_CMP_D_C -# define BN_MP_PRIME_IS_DIVISIBLE_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_DIV_2D_C # define BN_MP_INIT_SET_C +# define BN_MP_IS_SQUARE_C # define BN_MP_PRIME_MILLER_RABIN_C -# define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C # define BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C +# define BN_MP_RAND_C # define BN_MP_READ_RADIX_C -# define BN_MP_CMP_C # define BN_MP_SET_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_RAND_C -# define BN_MP_DIV_2D_C -# define BN_MP_CLEAR_C +# define BN_S_MP_PRIME_IS_DIVISIBLE_C #endif #if defined(BN_MP_PRIME_MILLER_RABIN_C) +# define BN_MP_CLEAR_C +# define BN_MP_CMP_C # define BN_MP_CMP_D_C -# define BN_MP_INIT_COPY_C -# define BN_MP_SUB_D_C # define BN_MP_CNT_LSB_C # define BN_MP_DIV_2D_C # define BN_MP_EXPTMOD_C -# define BN_MP_CMP_C +# define BN_MP_INIT_C +# define BN_MP_INIT_COPY_C # define BN_MP_SQRMOD_C -# define BN_MP_CLEAR_C +# define BN_MP_SUB_D_C #endif #if defined(BN_MP_PRIME_NEXT_PRIME_C) +# define BN_MP_ADD_D_C +# define BN_MP_CLEAR_C # define BN_MP_CMP_D_C -# define BN_MP_SET_C -# define BN_MP_SUB_D_C -# define BN_MP_ISEVEN_C +# define BN_MP_INIT_C # define BN_MP_MOD_D_C -# define BN_MP_INIT_C -# define BN_MP_ADD_D_C # define BN_MP_PRIME_IS_PRIME_C -# define BN_MP_CLEAR_C +# define BN_MP_SET_C +# define BN_MP_SUB_D_C #endif #if defined(BN_MP_PRIME_RABIN_MILLER_TRIALS_C) #endif -#if defined(BN_MP_PRIME_RANDOM_EX_C) -# define BN_MP_READ_UNSIGNED_BIN_C +#if defined(BN_MP_PRIME_RAND_C) +# define BN_MP_ADD_D_C +# define BN_MP_DIV_2_C +# define BN_MP_FROM_UBIN_C +# define BN_MP_MUL_2_C # define BN_MP_PRIME_IS_PRIME_C # define BN_MP_SUB_D_C -# define BN_MP_DIV_2_C -# define BN_MP_MUL_2_C -# define BN_MP_ADD_D_C +# define BN_S_MP_PRIME_RANDOM_EX_C +# define BN_S_MP_RAND_CB_C +# define BN_S_MP_RAND_SOURCE_C #endif #if defined(BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C) -# define BN_MP_PRIME_IS_PRIME_C -# define BN_MP_MUL_D_C -# define BN_S_MP_MUL_SI_C -# define BN_MP_INIT_C -# define BN_MP_SET_LONG_C -# define BN_MP_MUL_C +# define BN_MP_ADD_C +# define BN_MP_ADD_D_C # define BN_MP_CLEAR_C -# define BN_MP_INIT_MULTI_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_CMP_D_C +# define BN_MP_CNT_LSB_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_DIV_2D_C +# define BN_MP_DIV_2_C # define BN_MP_GCD_C -# define BN_MP_CMP_D_C -# define BN_MP_CMP_C +# define BN_MP_INIT_C +# define BN_MP_INIT_MULTI_C # define BN_MP_KRONECKER_C -# define BN_MP_ADD_D_C -# define BN_MP_CNT_LSB_C -# define BN_MP_DIV_2D_C -# define BN_MP_SET_C +# define BN_MP_MOD_C # define BN_MP_MUL_2_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_MOD_C +# define BN_MP_MUL_C +# define BN_MP_SET_C +# define BN_MP_SET_I32_C +# define BN_MP_SET_U32_C # define BN_MP_SQR_C # define BN_MP_SUB_C +# define BN_MP_SUB_D_C # define BN_S_MP_GET_BIT_C -# define BN_MP_ADD_C -# define BN_MP_ISODD_C -# define BN_MP_DIV_2_C -# define BN_MP_SUB_D_C -# define BN_MP_ISZERO_C -# define BN_MP_CLEAR_MULTI_C +# define BN_S_MP_MUL_SI_C #endif #if defined(BN_MP_RADIX_SIZE_C) -# define BN_MP_ISZERO_C +# define BN_MP_CLEAR_C # define BN_MP_COUNT_BITS_C -# define BN_MP_INIT_COPY_C # define BN_MP_DIV_D_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_COPY_C #endif #if defined(BN_MP_RADIX_SMAP_C) -# define BN_MP_S_RMAP_C -# define BN_MP_S_RMAP_REVERSE_C -# define BN_MP_S_RMAP_REVERSE_SZ_C #endif #if defined(BN_MP_RAND_C) -# define BN_MP_RAND_DIGIT_C +# define BN_MP_GROW_C +# define BN_MP_RAND_SOURCE_C # define BN_MP_ZERO_C -# define BN_MP_ADD_D_C -# define BN_MP_LSHD_C +# define BN_S_MP_RAND_PLATFORM_C +# define BN_S_MP_RAND_SOURCE_C #endif #if defined(BN_MP_READ_RADIX_C) -# define BN_MP_ZERO_C -# define BN_MP_S_RMAP_REVERSE_SZ_C -# define BN_MP_S_RMAP_REVERSE_C +# define BN_MP_ADD_D_C # define BN_MP_MUL_D_C -# define BN_MP_ADD_D_C -# define BN_MP_ISZERO_C -#endif - -#if defined(BN_MP_READ_SIGNED_BIN_C) -# define BN_MP_READ_UNSIGNED_BIN_C -#endif - -#if defined(BN_MP_READ_UNSIGNED_BIN_C) -# define BN_MP_GROW_C # define BN_MP_ZERO_C -# define BN_MP_MUL_2D_C -# define BN_MP_CLAMP_C #endif #if defined(BN_MP_REDUCE_C) -# define BN_MP_REDUCE_SETUP_C +# define BN_MP_ADD_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_C +# define BN_MP_CMP_D_C # define BN_MP_INIT_COPY_C -# define BN_MP_RSHD_C -# define BN_MP_MUL_C -# define BN_S_MP_MUL_HIGH_DIGS_C -# define BN_FAST_S_MP_MUL_HIGH_DIGS_C +# define BN_MP_LSHD_C # define BN_MP_MOD_2D_C +# define BN_MP_MUL_C +# define BN_MP_RSHD_C +# define BN_MP_SET_C +# define BN_MP_SUB_C # define BN_S_MP_MUL_DIGS_C -# define BN_MP_SUB_C -# define BN_MP_CMP_D_C -# define BN_MP_SET_C -# define BN_MP_LSHD_C -# define BN_MP_ADD_C -# define BN_MP_CMP_C +# define BN_S_MP_MUL_HIGH_DIGS_C +# define BN_S_MP_MUL_HIGH_DIGS_FAST_C # define BN_S_MP_SUB_C -# define BN_MP_CLEAR_C #endif #if defined(BN_MP_REDUCE_2K_C) -# define BN_MP_INIT_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_MAG_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C +# define BN_MP_INIT_C # define BN_MP_MUL_D_C # define BN_S_MP_ADD_C -# define BN_MP_CMP_MAG_C # define BN_S_MP_SUB_C -# define BN_MP_CLEAR_C #endif #if defined(BN_MP_REDUCE_2K_L_C) -# define BN_MP_INIT_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_MAG_C # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_2D_C +# define BN_MP_INIT_C # define BN_MP_MUL_C # define BN_S_MP_ADD_C -# define BN_MP_CMP_MAG_C # define BN_S_MP_SUB_C -# define BN_MP_CLEAR_C #endif #if defined(BN_MP_REDUCE_2K_SETUP_C) -# define BN_MP_INIT_C -# define BN_MP_COUNT_BITS_C # define BN_MP_2EXPT_C # define BN_MP_CLEAR_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_INIT_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_REDUCE_2K_SETUP_L_C) -# define BN_MP_INIT_C # define BN_MP_2EXPT_C +# define BN_MP_CLEAR_C # define BN_MP_COUNT_BITS_C +# define BN_MP_INIT_C # define BN_S_MP_SUB_C -# define BN_MP_CLEAR_C #endif #if defined(BN_MP_REDUCE_IS_2K_C) -# define BN_MP_REDUCE_2K_C # define BN_MP_COUNT_BITS_C #endif #if defined(BN_MP_REDUCE_IS_2K_L_C) #endif @@ -919,305 +926,394 @@ #if defined(BN_MP_REDUCE_SETUP_C) # define BN_MP_2EXPT_C # define BN_MP_DIV_C #endif + +#if defined(BN_MP_ROOT_U32_C) +# define BN_MP_2EXPT_C +# define BN_MP_ADD_D_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_COPY_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_DIV_C +# define BN_MP_EXCH_C +# define BN_MP_EXPT_U32_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_MUL_C +# define BN_MP_MUL_D_C +# define BN_MP_SET_C +# define BN_MP_SUB_C +# define BN_MP_SUB_D_C +#endif #if defined(BN_MP_RSHD_C) # define BN_MP_ZERO_C #endif + +#if defined(BN_MP_SBIN_SIZE_C) +# define BN_MP_UBIN_SIZE_C +#endif #if defined(BN_MP_SET_C) -# define BN_MP_ZERO_C #endif #if defined(BN_MP_SET_DOUBLE_C) -# define BN_MP_SET_LONG_LONG_C # define BN_MP_DIV_2D_C # define BN_MP_MUL_2D_C -# define BN_MP_ISZERO_C +# define BN_MP_SET_U64_C +#endif + +#if defined(BN_MP_SET_I32_C) +# define BN_MP_SET_U32_C +#endif + +#if defined(BN_MP_SET_I64_C) +# define BN_MP_SET_U64_C +#endif + +#if defined(BN_MP_SET_L_C) +# define BN_MP_SET_UL_C +#endif + +#if defined(BN_MP_SET_LL_C) +# define BN_MP_SET_ULL_C +#endif + +#if defined(BN_MP_SET_U32_C) +#endif + +#if defined(BN_MP_SET_U64_C) #endif -#if defined(BN_MP_SET_INT_C) -# define BN_MP_ZERO_C -# define BN_MP_MUL_2D_C -# define BN_MP_CLAMP_C +#if defined(BN_MP_SET_UL_C) #endif -#if defined(BN_MP_SET_LONG_C) -#endif - -#if defined(BN_MP_SET_LONG_LONG_C) +#if defined(BN_MP_SET_ULL_C) #endif #if defined(BN_MP_SHRINK_C) #endif -#if defined(BN_MP_SIGNED_BIN_SIZE_C) -# define BN_MP_UNSIGNED_BIN_SIZE_C +#if defined(BN_MP_SIGNED_RSH_C) +# define BN_MP_ADD_D_C +# define BN_MP_DIV_2D_C +# define BN_MP_SUB_D_C #endif #if defined(BN_MP_SQR_C) -# define BN_MP_TOOM_SQR_C -# define BN_MP_KARATSUBA_SQR_C -# define BN_FAST_S_MP_SQR_C +# define BN_S_MP_KARATSUBA_SQR_C # define BN_S_MP_SQR_C +# define BN_S_MP_SQR_FAST_C +# define BN_S_MP_TOOM_SQR_C #endif #if defined(BN_MP_SQRMOD_C) -# define BN_MP_INIT_C -# define BN_MP_SQR_C # define BN_MP_CLEAR_C +# define BN_MP_INIT_C # define BN_MP_MOD_C +# define BN_MP_SQR_C #endif #if defined(BN_MP_SQRT_C) -# define BN_MP_N_ROOT_C -# define BN_MP_ISZERO_C -# define BN_MP_ZERO_C +# define BN_MP_ADD_C +# define BN_MP_CLEAR_C +# define BN_MP_CMP_MAG_C +# define BN_MP_DIV_2_C +# define BN_MP_DIV_C +# define BN_MP_EXCH_C +# define BN_MP_INIT_C # define BN_MP_INIT_COPY_C # define BN_MP_RSHD_C -# define BN_MP_DIV_C -# define BN_MP_ADD_C -# define BN_MP_DIV_2_C -# define BN_MP_CMP_MAG_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_SQRTMOD_PRIME_C) +# define BN_MP_ADD_D_C +# define BN_MP_CLEAR_MULTI_C # define BN_MP_CMP_D_C -# define BN_MP_ZERO_C -# define BN_MP_JACOBI_C -# define BN_MP_INIT_MULTI_C -# define BN_MP_MOD_D_C -# define BN_MP_ADD_D_C +# define BN_MP_COPY_C # define BN_MP_DIV_2_C # define BN_MP_EXPTMOD_C -# define BN_MP_COPY_C -# define BN_MP_SUB_D_C -# define BN_MP_ISEVEN_C -# define BN_MP_SET_INT_C -# define BN_MP_SQRMOD_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_KRONECKER_C +# define BN_MP_MOD_D_C # define BN_MP_MULMOD_C # define BN_MP_SET_C -# define BN_MP_CLEAR_MULTI_C +# define BN_MP_SET_U32_C +# define BN_MP_SQRMOD_C +# define BN_MP_SUB_D_C +# define BN_MP_ZERO_C #endif #if defined(BN_MP_SUB_C) -# define BN_S_MP_ADD_C # define BN_MP_CMP_MAG_C +# define BN_S_MP_ADD_C # define BN_S_MP_SUB_C #endif #if defined(BN_MP_SUB_D_C) -# define BN_MP_GROW_C -# define BN_MP_ADD_D_C -# define BN_MP_CLAMP_C -#endif - -#if defined(BN_MP_SUBMOD_C) -# define BN_MP_INIT_C -# define BN_MP_SUB_C -# define BN_MP_CLEAR_C -# define BN_MP_MOD_C -#endif - -#if defined(BN_MP_TC_AND_C) -# define BN_MP_ISNEG_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_INIT_SET_INT_C -# define BN_MP_MUL_2D_C -# define BN_MP_INIT_C -# define BN_MP_ADD_C -# define BN_MP_CLEAR_C -# define BN_MP_AND_C -# define BN_MP_SUB_C -#endif - -#if defined(BN_MP_SIGNED_RSH_C) -# define BN_MP_ISNEG_C -# define BN_MP_DIV_2D_C -# define BN_MP_ADD_D_C -# define BN_MP_SUB_D_C -#endif - -#if defined(BN_MP_TC_OR_C) -# define BN_MP_ISNEG_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_INIT_SET_INT_C -# define BN_MP_MUL_2D_C -# define BN_MP_INIT_C -# define BN_MP_ADD_C -# define BN_MP_CLEAR_C -# define BN_MP_OR_C -# define BN_MP_SUB_C -#endif - -#if defined(BN_MP_TC_XOR_C) -# define BN_MP_ISNEG_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_INIT_SET_INT_C -# define BN_MP_MUL_2D_C -# define BN_MP_INIT_C -# define BN_MP_ADD_C -# define BN_MP_CLEAR_C -# define BN_MP_XOR_C -# define BN_MP_SUB_C -#endif - -#if defined(BN_MP_TO_SIGNED_BIN_C) -# define BN_MP_TO_UNSIGNED_BIN_C -#endif - -#if defined(BN_MP_TO_SIGNED_BIN_N_C) -# define BN_MP_SIGNED_BIN_SIZE_C -# define BN_MP_TO_SIGNED_BIN_C -#endif - -#if defined(BN_MP_TO_UNSIGNED_BIN_C) -# define BN_MP_INIT_COPY_C -# define BN_MP_ISZERO_C -# define BN_MP_DIV_2D_C -# define BN_MP_CLEAR_C -#endif - -#if defined(BN_MP_TO_UNSIGNED_BIN_N_C) -# define BN_MP_UNSIGNED_BIN_SIZE_C -# define BN_MP_TO_UNSIGNED_BIN_C -#endif - -#if defined(BN_MP_TOOM_MUL_C) -# define BN_MP_INIT_MULTI_C -# define BN_MP_MOD_2D_C -# define BN_MP_COPY_C -# define BN_MP_RSHD_C -# define BN_MP_MUL_C -# define BN_MP_MUL_2_C -# define BN_MP_ADD_C -# define BN_MP_SUB_C -# define BN_MP_DIV_2_C -# define BN_MP_MUL_2D_C -# define BN_MP_MUL_D_C -# define BN_MP_DIV_3_C -# define BN_MP_LSHD_C -# define BN_MP_CLEAR_MULTI_C -#endif - -#if defined(BN_MP_TOOM_SQR_C) -# define BN_MP_INIT_MULTI_C -# define BN_MP_MOD_2D_C -# define BN_MP_COPY_C -# define BN_MP_RSHD_C -# define BN_MP_SQR_C -# define BN_MP_MUL_2_C -# define BN_MP_ADD_C -# define BN_MP_SUB_C -# define BN_MP_DIV_2_C -# define BN_MP_MUL_2D_C -# define BN_MP_MUL_D_C -# define BN_MP_DIV_3_C -# define BN_MP_LSHD_C -# define BN_MP_CLEAR_MULTI_C -#endif - -#if defined(BN_MP_TORADIX_C) -# define BN_MP_ISZERO_C -# define BN_MP_INIT_COPY_C -# define BN_MP_DIV_D_C -# define BN_MP_CLEAR_C -# define BN_MP_S_RMAP_C -#endif - -#if defined(BN_MP_TORADIX_N_C) -# define BN_MP_ISZERO_C -# define BN_MP_INIT_COPY_C -# define BN_MP_DIV_D_C -# define BN_MP_CLEAR_C -# define BN_MP_S_RMAP_C -#endif - -#if defined(BN_MP_UNSIGNED_BIN_SIZE_C) -# define BN_MP_COUNT_BITS_C -#endif - -#if defined(BN_MP_XOR_C) -# define BN_MP_INIT_COPY_C -# define BN_MP_CLAMP_C -# define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_ADD_D_C +# define BN_MP_CLAMP_C +# define BN_MP_GROW_C +#endif + +#if defined(BN_MP_SUBMOD_C) +# define BN_MP_CLEAR_C +# define BN_MP_INIT_C +# define BN_MP_MOD_C +# define BN_MP_SUB_C +#endif + +#if defined(BN_MP_TO_RADIX_C) +# define BN_MP_CLEAR_C +# define BN_MP_DIV_D_C +# define BN_MP_INIT_COPY_C +# define BN_S_MP_REVERSE_C +#endif + +#if defined(BN_MP_TO_SBIN_C) +# define BN_MP_TO_UBIN_C +#endif + +#if defined(BN_MP_TO_UBIN_C) +# define BN_MP_CLEAR_C +# define BN_MP_DIV_2D_C +# define BN_MP_INIT_COPY_C +# define BN_MP_UBIN_SIZE_C +#endif + +#if defined(BN_MP_UBIN_SIZE_C) +# define BN_MP_COUNT_BITS_C +#endif + +#if defined(BN_MP_UNPACK_C) +# define BN_MP_CLAMP_C +# define BN_MP_MUL_2D_C +# define BN_MP_ZERO_C +#endif + +#if defined(BN_MP_XOR_C) +# define BN_MP_CLAMP_C +# define BN_MP_GROW_C #endif #if defined(BN_MP_ZERO_C) #endif #if defined(BN_PRIME_TAB_C) #endif -#if defined(BN_REVERSE_C) -#endif - #if defined(BN_S_MP_ADD_C) +# define BN_MP_CLAMP_C # define BN_MP_GROW_C +#endif + +#if defined(BN_S_MP_BALANCE_MUL_C) +# define BN_MP_ADD_C # define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_EXCH_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_INIT_SIZE_C +# define BN_MP_LSHD_C +# define BN_MP_MUL_C #endif #if defined(BN_S_MP_EXPTMOD_C) +# define BN_MP_CLEAR_C +# define BN_MP_COPY_C # define BN_MP_COUNT_BITS_C +# define BN_MP_EXCH_C # define BN_MP_INIT_C -# define BN_MP_CLEAR_C -# define BN_MP_REDUCE_SETUP_C -# define BN_MP_REDUCE_C -# define BN_MP_REDUCE_2K_SETUP_L_C +# define BN_MP_MOD_C +# define BN_MP_MUL_C # define BN_MP_REDUCE_2K_L_C -# define BN_MP_MOD_C -# define BN_MP_COPY_C +# define BN_MP_REDUCE_2K_SETUP_L_C +# define BN_MP_REDUCE_C +# define BN_MP_REDUCE_SETUP_C +# define BN_MP_SET_C # define BN_MP_SQR_C +#endif + +#if defined(BN_S_MP_EXPTMOD_FAST_C) +# define BN_MP_CLEAR_C +# define BN_MP_COPY_C +# define BN_MP_COUNT_BITS_C +# define BN_MP_DR_REDUCE_C +# define BN_MP_DR_SETUP_C +# define BN_MP_EXCH_C +# define BN_MP_INIT_SIZE_C +# define BN_MP_MOD_C +# define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C +# define BN_MP_MONTGOMERY_REDUCE_C +# define BN_MP_MONTGOMERY_SETUP_C +# define BN_MP_MULMOD_C # define BN_MP_MUL_C +# define BN_MP_REDUCE_2K_C +# define BN_MP_REDUCE_2K_SETUP_C +# define BN_MP_SET_C +# define BN_MP_SQR_C +# define BN_S_MP_MONTGOMERY_REDUCE_FAST_C +#endif + +#if defined(BN_S_MP_GET_BIT_C) +#endif + +#if defined(BN_S_MP_INVMOD_FAST_C) +# define BN_MP_ADD_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_CMP_D_C +# define BN_MP_CMP_MAG_C +# define BN_MP_COPY_C +# define BN_MP_DIV_2_C +# define BN_MP_EXCH_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_MOD_C # define BN_MP_SET_C +# define BN_MP_SUB_C +#endif + +#if defined(BN_S_MP_INVMOD_SLOW_C) +# define BN_MP_ADD_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_CMP_D_C +# define BN_MP_CMP_MAG_C +# define BN_MP_COPY_C +# define BN_MP_DIV_2_C # define BN_MP_EXCH_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_MOD_C +# define BN_MP_SET_C +# define BN_MP_SUB_C +#endif + +#if defined(BN_S_MP_KARATSUBA_MUL_C) +# define BN_MP_ADD_C +# define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C +# define BN_MP_LSHD_C +# define BN_MP_MUL_C +# define BN_S_MP_ADD_C +# define BN_S_MP_SUB_C +#endif + +#if defined(BN_S_MP_KARATSUBA_SQR_C) +# define BN_MP_ADD_C +# define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C +# define BN_MP_LSHD_C +# define BN_MP_SQR_C +# define BN_S_MP_ADD_C +# define BN_S_MP_SUB_C +#endif + +#if defined(BN_S_MP_MONTGOMERY_REDUCE_FAST_C) +# define BN_MP_CLAMP_C +# define BN_MP_CMP_MAG_C +# define BN_MP_GROW_C +# define BN_S_MP_SUB_C #endif #if defined(BN_S_MP_MUL_DIGS_C) -# define BN_FAST_S_MP_MUL_DIGS_C -# define BN_MP_INIT_SIZE_C # define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C # define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C +# define BN_S_MP_MUL_DIGS_FAST_C +#endif + +#if defined(BN_S_MP_MUL_DIGS_FAST_C) +# define BN_MP_CLAMP_C +# define BN_MP_GROW_C #endif #if defined(BN_S_MP_MUL_HIGH_DIGS_C) -# define BN_FAST_S_MP_MUL_HIGH_DIGS_C -# define BN_MP_INIT_SIZE_C # define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C # define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C +# define BN_S_MP_MUL_HIGH_DIGS_FAST_C +#endif + +#if defined(BN_S_MP_MUL_HIGH_DIGS_FAST_C) +# define BN_MP_CLAMP_C +# define BN_MP_GROW_C +#endif + +#if defined(BN_S_MP_PRIME_IS_DIVISIBLE_C) +# define BN_MP_MOD_D_C +#endif + +#if defined(BN_S_MP_RAND_JENKINS_C) +# define BN_S_MP_RAND_JENKINS_INIT_C +#endif + +#if defined(BN_S_MP_RAND_PLATFORM_C) +#endif + +#if defined(BN_S_MP_REVERSE_C) #endif #if defined(BN_S_MP_SQR_C) -# define BN_MP_INIT_SIZE_C # define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C # define BN_MP_EXCH_C -# define BN_MP_CLEAR_C +# define BN_MP_INIT_SIZE_C +#endif + +#if defined(BN_S_MP_SQR_FAST_C) +# define BN_MP_CLAMP_C +# define BN_MP_GROW_C #endif #if defined(BN_S_MP_SUB_C) +# define BN_MP_CLAMP_C # define BN_MP_GROW_C +#endif + +#if defined(BN_S_MP_TOOM_MUL_C) +# define BN_MP_ADD_C +# define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_DIV_2_C +# define BN_MP_DIV_3_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_INIT_SIZE_C +# define BN_MP_LSHD_C +# define BN_MP_MUL_2_C +# define BN_MP_MUL_C +# define BN_MP_SUB_C +#endif + +#if defined(BN_S_MP_TOOM_SQR_C) +# define BN_MP_ADD_C # define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_DIV_2_C +# define BN_MP_INIT_C +# define BN_MP_INIT_SIZE_C +# define BN_MP_LSHD_C +# define BN_MP_MUL_2_C +# define BN_MP_MUL_C +# define BN_MP_SQR_C +# define BN_MP_SUB_C #endif -#if defined(BNCORE_C) -#endif - +#ifdef LTM_INSIDE +#undef LTM_INSIDE #ifdef LTM3 # define LTM_LAST #endif -#include -#include +#include "tommath_superclass.h" +#include "tommath_class.h" #else # define LTM_LAST #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/tommath_cutoffs.h Index: libtommath/tommath_cutoffs.h ================================================================== --- /dev/null +++ libtommath/tommath_cutoffs.h @@ -0,0 +1,13 @@ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ +/* + Current values evaluated on an AMD A8-6600K (64-bit). + Type "make tune" to optimize them for your machine but + be aware that it may take a long time. It took 2:30 minutes + on the aforementioned machine for example. + */ + +#define MP_DEFAULT_KARATSUBA_MUL_CUTOFF 80 +#define MP_DEFAULT_KARATSUBA_SQR_CUTOFF 120 +#define MP_DEFAULT_TOOM_MUL_CUTOFF 350 +#define MP_DEFAULT_TOOM_SQR_CUTOFF 400 Index: libtommath/tommath_private.h ================================================================== --- libtommath/tommath_private.h +++ libtommath/tommath_private.h @@ -1,114 +1,324 @@ -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ -#ifndef TOMMATH_PRIV_H_ -#define TOMMATH_PRIV_H_ - -#include - -#ifndef MIN -#define MIN(x, y) (((x) < (y)) ? (x) : (y)) -#endif - -#ifndef MAX -#define MAX(x, y) (((x) > (y)) ? (x) : (y)) -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -/* define heap macros */ -#ifndef XMALLOC -/* default to libc stuff */ -# define XMALLOC(size) malloc(size) -# define XFREE(mem, size) free(mem) -# define XREALLOC(mem, oldsize, newsize) realloc(mem, newsize) -#elif 0 -/* prototypes for our heap functions */ -extern void *XMALLOC(size_t size); -extern void *XREALLOC(void *mem, size_t oldsize, size_t newsize); -extern void XFREE(void *mem, size_t size); -#endif - -/* you'll have to tune these... */ -#define KARATSUBA_MUL_CUTOFF 80 /* Min. number of digits before Karatsuba multiplication is used. */ -#define KARATSUBA_SQR_CUTOFF 120 /* Min. number of digits before Karatsuba squaring is used. */ -#define TOOM_MUL_CUTOFF 350 /* no optimal values of these are known yet so set em high */ -#define TOOM_SQR_CUTOFF 400 - -/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */ -#define MP_WARRAY (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1)) - -/* ---> Basic Manipulations <--- */ -#define IS_ZERO(a) ((a)->used == 0) -#define IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) -#define IS_ODD(a) (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) - -/* lowlevel functions, do not call! */ -int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c); -int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c); -#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1) -int fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); -int s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); -int fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); -int s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); -int fast_s_mp_sqr(const mp_int *a, mp_int *b); -int s_mp_sqr(const mp_int *a, mp_int *b); -int mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c); -int mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c); -int mp_karatsuba_sqr(const mp_int *a, mp_int *b); -int mp_toom_sqr(const mp_int *a, mp_int *b); -int fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c); -int mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c); -int fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho); -int mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode); -int s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode); -void bn_reverse(unsigned char *s, int len); - -extern const char *const mp_s_rmap; -extern const unsigned char mp_s_rmap_reverse[]; -extern const size_t mp_s_rmap_reverse_sz; - -/* Fancy macro to set an MPI from another type. - * There are several things assumed: - * x is the counter - * a is the pointer to the MPI - * b is the original value that should be set in the MPI. - */ -#define MP_SET_XLONG(func_name, type) \ -int func_name (mp_int * a, type b) \ -{ \ - int x = 0; \ - int new_size = (((CHAR_BIT * sizeof(type)) + DIGIT_BIT) - 1) / DIGIT_BIT; \ - int res = mp_grow(a, new_size); \ - if (res == MP_OKAY) { \ - mp_zero(a); \ - while (b != 0u) { \ - a->dp[x++] = ((mp_digit)b & MP_MASK); \ - if ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT) { break; } \ - b >>= ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT ? 0 : DIGIT_BIT); \ - } \ - a->used = x; \ - } \ - return res; \ -} - -#ifdef __cplusplus -} -#endif - -#endif - - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#ifndef TOMMATH_PRIV_H_ +#define TOMMATH_PRIV_H_ + +#ifdef MP_NO_STDINT +#ifdef HAVE_STDINT_H +# include +#else +# include "../compat/stdint.h" +#endif +#endif +#include "tclTomMath.h" +#include "tommath_class.h" + +/* + * Private symbols + * --------------- + * + * On Unix symbols can be marked as hidden if libtommath is compiled + * as a shared object. By default, symbols are visible. + * As of now, this feature is opt-in via the MP_PRIVATE_SYMBOLS define. + * + * On Win32 a .def file must be used to specify the exported symbols. + */ +#if defined (MP_PRIVATE_SYMBOLS) && defined(__GNUC__) && __GNUC__ >= 4 +# define MP_PRIVATE __attribute__ ((visibility ("hidden"))) +#else +# define MP_PRIVATE +#endif + +/* Hardening libtommath + * -------------------- + * + * By default memory is zeroed before calling + * MP_FREE to avoid leaking data. This is good + * practice in cryptographical applications. + * + * Note however that memory allocators used + * in cryptographical applications can often + * be configured by itself to clear memory, + * rendering the clearing in tommath unnecessary. + * See for example https://github.com/GrapheneOS/hardened_malloc + * and the option CONFIG_ZERO_ON_FREE. + * + * Furthermore there are applications which + * value performance more and want this + * feature to be disabled. For such applications + * define MP_NO_ZERO_ON_FREE during compilation. + */ +#ifdef MP_NO_ZERO_ON_FREE +# define MP_FREE_BUFFER(mem, size) MP_FREE((mem), (size)) +# define MP_FREE_DIGITS(mem, digits) MP_FREE((mem), sizeof (mp_digit) * (size_t)(digits)) +#else +# define MP_FREE_BUFFER(mem, size) \ +do { \ + size_t fs_ = (size); \ + void* fm_ = (mem); \ + if (fm_ != NULL) { \ + MP_ZERO_BUFFER(fm_, fs_); \ + MP_FREE(fm_, fs_); \ + } \ +} while (0) +# define MP_FREE_DIGITS(mem, digits) \ +do { \ + int fd_ = (digits); \ + void* fm_ = (mem); \ + if (fm_ != NULL) { \ + size_t fs_ = sizeof (mp_digit) * (size_t)fd_; \ + MP_ZERO_BUFFER(fm_, fs_); \ + MP_FREE(fm_, fs_); \ + } \ +} while (0) +#endif + +#ifdef MP_USE_MEMSET +# include +# define MP_ZERO_BUFFER(mem, size) memset((mem), 0, (size)) +# define MP_ZERO_DIGITS(mem, digits) \ +do { \ + int zd_ = (digits); \ + if (zd_ > 0) { \ + memset((mem), 0, sizeof(mp_digit) * (size_t)zd_); \ + } \ +} while (0) +#else +# define MP_ZERO_BUFFER(mem, size) \ +do { \ + size_t zs_ = (size); \ + char* zm_ = (char*)(mem); \ + while (zs_-- > 0u) { \ + *zm_++ = '\0'; \ + } \ +} while (0) +# define MP_ZERO_DIGITS(mem, digits) \ +do { \ + int zd_ = (digits); \ + mp_digit* zm_ = (mem); \ + while (zd_-- > 0) { \ + *zm_++ = 0; \ + } \ +} while (0) +#endif + +/* Tunable cutoffs + * --------------- + * + * - In the default settings, a cutoff X can be modified at runtime + * by adjusting the corresponding X_CUTOFF variable. + * + * - Tunability of the library can be disabled at compile time + * by defining the MP_FIXED_CUTOFFS macro. + * + * - There is an additional file tommath_cutoffs.h, which defines + * the default cutoffs. These can be adjusted manually or by the + * autotuner. + * + */ + +#ifdef MP_FIXED_CUTOFFS +# include "tommath_cutoffs.h" +# define MP_KARATSUBA_MUL_CUTOFF MP_DEFAULT_KARATSUBA_MUL_CUTOFF +# define MP_KARATSUBA_SQR_CUTOFF MP_DEFAULT_KARATSUBA_SQR_CUTOFF +# define MP_TOOM_MUL_CUTOFF MP_DEFAULT_TOOM_MUL_CUTOFF +# define MP_TOOM_SQR_CUTOFF MP_DEFAULT_TOOM_SQR_CUTOFF +#else +# define MP_KARATSUBA_MUL_CUTOFF KARATSUBA_MUL_CUTOFF +# define MP_KARATSUBA_SQR_CUTOFF KARATSUBA_SQR_CUTOFF +# define MP_TOOM_MUL_CUTOFF TOOM_MUL_CUTOFF +# define MP_TOOM_SQR_CUTOFF TOOM_SQR_CUTOFF +#endif + +/* define heap macros */ +#ifndef MP_MALLOC +/* default to libc stuff */ +# include +# define MP_MALLOC(size) malloc(size) +# define MP_REALLOC(mem, oldsize, newsize) realloc((mem), (newsize)) +# define MP_CALLOC(nmemb, size) calloc((nmemb), (size)) +# define MP_FREE(mem, size) free(mem) +#elif 0 +/* prototypes for our heap functions */ +extern void *MP_MALLOC(size_t size); +extern void *MP_REALLOC(void *mem, size_t oldsize, size_t newsize); +extern void *MP_CALLOC(size_t nmemb, size_t size); +extern void MP_FREE(void *mem, size_t size); +#endif + +/* feature detection macro */ +#ifdef _MSC_VER +/* Prevent false positive: not enough arguments for function-like macro invocation */ +#pragma warning(disable: 4003) +#endif +#define MP_STRINGIZE(x) MP__STRINGIZE(x) +#define MP__STRINGIZE(x) ""#x"" +#define MP_HAS(x) (sizeof(MP_STRINGIZE(BN_##x##_C)) == 1u) + +/* TODO: Remove private_mp_word as soon as deprecated mp_word is removed from tommath. */ +#if !defined(MP_64BIT) || defined(__GNUC__) +#undef mp_word +typedef private_mp_word mp_word; +#endif + +#define MP_MIN(x, y) (((x) < (y)) ? (x) : (y)) +#define MP_MAX(x, y) (((x) > (y)) ? (x) : (y)) + +/* Static assertion */ +#define MP_STATIC_ASSERT(msg, cond) typedef char mp_static_assert_##msg[(cond) ? 1 : -1]; + +/* ---> Basic Manipulations <--- */ +#define MP_IS_ZERO(a) ((a)->used == 0) +#define MP_IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) +#define MP_IS_ODD(a) (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) + +#define MP_SIZEOF_BITS(type) ((size_t)CHAR_BIT * sizeof(type)) +#define MP_MAXFAST (int)(1uL << (MP_SIZEOF_BITS(mp_word) - (2u * (size_t)MP_DIGIT_BIT))) + +/* TODO: Remove PRIVATE_MP_WARRAY as soon as deprecated MP_WARRAY is removed from tommath.h */ +#undef MP_WARRAY +#define MP_WARRAY PRIVATE_MP_WARRAY + +/* TODO: Remove PRIVATE_MP_PREC as soon as deprecated MP_PREC is removed from tommath.h */ +#ifdef PRIVATE_MP_PREC +# undef MP_PREC +# define MP_PREC PRIVATE_MP_PREC +#endif + +/* Minimum number of available digits in mp_int, MP_PREC >= MP_MIN_PREC */ +#define MP_MIN_PREC ((((int)MP_SIZEOF_BITS(uintmax_t) + MP_DIGIT_BIT) - 1) / MP_DIGIT_BIT) + +MP_STATIC_ASSERT(prec_geq_min_prec, MP_PREC >= MP_MIN_PREC) + +/* random number source */ +extern MP_PRIVATE mp_err(*s_mp_rand_source)(void *out, size_t size); + +#ifdef __cplusplus +extern "C" { +#endif +/* lowlevel functions, do not call! */ +MP_PRIVATE mp_bool s_mp_get_bit(const mp_int *a, unsigned int b); +MP_PRIVATE mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; +MP_PRIVATE mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; +MP_PRIVATE mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; +MP_PRIVATE mp_err s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; +MP_PRIVATE mp_err s_mp_sqr_fast(const mp_int *a, mp_int *b) MP_WUR; +MP_PRIVATE mp_err s_mp_sqr(const mp_int *a, mp_int *b) MP_WUR; +MP_PRIVATE mp_err s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_karatsuba_sqr(const mp_int *a, mp_int *b) MP_WUR; +MP_PRIVATE mp_err s_mp_toom_sqr(const mp_int *a, mp_int *b) MP_WUR; +MP_PRIVATE mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +MP_PRIVATE mp_err s_mp_montgomery_reduce_fast(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR; +MP_PRIVATE mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR; +MP_PRIVATE mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR; +MP_PRIVATE mp_err s_mp_rand_platform(void *p, size_t n) MP_WUR; +MP_PRIVATE mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat); +MP_PRIVATE void s_mp_reverse(unsigned char *s, size_t len); +MP_PRIVATE mp_err s_mp_prime_is_divisible(const mp_int *a, mp_bool *result); + +/* TODO: jenkins prng is not thread safe as of now */ +MP_PRIVATE mp_err s_mp_rand_jenkins(void *p, size_t n) MP_WUR; +MP_PRIVATE void s_mp_rand_jenkins_init(uint64_t seed); + +extern MP_PRIVATE const char *const mp_s_rmap; +extern MP_PRIVATE const uint8_t mp_s_rmap_reverse[]; +extern MP_PRIVATE const size_t mp_s_rmap_reverse_sz; +extern MP_PRIVATE const mp_digit *s_mp_prime_tab; + +/* deprecated functions */ +MP_DEPRECATED(s_mp_invmod_fast) mp_err fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(s_mp_montgomery_reduce_fast) mp_err fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, + mp_digit rho); +MP_DEPRECATED(s_mp_mul_digs_fast) mp_err fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, + int digs); +MP_DEPRECATED(s_mp_mul_high_digs_fast) mp_err fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, + mp_int *c, + int digs); +MP_DEPRECATED(s_mp_sqr_fast) mp_err fast_s_mp_sqr(const mp_int *a, mp_int *b); +MP_DEPRECATED(s_mp_balance_mul) mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(s_mp_exptmod_fast) mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, + mp_int *Y, + int redmode); +MP_DEPRECATED(s_mp_invmod_slow) mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(s_mp_karatsuba_mul) mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(s_mp_karatsuba_sqr) mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b); +MP_DEPRECATED(s_mp_toom_mul) mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c); +MP_DEPRECATED(s_mp_toom_sqr) mp_err mp_toom_sqr(const mp_int *a, mp_int *b); +MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len); + +#ifdef __cplusplus +} +#endif + +#ifndef TCL_WITH_EXTERNAL_TOMMATH +#undef mp_sqr +#define mp_sqr TclBN_mp_sqr +#endif + +#define MP_GET_ENDIANNESS(x) \ + do{\ + int16_t n = 0x1; \ + char *p = (char *)&n; \ + x = (p[0] == '\x01') ? MP_LITTLE_ENDIAN : MP_BIG_ENDIAN; \ + } while (0) + +/* code-generating macros */ +#define MP_SET_UNSIGNED(name, type) \ + void name(mp_int * a, type b) \ + { \ + int i = 0; \ + while (b != 0u) { \ + a->dp[i++] = ((mp_digit)b & MP_MASK); \ + if (MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) { break; } \ + b >>= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT); \ + } \ + a->used = i; \ + a->sign = MP_ZPOS; \ + MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); \ + } + +#define MP_SET_SIGNED(name, uname, type, utype) \ + void name(mp_int * a, type b) \ + { \ + uname(a, (b < 0) ? -(utype)b : (utype)b); \ + if (b < 0) { a->sign = MP_NEG; } \ + } + +#define MP_INIT_INT(name , set, type) \ + mp_err name(mp_int * a, type b) \ + { \ + mp_err err; \ + if ((err = mp_init(a)) != MP_OKAY) { \ + return err; \ + } \ + set(a, b); \ + return MP_OKAY; \ + } + +#define MP_GET_MAG(name, type) \ + type name(const mp_int* a) \ + { \ + unsigned i = MP_MIN((unsigned)a->used, (unsigned)((MP_SIZEOF_BITS(type) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT)); \ + type res = 0u; \ + while (i --> 0u) { \ + res <<= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT); \ + res |= (type)a->dp[i]; \ + if (MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) { break; } \ + } \ + return res; \ + } + +#define MP_GET_SIGNED(name, mag, type, utype) \ + type name(const mp_int* a) \ + { \ + utype res = mag(a); \ + return (a->sign == MP_NEG) ? (type)-res : (type)res; \ + } + +#endif Index: libtommath/tommath_superclass.h ================================================================== --- libtommath/tommath_superclass.h +++ libtommath/tommath_superclass.h @@ -1,88 +1,110 @@ -/* LibTomMath, multiple-precision integer library -- Tom St Denis - * - * LibTomMath is a library that provides multiple-precision - * integer arithmetic as well as number theoretic functionality. - * - * The library was designed directly after the MPI library by - * Michael Fromberger but has been written from scratch with - * additional optimizations in place. - * - * SPDX-License-Identifier: Unlicense - */ +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ /* super class file for PK algos */ /* default ... include all MPI */ +#ifndef LTM_NOTHING #define LTM_ALL +#endif /* RSA only (does not support DH/DSA/ECC) */ /* #define SC_RSA_1 */ +/* #define SC_RSA_1_WITH_TESTS */ /* For reference.... On an Athlon64 optimizing for speed... LTM's mpi.o with all functions [striped] is 142KiB in size. */ + +#ifdef SC_RSA_1_WITH_TESTS +# define BN_MP_ERROR_TO_STRING_C +# define BN_MP_FREAD_C +# define BN_MP_FWRITE_C +# define BN_MP_INCR_C +# define BN_MP_ISEVEN_C +# define BN_MP_ISODD_C +# define BN_MP_NEG_C +# define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C +# define BN_MP_RADIX_SIZE_C +# define BN_MP_RAND_C +# define BN_MP_REDUCE_C +# define BN_MP_REDUCE_2K_L_C +# define BN_MP_FROM_SBIN_C +# define BN_MP_ROOT_U32_C +# define BN_MP_SET_L_C +# define BN_MP_SET_UL_C +# define BN_MP_SBIN_SIZE_C +# define BN_MP_TO_RADIX_C +# define BN_MP_TO_SBIN_C +# define BN_S_MP_RAND_JENKINS_C +# define BN_S_MP_RAND_PLATFORM_C +#endif /* Works for RSA only, mpi.o is 68KiB */ -#ifdef SC_RSA_1 -# define BN_MP_SHRINK_C -# define BN_MP_LCM_C -# define BN_MP_PRIME_RANDOM_EX_C -# define BN_MP_INVMOD_C -# define BN_MP_GCD_C -# define BN_MP_MOD_C -# define BN_MP_MULMOD_C +#if defined(SC_RSA_1) || defined (SC_RSA_1_WITH_TESTS) +# define BN_CUTOFFS_C # define BN_MP_ADDMOD_C -# define BN_MP_EXPTMOD_C -# define BN_MP_SET_INT_C -# define BN_MP_INIT_MULTI_C # define BN_MP_CLEAR_MULTI_C -# define BN_MP_UNSIGNED_BIN_SIZE_C -# define BN_MP_TO_UNSIGNED_BIN_C +# define BN_MP_EXPTMOD_C +# define BN_MP_GCD_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_INVMOD_C +# define BN_MP_LCM_C +# define BN_MP_MOD_C # define BN_MP_MOD_D_C +# define BN_MP_MULMOD_C +# define BN_MP_PRIME_IS_PRIME_C # define BN_MP_PRIME_RABIN_MILLER_TRIALS_C -# define BN_REVERSE_C +# define BN_MP_PRIME_RAND_C +# define BN_MP_RADIX_SMAP_C +# define BN_MP_SET_INT_C +# define BN_MP_SHRINK_C +# define BN_MP_TO_UNSIGNED_BIN_C +# define BN_MP_UNSIGNED_BIN_SIZE_C # define BN_PRIME_TAB_C +# define BN_S_MP_REVERSE_C /* other modifiers */ # define BN_MP_DIV_SMALL /* Slower division, not critical */ + /* here we are on the last pass so we turn things off. The functions classes are still there * but we remove them specifically from the build. This also invokes tweaks in functions * like removing support for even moduli, etc... */ # ifdef LTM_LAST -# undef BN_MP_TOOM_MUL_C -# undef BN_MP_TOOM_SQR_C -# undef BN_MP_KARATSUBA_MUL_C -# undef BN_MP_KARATSUBA_SQR_C -# undef BN_MP_REDUCE_C -# undef BN_MP_REDUCE_SETUP_C # undef BN_MP_DR_IS_MODULUS_C # undef BN_MP_DR_SETUP_C # undef BN_MP_DR_REDUCE_C -# undef BN_MP_REDUCE_IS_2K_C +# undef BN_MP_DIV_3_C # undef BN_MP_REDUCE_2K_SETUP_C # undef BN_MP_REDUCE_2K_C +# undef BN_MP_REDUCE_IS_2K_C +# undef BN_MP_REDUCE_SETUP_C +# undef BN_S_MP_BALANCE_MUL_C # undef BN_S_MP_EXPTMOD_C -# undef BN_MP_DIV_3_C +# undef BN_S_MP_INVMOD_FAST_C +# undef BN_S_MP_KARATSUBA_MUL_C +# undef BN_S_MP_KARATSUBA_SQR_C # undef BN_S_MP_MUL_HIGH_DIGS_C -# undef BN_FAST_S_MP_MUL_HIGH_DIGS_C -# undef BN_FAST_MP_INVMOD_C +# undef BN_S_MP_MUL_HIGH_DIGS_FAST_C +# undef BN_S_MP_TOOM_MUL_C +# undef BN_S_MP_TOOM_SQR_C + +# ifndef SC_RSA_1_WITH_TESTS +# undef BN_MP_REDUCE_C +# endif /* To safely undefine these you have to make sure your RSA key won't exceed the Comba threshold * which is roughly 255 digits [7140 bits for 32-bit machines, 15300 bits for 64-bit machines] * which means roughly speaking you can handle upto 2536-bit RSA keys with these defined without * trouble. */ +# undef BN_MP_MONTGOMERY_REDUCE_C # undef BN_S_MP_MUL_DIGS_C # undef BN_S_MP_SQR_C -# undef BN_MP_MONTGOMERY_REDUCE_C # endif #endif - -/* ref: $Format:%D$ */ -/* git commit: $Format:%H$ */ -/* commit time: $Format:%ai$ */ ADDED libtommath/win32/libtommath.dll Index: libtommath/win32/libtommath.dll ================================================================== --- /dev/null +++ libtommath/win32/libtommath.dll cannot compute difference between binary files ADDED libtommath/win32/tommath.lib Index: libtommath/win32/tommath.lib ================================================================== --- /dev/null +++ libtommath/win32/tommath.lib cannot compute difference between binary files ADDED libtommath/win64/libtommath.dll Index: libtommath/win64/libtommath.dll ================================================================== --- /dev/null +++ libtommath/win64/libtommath.dll cannot compute difference between binary files ADDED libtommath/win64/libtommath.dll.a Index: libtommath/win64/libtommath.dll.a ================================================================== --- /dev/null +++ libtommath/win64/libtommath.dll.a cannot compute difference between binary files ADDED libtommath/win64/tommath.lib Index: libtommath/win64/tommath.lib ================================================================== --- /dev/null +++ libtommath/win64/tommath.lib cannot compute difference between binary files Index: macosx/README ================================================================== --- macosx/README +++ macosx/README @@ -19,11 +19,11 @@ - The Tcl'ers Wiki also has many pages dealing with Tcl & Tk on Mac OS X, see http://wiki.tcl.tk/_/ref?N=3753 http://wiki.tcl.tk/_/ref?N=8361 - Please report bugs with Tcl on Mac OS X to the tracker: - http://core.tcl.tk/tcl/reportlist + https://core.tcl-lang.org/tcl/reportlist 2. Using Tcl on Mac OS X ------------------------ - At a minimum, Mac OS X 10.3 is required to run Tcl. @@ -34,12 +34,12 @@ in a binary built on 10.x). Weak-linking is available on OS X 10.2 or later, it additionally allows Tcl built on 10.x to run on any 10.y with x > y >= z (for a chosen z >= 2). - Tcl extensions can be installed in any of: - $HOME/Library/Tcl /Library/Tcl /System/Library/Tcl - $HOME/Library/Frameworks /Library/Frameworks /System/Library/Frameworks + $HOME/Library/Tcl /Library/Tcl + $HOME/Library/Frameworks /Library/Frameworks (searched in that order). Given a potential package directory $pkg, Tcl on OSX checks for the file $pkg/Resources/Scripts/pkgIndex.tcl as well as the usual $pkg/pkgIndex.tcl. This allows building extensions as frameworks with all script files contained in the Resources/Scripts directory of the framework. @@ -55,11 +55,11 @@ Tcl.framework/Resources/Documentation/Reference/Tcl No nroff manpages are installed by default by the GNUmakefile. - The Tcl framework can be installed in any of the system's standard framework directories: - $HOME/Library/Frameworks /Library/Frameworks /System/Library/Frameworks + $HOME/Library/Frameworks /Library/Frameworks 3. Building Tcl on Mac OS X --------------------------- @@ -111,11 +111,11 @@ Note that the non-SDK configurations have their deployment target set to 10.5 (Tcl.xcode) resp. 10.6 (Tcl.xcodeproj). The Xcode projects refer to the toplevel tcl source directory via the TCL_SRCROOT user build setting, by default this is set to the project-relative path '../../tcl', if your tcl source directory is named differently, e.g. -'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing +'../../tcl8.7', you need to manually change the TCL_SRCROOT setting by editing your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory) with a text editor. - To build universal binaries outside of the Xcode IDE, set CFLAGS as follows: export CFLAGS="-arch i386 -arch x86_64 -arch ppc" @@ -132,13 +132,13 @@ ---------------------------------------------------------- - Unpack the Tcl source release archive. - The following instructions assume the Tcl source tree is named "tcl${ver}", -(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0'). +(where ${ver} is a shell variable containing the Tcl version number e.g. '8.7'). Setup this shell variable as follows: - ver="9.0" + ver="8.7" If you are building from CVS, omit this step (CVS source tree names usually do not contain a version number). - Setup environment variables as desired, e.g. for a universal build on 10.5: CFLAGS="-arch i386 -arch x86_64 -arch ppc -mmacosx-version-min=10.5" Index: macosx/Tcl-Common.xcconfig ================================================================== --- macosx/Tcl-Common.xcconfig +++ macosx/Tcl-Common.xcconfig @@ -32,6 +32,6 @@ PREFIX = /usr/local TCL_CONFIGURE_ARGS = --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H -VERSION = 9.0 +VERSION = 8.7 Index: macosx/Tcl.xcode/project.pbxproj ================================================================== --- macosx/Tcl.xcode/project.pbxproj +++ macosx/Tcl.xcode/project.pbxproj @@ -136,13 +136,12 @@ F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; }; F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; }; F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; }; F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; }; F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; }; - F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */; }; + F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */; }; F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; }; - F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; }; F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; }; F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; }; F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; }; F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; }; F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; }; @@ -162,18 +161,17 @@ F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; }; F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; }; F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; }; - F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; }; + F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; }; F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */; }; F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; }; F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; }; F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; }; - F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; }; - F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; }; - F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; }; + F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */; }; + F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */; }; F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; }; F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; }; /* End PBXBuildFile section */ /* Begin PBXContainerItemProxy section */ @@ -534,11 +532,10 @@ F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = ""; }; F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = ""; }; F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = ""; }; F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = ""; }; F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = ""; }; - F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = ""; }; F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = ""; }; F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = ""; }; F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = ""; }; F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = ""; }; @@ -576,11 +573,11 @@ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = ""; }; F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = ""; }; F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = ""; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = ""; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = ""; }; - F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = ""; }; + F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = ""; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = ""; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = ""; }; F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = ""; }; F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = ""; }; F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = ""; }; @@ -604,19 +601,17 @@ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = ""; }; F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = ""; }; F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = ""; }; F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = ""; }; F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = ""; }; - F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = ""; }; - F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = ""; }; + F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_ubin.c; sourceTree = ""; }; F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = ""; }; F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = ""; }; - F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = ""; }; - F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = ""; }; + F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_radix.c; sourceTree = ""; }; + F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_ubin_size.c; sourceTree = ""; }; F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = ""; }; F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = ""; }; - F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = ""; }; F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = ""; }; F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = ""; }; F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = ""; }; F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = ""; }; F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = ""; }; @@ -767,11 +762,10 @@ F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = ""; }; F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = ""; }; F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = ""; }; F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = ""; }; - F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = ""; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = ""; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = ""; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = ""; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = ""; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; @@ -1323,11 +1317,10 @@ F96D3F3308F272A7004A47F5 /* tclUniData.c */, F96D3F3408F272A7004A47F5 /* tclUtf.c */, F96D3F3508F272A7004A47F5 /* tclUtil.c */, F96D3F3608F272A7004A47F5 /* tclVar.c */, F96437C90EF0D4B2003F468E /* tclZlib.c */, - F96D3F3708F272A7004A47F5 /* tommath.h */, ); path = generic; sourceTree = ""; }; F96D3F3808F272A7004A47F5 /* library */ = { @@ -1336,10 +1329,11 @@ F96D3F3908F272A8004A47F5 /* auto.tcl */, F96D3F3A08F272A8004A47F5 /* clock.tcl */, F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, + F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, F96D401A08F272AA004A47F5 /* package.tcl */, F96D401B08F272AA004A47F5 /* parray.tcl */, @@ -1368,10 +1362,19 @@ F96D3F8E08F272A8004A47F5 /* http.tcl */, F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */, ); path = http; sourceTree = ""; + }; + F96D3F9008F272A8004A47F5 /* http1.0 */ = { + isa = PBXGroup; + children = ( + F96D3F9108F272A8004A47F5 /* http.tcl */, + F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */, + ); + path = http1.0; + sourceTree = ""; }; F96D3F9408F272A8004A47F5 /* msgcat */ = { isa = PBXGroup; children = ( F96D3F9508F272A8004A47F5 /* msgcat.tcl */, @@ -1426,11 +1429,11 @@ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */, F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, - F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */, + F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */, F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */, @@ -1455,19 +1458,17 @@ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */, F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */, F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */, F96D42C108F272B3004A47F5 /* bn_mp_sub.c */, F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */, - F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */, - F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */, + F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */, F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */, F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */, - F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */, - F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */, + F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */, + F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */, F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */, F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */, - F96D42D008F272B3004A47F5 /* bn_reverse.c */, F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */, F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */, F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */, F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */, F96D432908F272B4004A47F5 /* tommath_class.h */, @@ -1652,11 +1653,10 @@ isa = PBXGroup; children = ( F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.ac */, - F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, F96D442A08F272B8004A47F5 /* Makefile.in */, @@ -2057,11 +2057,11 @@ F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */, F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */, F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */, F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */, F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */, - F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */, + F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */, F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */, F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */, F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */, F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */, F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */, @@ -2086,19 +2086,17 @@ F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */, F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */, F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */, F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */, F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */, - F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */, - F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */, + F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */, F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */, F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */, - F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */, - F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */, + F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */, + F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */, F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */, F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */, - F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */, F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */, F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */, F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */, F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */, F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */, Index: macosx/Tcl.xcodeproj/project.pbxproj ================================================================== --- macosx/Tcl.xcodeproj/project.pbxproj +++ macosx/Tcl.xcodeproj/project.pbxproj @@ -136,13 +136,12 @@ F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; }; F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; }; F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; }; F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; }; F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; }; - F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */; }; + F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */; }; F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; }; - F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; }; F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; }; F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; }; F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; }; F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; }; F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; }; @@ -162,18 +161,16 @@ F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; }; F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; }; F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; }; - F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */; }; - F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; }; + F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; }; F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; }; F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; }; F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; }; - F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; }; - F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; }; - F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; }; + F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */; }; + F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */; }; F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; }; F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; }; /* End PBXBuildFile section */ /* Begin PBXContainerItemProxy section */ @@ -534,11 +531,10 @@ F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = ""; }; F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = ""; }; F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = ""; }; F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = ""; }; F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = ""; }; - F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = ""; }; F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = ""; }; F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = ""; }; F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = ""; }; F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = ""; }; F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = ""; }; @@ -576,11 +572,11 @@ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = ""; }; F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = ""; }; F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = ""; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = ""; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = ""; }; - F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = ""; }; + F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = ""; }; F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d_ex.c; sourceTree = ""; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = ""; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = ""; }; F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = ""; }; F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = ""; }; @@ -605,19 +601,17 @@ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = ""; }; F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = ""; }; F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = ""; }; F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = ""; }; F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = ""; }; - F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = ""; }; - F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = ""; }; + F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_ubin.c; sourceTree = ""; }; F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = ""; }; F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = ""; }; - F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = ""; }; - F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = ""; }; + F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_radix.c; sourceTree = ""; }; + F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_ubin_size.c; sourceTree = ""; }; F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = ""; }; F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = ""; }; - F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = ""; }; F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = ""; }; F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = ""; }; F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = ""; }; F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = ""; }; F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = ""; }; @@ -768,11 +762,10 @@ F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = ""; }; F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = ""; }; F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = ""; }; F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = ""; }; F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = ""; }; - F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = ""; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = ""; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = ""; }; F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = ""; }; F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = ""; }; F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = ""; }; @@ -1324,11 +1317,10 @@ F96D3F3308F272A7004A47F5 /* tclUniData.c */, F96D3F3408F272A7004A47F5 /* tclUtf.c */, F96D3F3508F272A7004A47F5 /* tclUtil.c */, F96D3F3608F272A7004A47F5 /* tclVar.c */, F96437C90EF0D4B2003F468E /* tclZlib.c */, - F96D3F3708F272A7004A47F5 /* tommath.h */, ); path = generic; sourceTree = ""; }; F96D3F3808F272A7004A47F5 /* library */ = { @@ -1337,10 +1329,11 @@ F96D3F3908F272A8004A47F5 /* auto.tcl */, F96D3F3A08F272A8004A47F5 /* clock.tcl */, F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, + F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, F96D401A08F272AA004A47F5 /* package.tcl */, F96D401B08F272AA004A47F5 /* parray.tcl */, @@ -1369,10 +1362,19 @@ F96D3F8E08F272A8004A47F5 /* http.tcl */, F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */, ); path = http; sourceTree = ""; + }; + F96D3F9008F272A8004A47F5 /* http1.0 */ = { + isa = PBXGroup; + children = ( + F96D3F9108F272A8004A47F5 /* http.tcl */, + F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */, + ); + path = http1.0; + sourceTree = ""; }; F96D3F9408F272A8004A47F5 /* msgcat */ = { isa = PBXGroup; children = ( F96D3F9508F272A8004A47F5 /* msgcat.tcl */, @@ -1427,11 +1429,11 @@ F96D427708F272B3004A47F5 /* bn_mp_div_2.c */, F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, - F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */, + F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */, F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */, @@ -1456,19 +1458,17 @@ F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */, F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */, F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */, F96D42C108F272B3004A47F5 /* bn_mp_sub.c */, F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */, - F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */, - F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */, + F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */, F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */, F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */, - F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */, - F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */, + F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */, + F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */, F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */, F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */, - F96D42D008F272B3004A47F5 /* bn_reverse.c */, F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */, F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */, F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */, F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */, F96D432908F272B4004A47F5 /* tommath_class.h */, @@ -1653,11 +1653,10 @@ isa = PBXGroup; children = ( F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.ac */, - F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, F96D442808F272B8004A47F5 /* installData.tcl */, F96D442908F272B8004A47F5 /* loadICU.tcl */, F96D442A08F272B8004A47F5 /* Makefile.in */, @@ -2058,11 +2057,11 @@ F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */, F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */, F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */, F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */, F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */, - F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */, + F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */, F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */, F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */, F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */, F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */, F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */, @@ -2087,19 +2086,17 @@ F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */, F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */, F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */, F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */, F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */, - F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */, - F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */, + F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */, F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */, F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */, - F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */, - F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */, + F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */, + F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */, F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */, F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */, - F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */, F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */, F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */, F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */, F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */, F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */, Index: macosx/tclMacOSXBundle.c ================================================================== --- macosx/tclMacOSXBundle.c +++ macosx/tclMacOSXBundle.c @@ -10,10 +10,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclPort.h" +#include "tclInt.h" #ifdef HAVE_COREFOUNDATION #include #ifndef TCL_DYLD_USE_DLFCN @@ -104,11 +105,11 @@ #if TCL_DYLD_USE_DLFCN #if MAC_OS_X_VERSION_MIN_REQUIRED < 1040 if (tclMacOSXDarwinRelease >= 8) #endif { - openresourcemap = dlsym(RTLD_NEXT, + openresourcemap = (short (*)(CFBundleRef))dlsym(RTLD_NEXT, "CFBundleOpenBundleResourceMap"); #ifdef TCL_DEBUG_LOAD if (!openresourcemap) { const char *errMsg = dlerror(); @@ -160,21 +161,24 @@ * libraryVariableName may be set, and the resource file opened. * *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) +#undef Tcl_MacOSXOpenBundleResources int Tcl_MacOSXOpenBundleResources( Tcl_Interp *interp, const char *bundleName, int hasResourceFile, - size_t maxPathLen, + int maxPathLen, char *libraryPath) { return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL, hasResourceFile, maxPathLen, libraryPath); } +#endif /* *---------------------------------------------------------------------- * * Tcl_MacOSXOpenVersionedBundleResources -- @@ -195,15 +199,15 @@ *---------------------------------------------------------------------- */ int Tcl_MacOSXOpenVersionedBundleResources( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), const char *bundleName, const char *bundleVersion, int hasResourceFile, - size_t maxPathLen, + int maxPathLen, char *libraryPath) { #ifdef HAVE_COREFOUNDATION CFBundleRef bundleRef, versionedBundleRef = NULL; CFStringRef bundleNameRef; Index: macosx/tclMacOSXFCmd.c ================================================================== --- macosx/tclMacOSXFCmd.c +++ macosx/tclMacOSXFCmd.c @@ -170,11 +170,11 @@ if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) { alist.fileattr = ATTR_FILE_RSRCLENGTH; } else { alist.commonattr = ATTR_CMN_FNDRINFO; } - native = Tcl_FSGetNativePath(fileName); + native = (const char *)Tcl_FSGetNativePath(fileName); result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read attributes of \"%s\": %s", @@ -266,11 +266,11 @@ if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) { alist.fileattr = ATTR_FILE_RSRCLENGTH; } else { alist.commonattr = ATTR_CMN_FNDRINFO; } - native = Tcl_FSGetNativePath(fileName); + native = (const char *)Tcl_FSGetNativePath(fileName); result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read attributes of \"%s\": %s", @@ -345,11 +345,11 @@ Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); - result = truncate(Tcl_DStringValue(&ds), (off_t)0); + result = truncate(Tcl_DStringValue(&ds), 0); if (result != 0) { /* * truncate() on a valid resource fork path may fail with a * permission error in some OS releases, try truncating with * open() instead: @@ -637,14 +637,13 @@ { const char *string; int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); - size_t length; - string = TclGetStringFromObj(objPtr, &length); - Tcl_UtfToExternalDString(encoding, string, length, &ds); + string = TclGetString(objPtr); + Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected Macintosh OS type but got \"%s\": ", string)); @@ -688,11 +687,11 @@ *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( - register Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.wideValue; Index: macosx/tclMacOSXNotify.c ================================================================== --- macosx/tclMacOSXNotify.c +++ macosx/tclMacOSXNotify.c @@ -753,11 +753,11 @@ *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( - ClientData clientData) /* Not used. */ + ClientData clientData) { ThreadSpecificData *tsdPtr; if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); @@ -856,11 +856,11 @@ void Tcl_AlertNotifier( ClientData clientData) { - ThreadSpecificData *tsdPtr = clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); return; } @@ -940,12 +940,12 @@ *---------------------------------------------------------------------- */ static void TimerWakeUp( - CFRunLoopTimerRef timer, - void *info) + TCL_UNUSED(CFRunLoopTimerRef), + TCL_UNUSED(ClientData)) { } /* *---------------------------------------------------------------------- @@ -1034,11 +1034,11 @@ if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { - filePtr = Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; } @@ -1162,11 +1162,11 @@ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } - Tcl_Free(filePtr); + ckfree(filePtr); } /* *---------------------------------------------------------------------- * @@ -1378,11 +1378,11 @@ QueueFileEvents( void *info) { SelectMasks readyMasks; FileHandler *filePtr; - ThreadSpecificData *tsdPtr = info; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info; /* * Queue all detected file events. */ @@ -1417,11 +1417,11 @@ * Don't bother to queue an event if the mask was previously non-zero * since an event must still be on the queue. */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = Tcl_Alloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } @@ -1446,15 +1446,15 @@ *---------------------------------------------------------------------- */ static void UpdateWaitingListAndServiceEvents( - CFRunLoopObserverRef observer, + TCL_UNUSED(CFRunLoopObserverRef), CFRunLoopActivity activity, void *info) { - ThreadSpecificData *tsdPtr = info; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info; if (tsdPtr->sleeping) { return; } switch (activity) { @@ -1825,11 +1825,11 @@ *---------------------------------------------------------------------- */ static TCL_NORETURN void NotifierThreadProc( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr; fd_set readableMask, writableMask, exceptionalMask; int i, numFdBits = 0, polling; struct timeval poll = {0., 0.}, *timePtr; Index: tests-perf/clock.perf.tcl ================================================================== --- tests-perf/clock.perf.tcl +++ tests-perf/clock.perf.tcl @@ -120,11 +120,11 @@ {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} } } proc test-scan {{reptime 1000}} { - _test_run $reptime { + _test_run -convert-result {clock format $_(r) -locale en} $reptime { # Scan : date (in gmt) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} # Scan : date (system time zone, with base) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0} # Scan : date (system time zone, without base) @@ -196,15 +196,15 @@ # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} # # Scan : again: # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} - } {puts [clock format $_(r) -locale en]} + } } proc test-freescan {{reptime 1000}} { - _test_run $reptime { + _test_run -convert-result {clock format $_(r) -locale en} $reptime { # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} # FreeScan : relative date with relative weekday {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} # FreeScan : relative date with ordinal month @@ -237,11 +237,11 @@ {clock scan "19:18:30 GMT" -base 148863600} # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST {clock scan "19:18:30 MST" -base 148863600 -gmt 1 clock scan "19:18:30 EST" -base 148863600 } - } {puts [clock format $_(r) -locale en]} + } } proc test-add {{reptime 1000}} { set tests { # Add : years @@ -280,11 +280,11 @@ } # if does not support add of weekdays: if {[catch {clock add 0 3 weekdays -gmt 1}]} { regsub -all {\mweekdays\M} $tests "days" tests } - _test_run $reptime $tests {puts [clock format $_(r) -locale en]} + _test_run -convert-result {clock format $_(r) -locale en} $reptime $tests } proc test-convert {{reptime 1000}} { _test_run $reptime { # Convert locale (en -> de): Index: tests-perf/test-performance.tcl ================================================================== --- tests-perf/test-performance.tcl +++ tests-perf/test-performance.tcl @@ -47,11 +47,11 @@ if {!$tcnt} { puts "" return } - set mintm 0x7fffffff + set mintm 0x7FFFFFFF set maxtm 0 set nettm 0 set wtm 0 set wcnt 0 set i 0 @@ -125,19 +125,27 @@ } proc _test_run {args} { upvar _ _ # parse args: - array set _ [set _opts {-no-result 0 -uplevel 0}] + array set _ {-no-result 0 -uplevel 0 -convert-result {}} while {[llength $args] > 2} { - if {[set o [lindex $args 0]] ni $_opts || $_($o)} { + if {![info exists _([set o [lindex $args 0]])]} { break } - set _($o) 1 - set args [lrange $args 1 end] + if {[string is boolean -strict $_($o)]} { + set _($o) [expr {! $_($o)}] + set args [lrange $args 1 end] + } else { + if {[llength $args] <= 2} { + return -code error "value expected for option $o" + } + set _($o) [lindex $args 1] + set args [lrange $args 2 end] + } } - unset -nocomplain _opts o + unset -nocomplain o if {[llength $args] < 2 || [llength $args] > 3} { return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\"" } set _(outcmd) {puts} set args [lassign $args reptime lst] @@ -171,11 +179,12 @@ } set _(ittime) $_(reptime) # if output result (and not once): if {!$_(-no-result)} { set _(r) [if 1 $_(c)] - if {$_(outcmd) ne {}} {{*}$_(outcmd) $_(r)} + if {$_(-convert-result) ne ""} { set _(r) [if 1 $_(-convert-result)] } + {*}$_(outcmd) $_(r) if {[llength $_(ittime)] > 1} { # decrement max-count lset _(ittime) 1 [expr {[lindex $_(ittime) 1] - 1}] } } {*}$_(outcmd) [set _(m) [timerate $_(c) {*}$_(ittime)]] Index: tests/all.tcl ================================================================== --- tests/all.tcl +++ tests/all.tcl @@ -10,11 +10,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest package require Tcl 8.5- -package require tcltest 2.2 +package require tcltest 2.5 namespace import ::tcltest::* configure {*}$argv -testdir [file dirname [file dirname [file normalize [ info script]/...]]] @@ -23,6 +23,11 @@ } set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] unset -nocomplain env(ERROR_ON_FAILURES) if {[runAllTests] && $ErrorOnFailures} {exit 1} -proc exit args {} +# if calling direct only (avoid rewrite exit if inlined or interactive): +if { [info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]] + && !([info exists ::tcl_interactive] && $::tcl_interactive) +} { + proc exit args {} +} Index: tests/assemble.test ================================================================== --- tests/assemble.test +++ tests/assemble.test @@ -529,10 +529,22 @@ } x } -result 12 -cleanup {rename x {}} +} +test assemble-7.17 {land/lor} { + -body { + proc x {a b} { + list \ + [assemble {load a; load b; land}] \ + [assemble {load a; load b; lor}] + } + list [x 0 0] [x 0 23] [x 35 0] [x 47 59] + } + -result {{0 0} {0 1} {0 1} {1 1}} + -cleanup {rename x {}} } test assemble-7.18 {lappendArrayStk} { -body { proc x {} { set able(baker) charlie @@ -767,11 +779,11 @@ assemble { push NaN; uplus } } -returnCodes error - -result {can't use non-numeric floating-point value "NaN" as operand of "+"} + -result {can't use non-numeric floating-point value as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { assemble { push NaN; tryCvtToNumeric @@ -1522,65 +1534,39 @@ -cleanup {rename x {}} } # assemble-15 - listIndexImm -test assemble-15.1 {listIndexImm - wrong # args} { - -body { - assemble {listIndexImm} - } - -returnCodes error - -match glob - -result {wrong # args*} -} -test assemble-15.2 {listIndexImm - wrong # args} { - -body { - assemble {listIndexImm too many} - } - -returnCodes error - -match glob - -result {wrong # args*} -} -test assemble-15.3 {listIndexImm - bad substitution} { - -body { - list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode - } - -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} - -cleanup {unset result} -} -test assemble-15.4 {listIndexImm - invalid index} { - -body { - assemble {listIndexImm rubbish} - } - -returnCodes error - -match glob - -result {bad index "rubbish"*} -} -test assemble-15.5 {listIndexImm} { - -body { - assemble {push {a b c}; listIndexImm 2} - } - -result c -} -test assemble-15.6 {listIndexImm} { - -body { - assemble {push {a b c}; listIndexImm end-1} - } - -result b -} -test assemble-15.7 {listIndexImm} { - -body { - assemble {push {a b c}; listIndexImm end} - } - -result c -} -test assemble-15.8 {listIndexImm} { +test assemble-15.1 {listIndexImm - wrong # args} -body { + assemble {listIndexImm} +} -returnCodes error -match glob -result {wrong # args*} +test assemble-15.2 {listIndexImm - wrong # args} -body { + assemble {listIndexImm too many} +} -returnCodes error -match glob -result {wrong # args*} +test assemble-15.3 {listIndexImm - bad substitution} -body { + list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode +} -cleanup { + unset result +} -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} +test assemble-15.4 {listIndexImm - invalid index} -body { + assemble {listIndexImm rubbish} +} -returnCodes error -match glob -result {bad index "rubbish"*} +test assemble-15.5 {listIndexImm} -body { + assemble {push {a b c}; listIndexImm 2} +} -result c +test assemble-15.6 {listIndexImm} -body { + assemble {push {a b c}; listIndexImm end-1} +} -result b +test assemble-15.7 {listIndexImm} -body { + assemble {push {a b c}; listIndexImm end} +} -result c +test assemble-15.8 {listIndexImm} -body { assemble {push {a b c}; listIndexImm end+2} -} {} -test assemble-15.9 {listIndexImm} { +} -result {} +test assemble-15.9 {listIndexImm} -body { assemble {push {a b c}; listIndexImm -1-1} -} {} +} -result {} # assemble-16 - invokeStk test assemble-16.1 {invokeStk - wrong # args} { -body { Index: tests/async.test ================================================================== --- tests/async.test +++ tests/async.test @@ -18,10 +18,11 @@ ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testasync [llength [info commands testasync]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] proc async1 {result code} { global aresult acode set aresult $result set acode $code @@ -200,11 +201,11 @@ # "still reachable" cases from early thread termination after 100 testasync delete $hm } test async-4.3 {async interrupting loop-less bytecode sequence} -constraints { - testasync + testasync knownMsvcBug } -setup { set hm [testasync create async3] } -body { apply [list {handle} [concat { global aresult Index: tests/basic.test ================================================================== --- tests/basic.test +++ tests/basic.test @@ -962,11 +962,11 @@ unset -nocomplain a } -body { run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]} } -result [lrepeat 3 {}] -cleanup {unset -nocomplain a} -test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -setup { +test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -constraints $constraints -setup { unset -nocomplain ::CRLF set ::CRLF "\r\n" } -body { # Force variant that turned up in Bug 2c154a40be as that's externally # noticeable in an important downstream project. Index: tests/binary.test ================================================================== --- tests/binary.test +++ tests/binary.test @@ -14,10 +14,11 @@ package require tcltest namespace import -force ::tcltest::* } testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}] testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}] +testConstraint testbytestring [llength [info commands testbytestring]] # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues binary scan [binary format dd -1.0 1.0] c* c @@ -2508,13 +2509,13 @@ binary decode hex "61 61" } -result {aa} test binary-71.7 {binary decode hex} -body { binary decode hex "61\n\n\n61" } -result {aa} -test binary-71.8 {binary decode hex} -body { +test binary-71.8 {binary decode hex} -match glob -body { binary decode hex -strict "61 61" -} -returnCodes error -result {invalid hexadecimal digit " " at position 2} +} -returnCodes error -result {invalid hexadecimal digit " " * at position 2} test binary-71.9 {binary decode hex} -body { set r [binary decode hex "6"] list [string length $r] $r } -result {0 {}} test binary-71.10 {binary decode hex} -body { @@ -2631,10 +2632,13 @@ binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc } -result {YWJj-*-YWJj-*-YWJj} test binary-72.28 {binary encode base64} -body { binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc } -result {YWJjYW0123456789JjYWJj} +test binary-72.29 {binary encode base64} { + string length [binary encode base64 -maxlen 3 -wrapchar \xca abc] +} 5 test binary-73.1 {binary decode base64} -body { binary decode base64 } -returnCodes error -match glob -result "wrong # args: *" test binary-73.2 {binary decode base64} -body { @@ -2644,23 +2648,23 @@ binary decode base64 {} } -result {} test binary-73.4 {binary decode base64} -body { binary decode base64 [string repeat YWJj 20] } -result [string repeat abc 20] -test binary-73.5 {binary encode base64} -body { +test binary-73.5 {binary decode base64} -body { binary decode base64 AAECAwQAAQID } -result "\0\1\2\3\4\0\1\2\3" -test binary-73.6 {binary encode base64} -body { +test binary-73.6 {binary decode base64} -body { binary decode base64 AA== } -result "\0" -test binary-73.7 {binary encode base64} -body { +test binary-73.7 {binary decode base64} -body { binary decode base64 AAA= } -result "\0\0" -test binary-73.8 {binary encode base64} -body { +test binary-73.8 {binary decode base64} -body { binary decode base64 AAAA } -result "\0\0\0" -test binary-73.9 {binary encode base64} -body { +test binary-73.9 {binary decode base64} -body { binary decode base64 AAAAAA== } -result "\0\0\0\0" test binary-73.10 {binary decode base64} -body { set s "[string repeat YWJj 10]\n[string repeat YWJj 10]" binary decode base64 $s @@ -2669,15 +2673,15 @@ set s "[string repeat YWJj 10]\n [string repeat YWJj 10]" binary decode base64 $s } -result [string repeat abc 20] test binary-73.12 {binary decode base64} -body { binary decode base64 -strict ":YWJj" -} -returnCodes error -match glob -result {invalid base64 character ":" at position 0} +} -returnCodes error -match glob -result {invalid base64 character ":" * at position 0} test binary-73.13 {binary decode base64} -body { set s "[string repeat YWJj 10]:[string repeat YWJj 10]" binary decode base64 -strict $s -} -returnCodes error -match glob -result {invalid base64 character ":" at position 40} +} -returnCodes error -match glob -result {invalid base64 character ":" * at position 40} test binary-73.14 {binary decode base64} -body { set s "[string repeat YWJj 10]\n [string repeat YWJj 10]" binary decode base64 -strict $s } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.20 {binary decode base64} -body { @@ -2716,11 +2720,11 @@ } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.30 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WFla\n]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.31 {binary decode base64} -body { - list [string length [set r [binary decode base64 WA==WFla]]] $r + list [string length [set r [binary decode base64 -strict WA==WFla]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.32 {binary decode base64, bug [00d04c4f12]} -body { list \ [string length [binary decode base64 =]] \ [string length [binary decode base64 " ="]] \ @@ -2758,10 +2762,13 @@ } } } join $r \n } -result {} +test binary-73.37 {binary decode base64: Bug ffeb2097af} { + binary decode base64 [binary encode base64 -maxlen 3 -wrapchar : abc] +} abc test binary-74.1 {binary encode uuencode} -body { binary encode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-74.2 {binary encode uuencode} -body { @@ -2795,15 +2802,21 @@ } test binary-74.10 {binary encode uuencode} -returnCodes error -body { binary encode uuencode -foo 30 abcabcabc } -result {bad option "-foo": must be -maxlen or -wrapchar} test binary-74.11 {binary encode uuencode} -returnCodes error -body { - binary encode uuencode -maxlen 1 abcabcabc + binary encode uuencode -maxlen 4 abcabcabc } -result {line length out of range} test binary-74.12 {binary encode uuencode} -body { - binary encode uuencode -maxlen 3 -wrapchar | abcabcabc -} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|} + binary encode uuencode -maxlen 5 -wrapchar \t abcabcabc +} -result #86)C\t#86)C\t#86)C\t +test binary-74.13 {binary encode uuencode} -body { + binary encode uuencode -maxlen 85 -wrapchar \t abcabcabc +} -result )86)C86)C86)C\t +test binary-74.14 {binary encode uuencode} -returnCodes error -body { + binary encode uuencode -maxlen 86 abcabcabc +} -result {line length out of range} test binary-75.1 {binary decode uuencode} -body { binary decode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-75.2 {binary decode uuencode} -body { @@ -2841,15 +2854,15 @@ set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r" binary decode uuencode $s } -result [string repeat abc 20] test binary-75.12 {binary decode uuencode} -body { binary decode uuencode -strict "|86)C" -} -returnCodes error -match glob -result {invalid uuencode character "|" at position 0} +} -returnCodes error -match glob -result {invalid uuencode character "|" * at position 0} test binary-75.13 {binary decode uuencode} -body { set s ">[string repeat 86)C 10]|[string repeat 86)C 10]" binary decode uuencode -strict $s -} -returnCodes error -match glob -result {invalid uuencode character "|" at position 41} +} -returnCodes error -match glob -result {invalid uuencode character "|" * at position 41} test binary-75.14 {binary decode uuencode} -body { set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]" binary decode uuencode -strict $s } -returnCodes error -match glob -result {invalid uuencode character *} test binary-75.20 {binary decode uuencode} -body { @@ -2873,11 +2886,11 @@ binary decode uuencode $s } -result ABC test binary-75.25 {binary decode uuencode} -body { set s "#04)\#z" binary decode uuencode $s -} -returnCodes error -match glob -result {invalid uuencode character "z" at position 5} +} -returnCodes error -match glob -result {invalid uuencode character "z" * at position 5} test binary-75.26 {binary decode uuencode} -body { string length [binary decode uuencode " "] } -result 0 test binary-76.1 {binary string appending growth algorithm} unix { @@ -2910,20 +2923,44 @@ return $one[binary format H* $b] }} ab cd } [binary format H* abcd] test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678]} -body { - # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX <= 4): + # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX == 3): binary encode hex \U0001f415 binary scan \U0001f415 a* v; set v set str {} } -result {} + +testConstraint testsetbytearraylength \ + [expr {"testsetbytearraylength" in [info commands]}] + +test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat A B C] 1 +} A +test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat \u0141 B C] 1 +} A + +test binary-80.1 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { + testbytestring "\u4E4E" +} -result "expected byte sequence but character 0 was '\u4E4E' (U+004E4E)" +test binary-80.2 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { + testbytestring [testbytestring "\x00\xA0\xA0\xA0\xE4\xB9\x8E"] +} -result "expected byte sequence but character 4 was '\u4E4E' (U+004E4E)" +test binary-80.3 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { + testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"] +} -result "expected byte sequence but character 4 was '\u4E4E' (U+004E4E)" +test binary-80.4 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { + testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] +} -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" + # ---------------------------------------------------------------------- # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: ADDED tests/case.test Index: tests/case.test ================================================================== --- /dev/null +++ tests/case.test @@ -0,0 +1,94 @@ +# Commands covered: case +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {![llength [info commands case]]} { + # No "case" command? So no need to test + return +} + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* +} + +test case-1.1 {simple pattern} { + case a in a {format 1} b {format 2} c {format 3} default {format 4} +} 1 +test case-1.2 {simple pattern} { + case b a {format 1} b {format 2} c {format 3} default {format 4} +} 2 +test case-1.3 {simple pattern} { + case x in a {format 1} b {format 2} c {format 3} default {format 4} +} 4 +test case-1.4 {simple pattern} { + case x a {format 1} b {format 2} c {format 3} +} {} +test case-1.5 {simple pattern matches many times} { + case b a {format 1} b {format 2} b {format 3} b {format 4} +} 2 +test case-1.6 {fancier pattern} { + case cx a {format 1} *c {format 2} *x {format 3} default {format 4} +} 3 +test case-1.7 {list of patterns} { + case abc in {a b c} {format 1} {def abc ghi} {format 2} +} 2 + +test case-2.1 {error in executed command} { + list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ + $msg $::errorInfo +} {1 {Just a test} {Just a test + while executing +"error "Just a test"" + ("a" arm line 1) + invoked from within +"case a in a {error "Just a test"} default {format 1}"}} +test case-2.2 {error: not enough args} { + list [catch {case} msg] $msg +} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} +test case-2.3 {error: pattern with no body} { + list [catch {case a b} msg] $msg +} {1 {extra case pattern with no body}} +test case-2.4 {error: pattern with no body} { + list [catch {case a in b {format 1} c} msg] $msg +} {1 {extra case pattern with no body}} +test case-2.5 {error in default command} { + list [catch {case foo in a {error case1} default {error case2} \ + b {error case 3}} msg] $msg $::errorInfo +} {1 case2 {case2 + while executing +"error case2" + ("default" arm line 1) + invoked from within +"case foo in a {error case1} default {error case2} b {error case 3}"}} + +test case-3.1 {single-argument form for pattern/command pairs} { + case b in { + a {format 1} + b {format 2} + default {format 6} + } +} {2} +test case-3.2 {single-argument form for pattern/command pairs} { + case b { + a {format 1} + b {format 2} + default {format 6} + } +} {2} +test case-3.3 {single-argument form for pattern/command pairs} { + list [catch {case z in {a 2 b}} msg] $msg +} {1 {extra case pattern with no body}} + +# cleanup +::tcltest::cleanupTests +return Index: tests/chanio.test ================================================================== --- tests/chanio.test +++ tests/chanio.test @@ -41,10 +41,11 @@ testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] + testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] @@ -886,11 +887,11 @@ set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # Tcl_ExternalToUtf() set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none - chan configure $f -encoding unicode + chan configure $f -encoding utf-16 chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 chan gets $f chan configure $f -blocking 0 lappend x [chan gets $f line] $line [testchannel queuedcr $f] @@ -1127,11 +1128,11 @@ chan configure $f -translation lf -encoding ascii -buffering none chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" chan event $f read [namespace code { lappend x [chan gets $f line] $line [testchannel inputbuffered $f] }] - chan configure $f -encoding unicode -buffersize 16 -blocking 0 + chan configure $f -encoding utf-16 -buffersize 16 -blocking 0 vwait [namespace which -variable x] chan configure $f -translation auto -encoding ascii -blocking 1 # here vwait [namespace which -variable x] return $x @@ -1878,11 +1879,11 @@ } -cleanup { chan close $f } -result {{{} {}} {auto lf}} test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { set path(stdout) [makeFile {} stdout] -} -constraints {stdio openpipe} -body { +} -constraints {stdio openpipe knownMsvcBug} -body { set f [open $path(script) w] chan puts -nonewline $f { chan close stdout set f1 [} chan puts $f [list open $path(stdout) w]] @@ -2022,11 +2023,11 @@ chan close $f } -result {0 60 72} test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup { file delete $path(test1) set l "" -} -constraints {unixOrPc} -body { +} -constraints {unixOrWin} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffersize 60 -eofchar {} lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { chan puts $f hello @@ -2721,11 +2722,11 @@ set result "file size only [file size $path(output)]" } else { set result ok } # allow a little time for the background process to chan close. - # otherwise, the following test fails on the [file delete $path(output) + # otherwise, the following test fails on the [file delete $path(output)] # on Windows because a process still has the file open. after 100 set v 1; vwait v return $result } -result ok test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup { @@ -2788,11 +2789,11 @@ proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } -} -constraints {socket tempNotMac fileevent} -body { +} -constraints {socket tempNotMac fileevent knownMsvcBug} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] chan configure $s -blocking off set x accepted @@ -2814,11 +2815,11 @@ chan configure $cs -blocking off writelots $cs $l chan close $cs chan close $ss vwait [namespace which -variable x] - return $c + set c } -result 2000 test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup { catch {interp delete x} catch {interp delete y} } -constraints {socket tempNotMac fileevent} -body { @@ -7030,11 +7031,11 @@ set ::forever has-been-reached }] vwait ::forever catch {after cancel $token} # Report - return $::RES + set ::RES } -cleanup { chan close $f chan close $g catch {unset ::RES} catch {unset ::forever} @@ -7230,11 +7231,11 @@ # completes. set done 0 for {set i 0} {$i < 10} {incr i} { if {![catch { set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]] - }]} then { + }]} { set done 1 break } after 100 } @@ -7302,11 +7303,11 @@ producer vwait [namespace which -variable done] chan close $writer chan close $s after cancel $after - return $counter + set counter } -cleanup { if {$accept ne {}} {chan close $accept} } -result 1 set path(fooBar) [makeFile {} fooBar] @@ -7329,11 +7330,11 @@ } -body { set f [open $path(fooBar) w] chan event $f writable [namespace code [list eventScript $f]] variable x not_done vwait [namespace which -variable x] - return $x + set x } -cleanup { interp bgerror {} $handler } -result {got_error} test chan-io-56.1 {ChannelTimerProc} {testchannelevent} { @@ -7374,11 +7375,11 @@ variable result [chan gets $s2] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan gets $s2] vwait [namespace which -variable result] - return $result + set result } -cleanup { chan close $s chan close $s2 chan close $server } -result {12 readable 34567890 timer} @@ -7399,18 +7400,18 @@ variable result [chan read $s2 1] after 1000 [namespace code {lappend result timer}] vwait [namespace which -variable result] lappend result [chan read $s2 9] vwait [namespace which -variable result] - return $result + set result } -cleanup { chan close $s chan close $s2 chan close $server } -result {1 readable 234567890 timer} -test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} { +test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] chan puts $out { chan puts "normal message from pipe" chan puts stderr "error message from pipe" exit 1 Index: tests/clock.test ================================================================== --- tests/clock.test +++ tests/clock.test @@ -248,21 +248,10 @@ return -code error "test case attempts to read unknown registry entry $path $key" } return [dict get $reg $path $key] } -proc timeWithinDuration {duration start end} { - regexp {([\d.]+)(s|ms|us)} $duration -> duration unit - if {[llength $start] > 1} { set start [expr "([join $start +])/[llength $start]"] } - if {[llength $end] > 1} { set end [expr "([join $end +])/[llength $end]"] } - set delta [expr {$end - $start}] - expr { - ($delta > 0) && ($delta <= $duration) ? - "ok" : - "test should have taken 0-$duration $unit, actually took $delta"} -} - # Test some of the basics of [clock format] test clock-1.0 "clock format - wrong # args" { list [catch {clock format} msg] $msg $::errorCode @@ -35034,10 +35023,28 @@ set x2 [clock format $f2 -format %Y-%m-%d -timezone :UTC] set x3 [clock format $f3 -format %Y-%m-%d -timezone :UTC] set x4 [clock format $f4 -format %Y-%m-%d -timezone :UTC] list $x1 $x2 $x3 $x4 } {2000-02-29 2000-01-31 1999-12-31 1999-11-30} +test clock-30.8a {clock add months, negative, over threshold of a year} { + set t [clock scan 2019-01-31 -format %Y-%m-%d -gmt 1] + list [clock format [clock add $t -1 month -gmt 1] -format %Y-%m-%d -gmt 1] \ + [clock format [clock add $t -2 month -gmt 1] -format %Y-%m-%d -gmt 1] \ + [clock format [clock add $t -3 month -gmt 1] -format %Y-%m-%d -gmt 1] \ + [clock format [clock add $t -4 month -gmt 1] -format %Y-%m-%d -gmt 1] +} {2018-12-31 2018-11-30 2018-10-31 2018-09-30} +test clock-30.8b {clock add months, negative, over threshold of a year} { + set t [clock scan 2000-01-28 -format %Y-%m-%d -gmt 1] + for {set i 1} {$i < 24} {incr i 1} { + set f1 [clock add $t -$i month -gmt 1] + set f2 [clock add $f1 $i month -gmt 1] + if {$f2 != $t} { + error "\[clock add $t -$i month -gmt 1\] does not consider\ + \[clock add $f1 $i month -gmt 1\] != $t" + } + } +} {} test clock-30.9 {clock add days} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] set f1 [clock add $t 1 day -timezone :UTC] set f2 [clock add $t -1 day -timezone :UTC] @@ -35449,52 +35456,72 @@ test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} test clock-33.5 {clock clicks tests, millisecond timing test} { - set start [set end {}] - lassign [time { - lappend start [clock clicks -milli] - after 1 {lappend end [clock clicks -milli]} - vwait end - } 5] tm - timeWithinDuration [expr {int($tm/1000 + 1)}]ms $start $end + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. + if {[lindex [timerate { + set start [clock clicks -milli] + timerate {} 10; # short but precise busy wait + set end [clock clicks -milli] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } + # 60 msecs seems to be the max time slice under Windows 95/98 + expr { + ($end > $start) && (($end - $start) <= 60) ? + "ok" : + "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { - set start [set end {}] - lassign [time { - lappend start [clock milliseconds] - after 1 {lappend end [clock milliseconds]} - vwait end - } 5] tm - timeWithinDuration [expr {int($tm/1000 + 1)}]ms $start $end + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. + if {[lindex [timerate { + set start [clock milliseconds] + timerate {} 10; # short but precise busy wait + set end [clock milliseconds] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } + # 60 msecs seems to be the max time slice under Windows 95/98 + expr { + ($end > $start) && (($end - $start) <= 60) ? + "ok" : + "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks ? } msg] $msg } {1 {bad option "?": must be -milliseconds or -microseconds}} test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg] $msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} test clock-33.8 {clock clicks test, microsecond timing test} { - set start [set end {}] - lassign [time { - lappend start [clock clicks -micro] - after 1 {lappend end [clock clicks -micro]} - vwait end - } 5] tm - timeWithinDuration [expr {int($tm + 10)}]us $start $end -} {ok} + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. + if {[lindex [timerate { + set start [clock clicks -micro] + timerate {} 10; # short but precise busy wait + set end [clock clicks -micro] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } + expr {($end > $start) && (($end - $start) <= 60000)} +} {1} test clock-33.8a {clock test, microsecond timing test} { - set start [set end {}] - lassign [time { - lappend start [clock microseconds] - after 1 {lappend end [clock microseconds]} - vwait end - } 5] tm - timeWithinDuration [expr {int($tm + 10)}]us $start $end -} {ok} + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. + if {[lindex [timerate { + set start [clock microseconds] + timerate {} 10; # short but precise busy wait + set end [clock microseconds] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } + expr {($end > $start) && (($end - $start) <= 60000)} +} {1} test clock-33.9 {clock clicks test, millis align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock clicks -millis] Index: tests/cmdAH.test ================================================================== --- tests/cmdAH.test +++ tests/cmdAH.test @@ -19,10 +19,14 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] +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 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] @@ -56,10 +60,12 @@ break foo } -returnCodes error -result {wrong # args: should be "break"} test cmdAH-0.2 {Tcl_BreakObjCmd, success} { list [catch {break} msg] $msg } {3 {}} + +# Tcl_CaseObjCmd is tested in case.test test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body { catch } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} test cmdAH-1.2 {Tcl_CatchObjCmd, errors} { @@ -884,11 +890,11 @@ # file to be executable. testchmod 0o775 $gorpfile file exe $gorpfile } 1 test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body { - # On pc, must be a .exe, .com, etc. + # On windows, must be a .exe, .com, etc. set x {} set gorpexes {} foreach ext {exe com cmd bat} { lappend x [file exe nosuchfile.$ext] set gorpexe [makeFile foo gorp.$ext] @@ -1286,16 +1292,52 @@ Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension) } -constraints {win} -body { file mtime [file join [temporaryDirectory] CON.txt] } -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]} -constraints {time64bit} -setup { + set filename [makeFile "" foo.text] +} -body { + list [file atime $filename 3155760000] [file atime $filename] +} -cleanup { + removeFile $filename +} -result {3155760000 3155760000} +test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { + set filename [makeFile "" foo.text] +} -body { + list [file mtime $filename 3155760000] [file mtime $filename] +} -cleanup { + file delete -force $filename +} -result {3155760000 3155760000} + # owned test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body { file owned a b } -result {wrong # args: should be "file owned name"} -test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body { - file owned $gorpfile +test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup { + set fn $gorpfile + # prefer temp file to check owner (try to avoid bug [7de2d722bd]): + if { + [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] && + [file dirname $fn] ne [file normalize $::env(TEMP)] + } { + set fn [file join $::env(TEMP)/test-owner-from-tcl.txt] + set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)] + } + # be sure we have really owned this file before trying to check that + # (avoid dependency on admin with UAC and the setting "System objects: + # Default owner for objects created by members of the Administrators group"): + catch { + exec takeown /F [file nativename $fn] + } +} -body { + file owned $fn +} -cleanup { + if {$fn ne $gorpfile} { + removeFile $fn + } } -result 1 test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { # Avoid problems with AFS set tmpfile [makeFile "data" touch.me /tmp] } -body { @@ -1305,11 +1347,15 @@ } -result 1 test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { file owned / } 0 test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body { - file owned $env(windir) + if {[info exists env(SystemRoot)]} { + file owned $env(SystemRoot) + } else { + file owned $env(windir) + } } -result 0 test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body { file owned nosuchfile } -result 0 Index: tests/cmdIL.test ================================================================== --- tests/cmdIL.test +++ tests/cmdIL.test @@ -17,10 +17,12 @@ catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] +source [file join [file dirname [info script]] internals.tcl] +namespace import -force ::tcltest::internals::* test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { @@ -159,14 +161,14 @@ test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff] } [list \0 \x7f \x80 \uffff \U01ffff] test cmdIL-1.41 {lsort -stride and -index} -body { lsort -stride 2 -index -2 {a 2 b 1} -} -returnCodes error -result {index "-2" cannot select an element from any list} +} -returnCodes error -result {index "-2" out of range} test cmdIL-1.42 {lsort -stride and-index} -body { lsort -stride 2 -index -1-1 {a 2 b 1} -} -returnCodes error -result {index "-1-1" cannot select an element from any list} +} -returnCodes error -result {index "-1-1" out of range} # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup { @@ -224,14 +226,14 @@ test cmdIL-3.5.1 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index 1+3 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {element 4 missing from sublist "1 . c"} test cmdIL-3.5.2 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index -1-1 {{1 . c} {2 . b} {3 . a}} -} -returnCodes error -result {index "-1-1" cannot select an element from any list} +} -returnCodes error -result {index "-1-1" out of range} test cmdIL-3.5.3 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index -2 {{1 . c} {2 . b} {3 . a}} -} -returnCodes error -result {index "-2" cannot select an element from any list} +} -returnCodes error -result {index "-2" out of range} test cmdIL-3.5.4 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end-4 {{1 . c} {2 . b} {3 . a}} } -returnCodes error -result {element end-4 missing from sublist "1 . c"} test cmdIL-3.5.5 {SortCompare procedure, -index option} { lsort -index {} {a b} @@ -239,17 +241,17 @@ test cmdIL-3.5.6 {SortCompare procedure, -index option} { lsort -index {} [list a \{] } {a \{} test cmdIL-3.5.7 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end--1 {{1 . c} {2 . b} {3 . a}} -} -returnCodes error -result {index "end--1" cannot select an element from any list} +} -returnCodes error -result {index "end--1" out of range} test cmdIL-3.5.8 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end+1 {{1 . c} {2 . b} {3 . a}} -} -returnCodes error -result {index "end+1" cannot select an element from any list} +} -returnCodes error -result {index "end+1" out of range} test cmdIL-3.5.9 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index end+2 {{1 . c} {2 . b} {3 . a}} -} -returnCodes error -result {index "end+2" cannot select an element from any list} +} -returnCodes error -result {index "end+2" out of range} test cmdIL-3.5.10 {SortCompare procedure, -index option (out of range, calculated index)} -body { lsort -index 0 {{}} } -returnCodes error -result {element 0 missing from sublist ""} test cmdIL-3.6 {SortCompare procedure, -index option} { lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}} @@ -517,10 +519,25 @@ rename test_lsort "" } test cmdIL-5.6 {lsort with multiple list-style index options} { lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} } {{a b} {b e} {c d}} +test cmdIL-5.7 {lsort memory exhaustion} -constraints {testWithLimit} -body { + # test it in child process (with limited address space) ca. 80MB extra memory + # on x64 system it would be not enough to sort 4M items (the half 2M only), + # warn and skip if no error (enough memory) or error by list creation: + testWithLimit \ + -warn-on-code 0 -warn-on-alloc-error 1 \ + -addmem [expr {$tcl_platform(pointerSize)*4000000 + $tcl_platform(pointerSize)*3*2000000}] \ + { + # create list and get length (avoid too long output in interactive shells): + llength [set l [lrepeat 4000000 ""]] + # test OOM: + llength [lsort $l] + } + # expecting error no memory by sort +} -returnCodes 1 -result {no enough memory to proccess sort of 4000000 items} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { apply {{} { lassign }} } -result {wrong # args: should be "lassign list ?varName ...?"} Index: tests/cmdMZ.test ================================================================== --- tests/cmdMZ.test +++ tests/cmdMZ.test @@ -20,10 +20,11 @@ namespace import ::tcltest::cleanupTests namespace import ::tcltest::customMatch namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::temporaryDirectory + namespace import ::tcltest::testConstraint namespace import ::tcltest::test proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 @@ -225,16 +226,16 @@ # Tcl_SourceObjCmd # More tests of Tcl_SourceObjCmd are in source.test test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints { - unixOrPc + unixOrWin } -returnCodes error -body { source } -match glob -result {wrong # args: should be "source*fileName"} test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints { - unixOrPc + unixOrWin } -returnCodes error -body { source a b c d e f } -match glob -result {wrong # args: should be "source*fileName"} test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body { set file [makeFile { @@ -319,12 +320,16 @@ # todo: rewrite this if monotonic clock is provided resp. command "after" # gets microsecond accuracy (RFE [fdfbd5e10] gets merged): proc _nrt_sleep {msec} { set usec [expr {$msec * 1000}] set stime [clock microseconds] - while {abs([clock microseconds] - $stime) < $usec} {after 0} + while {abs([clock microseconds] - $stime) < $usec} { + # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise): + # after 0 + } } +_nrt_sleep 0; # warm up (clock, compile, etc) test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body { time } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body { @@ -337,20 +342,42 @@ time bogusCmd -12456 } {0 microseconds per iteration} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} -test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { - expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} -} 1 +test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} -body { + set m1 [lindex [time {_nrt_sleep 0.01}] 0] + set m2 [lindex [time {_nrt_sleep 10.0}] 0] + list \ + [expr {$m1 < $m2}] \ + $m1 $m2; # interesting only in error case. +} -match glob -result [list 1 *] test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "time {error foo}"}} +test cmdMZ-5.7.1 {Tcl_TimeObjCmd: return from time} { + set x 0 + proc r1 {} {upvar x x; time {incr x; return "r1"; incr x} 10} + list [r1] $x +} {r1 1} +test cmdMZ-5.8 {Tcl_TimeObjCmd: done optimization: nested call of self inside time (if compiled)} { + set x [set y 0] + set m1 { + if {[incr x] <= 5} { + # nested call should return result, so covering that: + if {![string is integer -strict [eval $m1]]} {error unexpected} + } + # increase again (no "continue" from nested call): + incr x + } + time {incr y; eval $m1} 5 + list $y $x +} {5 20} test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate} msg] $msg } {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}} test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} { @@ -372,66 +399,87 @@ regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0] } 1 test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 -test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { - set m1 [timerate {_nrt_sleep 0} 20] - set m2 [timerate {_nrt_sleep 0.2} 20] - list \ +test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} -body { + set m1 [timerate {_nrt_sleep 0.01} 50] + set m2 [timerate {_nrt_sleep 1.00} 50] + list [list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ - [expr {[lindex $m1 2] > 1000}] \ - [expr {[lindex $m2 2] < 1000}] \ - [expr {[lindex $m1 4] > 50000}] \ - [expr {[lindex $m2 4] < 50000}] \ - [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \ - [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}] -} [lrepeat 9 1] + [expr {[lindex $m1 2] > 500}] \ + [expr {[lindex $m2 2] < 500}] \ + [expr {[lindex $m1 4] > 10000}] \ + [expr {[lindex $m2 4] < 10000}] \ + [expr {[lindex $m1 6] > 5 && [lindex $m1 6] < 100}] \ + [expr {[lindex $m2 6] > 5 && [lindex $m2 6] < 100}] \ + ] $m1 $m2; # interesting only in error case. +} -match glob -result [list [lrepeat 9 1] *] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "timerate {error foo} 1"}} -test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { +test cmdMZ-6.7.1 {Tcl_TimeRateObjCmd: return from timerate} { + set x 0 + proc r1 {} {upvar x x; timerate {incr x; return "r1"; incr x} 1000 10} + list [r1] $x +} {r1 1} +test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} -body { set m1 [timerate {break}] - list \ + list [list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ - [expr {[lindex $m1 6] < 10}] -} {1 1 1 1} -test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} { + [expr {[lindex $m1 6] < 10}] \ + ] $m1; # interesting only in error case. +} -match glob -result [list {1 1 1 1} *] +test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} -body { set m1 [timerate {continue; return -code error "unexpected"} 1000 10] - list \ - [expr {[lindex $m1 0] < 1000}] \ - [expr {[lindex $m1 2] == 10}] \ - [expr {[lindex $m1 4] > 1000}] \ - [expr {[lindex $m1 6] < 100}] -} {1 1 1 1} + list [list \ + [expr {[lindex $m1 0] < 1000}] \ + [expr {[lindex $m1 2] == 10}] \ + [expr {[lindex $m1 4] > 1000}] \ + [expr {[lindex $m1 6] < 100}] \ + ] $m1; # interesting only in error case. +} -match glob -result [list {1 1 1 1} *] test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} -test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { +test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} -body { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] - list \ + list [list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ - [expr {[lindex $m1 6] <= 0.001}] -} {1 1 1 1} + [expr {[lindex $m1 6] <= 0.001}] \ + ] $m1; # interesting only in error case. +} -match glob -result [list {1 1 1 1} *] test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} { set m1 {set m2 ok} if 1 $m1 timerate $m1 1000 10 if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop } ok +test cmdMZ-6.12 {Tcl_TimeRateObjCmd: done optimization: nested call of self inside timerate} { + set x 0 + set m1 { + if {[incr x] <= 5} { + # nested call should return result, so covering that: + if {![string is integer -strict [eval $m1]]} {error unexpected} + } + # increase again (no "continue" from nested call): + incr x + } + list [lindex [timerate $m1 1000 5] 2] $x +} {5 20} test cmdMZ-try-1.0 { fix for issue 45b9faf103f2 Index: tests/compExpr-old.test ================================================================== --- tests/compExpr-old.test +++ tests/compExpr-old.test @@ -16,10 +16,11 @@ package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues @@ -276,14 +277,14 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2^x } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of "^"}} +} {1 {can't use floating-point value as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "^"}} +} {1 {can't use non-numeric string as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1 test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0 @@ -300,14 +301,14 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { expr 2&x } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of "&"}} +} {1 {can't use floating-point value as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "&"}} +} {1 {can't use non-numeric string as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1 test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0 @@ -361,14 +362,14 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { expr 2<>43}} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of ">>"}} +} {1 {can't use floating-point value as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "<<"}} +} {1 {can't use non-numeric string as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1 test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6 @@ -383,14 +384,14 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { expr 2-x } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} test compExpr-old-11.13a {CompileAddExpr: runtime error} ieeeFloatingPoint { list [catch {expr {2.3/0.0}} msg] $msg @@ -414,14 +415,14 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*x } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "*"}} +} {1 {can't use non-numeric string as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "/"}} +} {1 {can't use non-numeric string as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36 test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0 @@ -435,14 +436,14 @@ expr !1.x set msg } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "~"}} +} {1 {can't use non-numeric string as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value "4.0" as operand of "~"}} +} {1 {can't use floating-point value as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 expr $a } 27 @@ -586,11 +587,10 @@ while *ing "expr pow(1)"} test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * - test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} set a(VALUE) ff15 set i 123 if {[expr 0x$a(VALUE)] & 16} { Index: tests/compExpr.test ================================================================== --- tests/compExpr.test +++ tests/compExpr.test @@ -12,10 +12,11 @@ package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] # Constrain memory leak tests testConstraint memory [llength [info commands memory]] catch {unset a} Index: tests/compile.test ================================================================== --- tests/compile.test +++ tests/compile.test @@ -321,11 +321,11 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a bogus }} } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} -} -returnCodes error -match glob -result {*} +} -returnCodes error -match glob -result {*invalid octal number*} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; array set var {one two many} }} } -returnCodes error -result {list must have an even number of elements} test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; incr foo bar baz}} @@ -463,10 +463,71 @@ } append body {]; puts OK} regsub BODY {proc crash {} {BODY}; crash} $body script list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} + +# Tests of nested compile (body in body compilation), should not generate stack overflow +# (with abnormal program termination), bug [fec0c17d39]: +proc _ti_gencode {} { + # creates test interpreter on demand with [gencode] generator: + if {[interp exists ti]} { + return + } + interp create ti + ti eval {proc gencode {nr {cmd eval} {nl 0}} { + set code "" + set e ""; if {$nl} {set e "\n"} + for {set i 0} {$i < $nr} {incr i} { + append code "$cmd \{$e" + } + append code "lappend result 1$e" + for {set i 0} {$i < $nr} {incr i} { + append code "\}$e" + } + #puts [format "%% %.40s ... %d bytes" $code [string length $code]] + return $code + }} +} +test compile-13.2 {TclCompileScript: testing expected nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti [expr {10000+50}] + ti eval {set result {}} +} -body { + # Test different compilation variants (instructions evalStk, invokeStk, etc), + # with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack + # boxes or systems, please don't decrease it (either provide a constraint) + ti eval {foreach cmd {eval "if 1" try catch} { + set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd] + if 1 $c + }} + ti eval {set result} +} -result {1 1 1 1} +test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti 100 + ti eval {set result {}} +} -body { + # Test different compilation variants (instructions evalStk, invokeStk, etc), + # with 500 nested scripts (bodies). It must generate "too many nested compilations" + # error for any variant we're testing here: + ti eval {foreach cmd {eval "if 1" try catch} { + set c [gencode 500 $cmd] + lappend errors [catch $c e] $e + }} + #puts $errors + # all of nested calls exceed the limit, so must end with "too many nested compilations" + # (or evaluations, depending on compile method/instruction and "mixed" compile within + # evaliation), so no one succeeds, the result must be empty: + ti eval {set result} +} -result {} +# +# clean up: +if {[interp exists ti]} { + interp delete ti +} +rename _ti_gencode {} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 catch {set bubba([join $abba $jubba]) $vol} msg2 Index: tests/dstring.test ================================================================== --- tests/dstring.test +++ tests/dstring.test @@ -178,20 +178,41 @@ testdstring element # testdstring get } -cleanup { testdstring free } -result {x #} -test dstring-2.13 {appending list elements} -constraints testdstring -body { - # This test shows lack of sophistication in Tcl_DStringAppendElement's - # decision about whether #-quoting can be disabled. +test dstring-2.13 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { + # This test checks the sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. testdstring append "x " -1 testdstring element # testdstring get } -cleanup { testdstring free -} -result {x {#}} +} -result {x #} +test dstring-2.14 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { + testdstring append " " -1 + testdstring element # + testdstring get +} -cleanup { + testdstring free +} -result { {#}} +test dstring-2.15 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { + # This test checks the sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. + testdstring append "x " -1 + testdstring element # + testdstring get +} -cleanup { + testdstring free +} -result {x #} test dstring-3.1 {nested sublists} -constraints testdstring -setup { testdstring free } -body { testdstring start @@ -304,23 +325,50 @@ testdstring end testdstring get } -cleanup { testdstring free } -result {x {x #}} -test dstring-3.10 {appending list elements} -constraints testdstring -body { - # This test shows lack of sophistication in Tcl_DStringAppendElement's - # decision about whether #-quoting can be disabled. +test dstring-3.10 {appending list elements} -constraints testdstring -setup { testdstring free +} -body { + # This test checks the sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. testdstring append x -1 testdstring start testdstring append "x " -1 testdstring element # testdstring end testdstring get } -cleanup { testdstring free -} -result {x {x {#}}} +} -result {x {x #}} +test dstring-3.11 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { + testdstring append x -1 + testdstring start + testdstring append " " -1 + testdstring element # + testdstring end + testdstring get +} -cleanup { + testdstring free +} -result {x { {#}}} +test dstring-3.12 {appending list elements} -constraints testdstring -setup { + testdstring free +} -body { + # This test checks the sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. + testdstring append x -1 + testdstring start + testdstring append "x " -1 + testdstring element # + testdstring end + testdstring get +} -cleanup { + testdstring free +} -result {x {x #}} test dstring-4.1 {truncation} -constraints testdstring -setup { testdstring free } -body { testdstring append "abcdefg" -1 Index: tests/encoding.test ================================================================== --- tests/encoding.test +++ tests/encoding.test @@ -281,20 +281,20 @@ } -result {invalid encoding file "splat"} # OpenEncodingFile is fully tested by the rest of the tests in this file. test encoding-12.1 {LoadTableEncoding: normal encoding} { - set x [encoding convertto iso8859-3 \u120] - append x [encoding convertto iso8859-3 \ud5] - append x [encoding convertfrom iso8859-3 \xd5] + set x [encoding convertto iso8859-3 \u0120] + append x [encoding convertto iso8859-3 \xD5] + append x [encoding convertfrom iso8859-3 \xD5] } "\xd5?\u120" test encoding-12.2 {LoadTableEncoding: single-byte encoding} { set x [encoding convertto iso8859-3 ab\u0120g] - append x [encoding convertfrom iso8859-3 ab\xd5g] + append x [encoding convertfrom iso8859-3 ab\xD5g] } "ab\xd5gab\u120g" test encoding-12.3 {LoadTableEncoding: multi-byte encoding} { - set x [encoding convertto shiftjis ab\u4e4eg] + set x [encoding convertto shiftjis ab\u4E4Eg] append x [encoding convertfrom shiftjis ab\x8c\xc1g] } "ab\x8c\xc1gab\u4e4eg" test encoding-12.4 {LoadTableEncoding: double-byte encoding} { set x [encoding convertto jis0208 \u4e4e\u3b1] append x [encoding convertfrom jis0208 8C&A] @@ -319,23 +319,125 @@ test encoding-15.3 {UtfToUtfProc null character input} teststringbytes { set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]] binary scan [teststringbytes $y] H* z set z } c080 - -test encoding-16.1 {UnicodeToUtfProc} -body { - set val [encoding convertfrom unicode NN] - list $val [format %x [scan $val %c]] -} -result "\u4e4e 4e4e" -test encoding-16.2 {UnicodeToUtfProc} -body { - set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"] - list $val [format %x [scan $val %c]] -} -result "\U460dc 460dc" - -test encoding-17.1 {UtfToUnicodeProc} -body { - encoding convertto unicode "\U460dc" -} -result "\xd8\xd8\xdc\xdc" +test encoding-15.4 {UtfToUtfProc emoji character input} -body { + set x \xED\xA0\xBD\xED\xB8\x82 + set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82] + list [string length $x] $y +} -result "6 \U1F602" +test encoding-15.5 {UtfToUtfProc emoji character input} { + set x \xF0\x9F\x98\x82 + set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82] + list [string length $x] $y +} "4 \U1F602" +test encoding-15.6 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\uDE02\uD83D + set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D] + binary scan $y H* z + list [string length $y] $z +} {10 edb882f09f9882eda0bd} +test encoding-15.7 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\uD83D + set y [encoding convertto utf-8 \uDE02\uD83D\uD83D] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 9 edb882eda0bdeda0bd} +test encoding-15.8 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\xE9 + set y [encoding convertto utf-8 \uDE02\uD83D\xE9] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 8 edb882eda0bdc3a9} +test encoding-15.9 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83DX + set y [encoding convertto utf-8 \uDE02\uD83DX] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 7 edb882eda0bd58} +test encoding-15.10 {UtfToUtfProc high surrogate character output} { + set x \uDE02\xE9 + set y [encoding convertto utf-8 \uDE02\xE9] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {2 5 edb882c3a9} +test encoding-15.11 {UtfToUtfProc low surrogate character output} { + set x \uDA02\xE9 + set y [encoding convertto utf-8 \uDA02\xE9] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {2 5 eda882c3a9} +test encoding-15.12 {UtfToUtfProc high surrogate character output} { + set x \uDE02Y + set y [encoding convertto utf-8 \uDE02Y] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {2 4 edb88259} +test encoding-15.13 {UtfToUtfProc low surrogate character output} { + set x \uDA02Y + set y [encoding convertto utf-8 \uDA02Y] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {2 4 eda88259} +test encoding-15.14 {UtfToUtfProc high surrogate character output} { + set x \uDE02 + set y [encoding convertto utf-8 \uDE02] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {1 3 edb882} +test encoding-15.15 {UtfToUtfProc low surrogate character output} { + set x \uDA02 + set y [encoding convertto utf-8 \uDA02] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {1 3 eda882} +test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} { + set x \xF0\xA0\xA1\xC2 + set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2] + list [string length $x] $y +} "4 \xF0\xA0\xA1\xC2" +test encoding-15.17 {UtfToUtfProc emoji character output} { + set x \U1F602 + set y [encoding convertto utf-8 \U1F602] + binary scan $y H* z + list [string length $y] $z +} {4 f09f9882} + +test encoding-16.1 {Utf16ToUtfProc} -body { + set val [encoding convertfrom utf-16 NN] + list $val [format %x [scan $val %c]] +} -result "\u4E4E 4e4e" +test encoding-16.2 {Utf16ToUtfProc} -body { + set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"] + list $val [format %x [scan $val %c]] +} -result "\U460DC 460dc" +test encoding-16.3 {Utf16ToUtfProc} -body { + set val [encoding convertfrom utf-16 "\xDC\xDC"] + list $val [format %x [scan $val %c]] +} -result "\uDCDC dcdc" +test encoding-16.4 {Ucs2ToUtfProc} -body { + set val [encoding convertfrom ucs-2 NN] + list $val [format %x [scan $val %c]] +} -result "\u4E4E 4e4e" +test encoding-16.4 {Ucs2ToUtfProc} -body { + set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"] + list $val [format %x [scan $val %c]] +} -result "\U460DC 460dc" + +test encoding-17.1 {UtfToUtf16Proc} -body { + encoding convertto utf-16 "\U460DC" +} -result "\xD8\xD8\xDC\xDC" +test encoding-17.2 {UtfToUtf16Proc} -body { + encoding convertto utf-16 "\uDCDC" +} -result "\xDC\xDC" +test encoding-17.3 {UtfToUtf16Proc} -body { + encoding convertto utf-16 "\uD8D8" +} -result "\xD8\xD8" +test encoding-17.4 {UtfToUcs2Proc} -body { + encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"] +} -result "\uFFFD" test encoding-18.1 {TableToUtfProc} { } {} test encoding-19.1 {TableFromUtfProc} { @@ -618,10 +720,25 @@ test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body { encoding dirs "\{not a list" } -result "expected directory list but got \"\{not a list\"" } + + +test encoding-28.0 {all encodings load} -body { + set string hello + foreach name [encoding names] { + incr count + encoding convertto $name $string + + # discard the cached internal representation of Tcl_Encoding + # Unfortunately, without this, encoding 2-1 fails. + llength $name + } + return $count +} -result [expr {[info exists ::tcl_precision] ? 86 : 85}] + runtests } # cleanup Index: tests/env.test ================================================================== --- tests/env.test +++ tests/env.test @@ -217,10 +217,30 @@ } -cleanup { cleanup1 } -result {NAME1=test string NAME2=more XYZZY=garbage} +test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup { + # be sure set of (unicode) environment occurs if single-byte encoding is used: + encodingswitch cp1252 + # german (cp1252) and russian (cp1251) characters together encoded as utf-8: + set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d + set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]] + # now switch to utf-8 (to see correct values from test): + encoding system utf-8 +} -body { + exec [interpreter] << [string map [list \$val $val] { + encoding system utf-8; fconfigure stdout -encoding utf-8 + set test [encoding convertfrom utf-8 [binary decode hex $val]] + puts "[expr {$env(XYZZY) eq $test}] \ngot:\t\ + $env(XYZZY) ([binary encode hex [encoding convertto $env(XYZZY)]]) \nexp:\t\ + $test ([binary encode hex [encoding convertto $test]])" + }] +} -cleanup { + encodingrestore + unset -nocomplain val f env(XYZZY) +} -match glob -result {1 *} test env-3.1 { changing environment variables } -constraints exec -setup setup2 -body { set result [getenv] Index: tests/exec.test ================================================================== --- tests/exec.test +++ tests/exec.test @@ -22,10 +22,12 @@ package require tcltests # All tests require the "exec" command. # Skip them if exec is not defined. testConstraint exec [llength [info commands exec]] +testConstraint noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}] + unset -nocomplain path # Utilities that are like bourne shell stalwarts, but cross-platform. set path(echo) [makeFile { puts -nonewline [lindex $argv 0] @@ -667,11 +669,11 @@ } -result contents # Note that this test cannot be adapted to work on Windows; that platform has # no kernel support for an analog of O_APPEND. OTOH, that means we can assume # that there is a POSIX shell... -test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind} -setup { +test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosx} -setup { set tmpfile [makeFile {0} tmpfile.exec-19.1] } -body { # Note that we have to allow for the current contents of the temporary # file, which is why the result is 14 and not 12 exec /bin/sh -c \ Index: tests/execute.test ================================================================== --- tests/execute.test +++ tests/execute.test @@ -35,10 +35,15 @@ }] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] + +if {[namespace which -command testbumpinterpepoch] eq ""} { + proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } +} + # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested # INST_PUSH1 not tested # INST_PUSH4 not tested @@ -172,11 +177,11 @@ expr {$x + 1} } 2.0 test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} } 2 test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} { @@ -197,11 +202,11 @@ expr {1 + $x} } 2.0 test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { set x [testintobj set 0 1] expr {$x - 1} @@ -224,11 +229,11 @@ expr {$x - 1} } 0.0 test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} } 0 test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} { @@ -249,11 +254,11 @@ expr {1 - $x} } 0.0 test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { set x [testintobj set 1 1] expr {$x * 1} @@ -276,11 +281,11 @@ expr {$x * 1} } 1.0 test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "*"}} +} {1 {can't use non-numeric string as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} } 1 test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} { @@ -301,11 +306,11 @@ expr {1 * $x} } 1.0 test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "*"}} +} {1 {can't use non-numeric string as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { set x [testintobj set 1 1] expr {$x / 1} @@ -328,11 +333,11 @@ expr {$x / 1} } 1.0 test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "/"}} +} {1 {can't use non-numeric string as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} } 2 test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} { @@ -353,11 +358,11 @@ expr {2 / $x} } 2.0 test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "/"}} +} {1 {can't use non-numeric string as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { set x [testintobj set 1 1] expr {+ $x} @@ -380,11 +385,11 @@ expr {+ $x} } 1.0 test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { set x [testintobj set 1 1] expr {- $x} @@ -407,11 +412,11 @@ expr {- $x} } -1.0 test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { set x [testintobj set 1 2] expr {! $x} @@ -455,11 +460,15 @@ expr {! $x} } 1 test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg -} {1 {can't use non-numeric string "foo" as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} + +# INST_BITNOT not tested +# INST_CALL_BUILTIN_FUNC1 not tested +# INST_CALL_FUNC1 not tested # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { set x [testintobj set 1 1] expr {$x} @@ -927,12 +936,11 @@ # evaluation set arglst [string repeat "a " 1000] proc f {args} "f $arglst" proc run {} { # bump the interp's epoch - rename ::set ::dummy - rename ::dummy ::set + testbumpinterpepoch catch f msg set msg } run } -cleanup { @@ -942,12 +950,11 @@ proc foo {} { error bar } proc FOO {} { catch {error bar} m o - rename ::set ::dummy - rename ::dummy ::set + testbumpinterpepoch return -options $o $m } } -body { catch foo m o set stack1 [dict get $o -errorinfo] @@ -972,14 +979,84 @@ while executing "error FOO" invoked from within "catch \[list error FOO\] m o"} -errorline 2} +test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup { + interp create slave + slave eval { + package require tcltest + catch [list package require -exact Tcltest [info patchlevel]] + ::tcltest::loadTestedCommands + if {[namespace which -command testbumpinterpepoch] eq ""} { + proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } + } + } +} -body { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; + } + slave eval { + set i 0; while {[incr i] < 3} { + lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C; + } + } + slave eval { + set i 0; while {[incr i] < 3} { + lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; + } + } + slave eval { + catch { + lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; + } + } + slave eval {set res} +} -cleanup { + interp delete slave +} -result [lrepeat 4 A B] +test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup { + interp create slave + slave eval { + package require tcltest + catch [list package require -exact Tcltest [info patchlevel]] + ::tcltest::loadTestedCommands + if {[namespace which -command testbumpinterpepoch] eq ""} { + proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set } + } + } +} -body { + set res {} + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C; + } + } e] $e + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C; + } + } e] $e + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C; + } + } e] $e + lappend res [catch { + slave eval { + lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C; + } + } e] $e + list $res [slave eval {set res}] +} -cleanup { + interp delete slave +} -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]] + test execute-9.1 {Interp result resetting [Bug 1522803]} { set c 0 catch { - catch {set foo} + catch {error foo} expr {1/$c} } if {[string match *foo* $::errorInfo]} { set result "Bad errorInfo: $::errorInfo" } else { @@ -1010,10 +1087,11 @@ } } proc t {args} { incr ::foo } + set ::foo 0 trace add execution ::generate enterstep ::t } -body { coroutine coro generate 5 trace remove execution ::generate enterstep ::t set ::foo Index: tests/expr-old.test ================================================================== --- tests/expr-old.test +++ tests/expr-old.test @@ -190,38 +190,38 @@ # Operators that aren't legal on floating-point numbers test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value "4.0" as operand of "~"}} +} {1 {can't use floating-point value as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg -} {1 {can't use floating-point value "4.0" as operand of "%"}} +} {1 {can't use floating-point value as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg -} {1 {can't use floating-point value "27.0" as operand of "%"}} +} {1 {can't use floating-point value as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg -} {1 {can't use floating-point value "1.0" as operand of "<<"}} +} {1 {can't use floating-point value as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg -} {1 {can't use floating-point value "1.0" as operand of "<<"}} +} {1 {can't use floating-point value as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of ">>"}} +} {1 {can't use floating-point value as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg -} {1 {can't use floating-point value "3.0" as operand of ">>"}} +} {1 {can't use floating-point value as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg -} {1 {can't use floating-point value "3.0" as operand of "&"}} +} {1 {can't use floating-point value as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of "|"}} +} {1 {can't use floating-point value as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of "^"}} +} {1 {can't use floating-point value as operand of "^"}} # Check the string operators individually. test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0 test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0 @@ -258,50 +258,50 @@ # Operators that aren't legal on string operands. test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "~"}} +} {1 {can't use non-numeric string as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "*"}} +} {1 {can't use non-numeric string as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "/"}} +} {1 {can't use non-numeric string as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "%"}} +} {1 {can't use non-numeric string as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "<<"}} +} {1 {can't use non-numeric string as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of ">>"}} +} {1 {can't use non-numeric string as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "&"}} +} {1 {can't use non-numeric string as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "^"}} +} {1 {can't use non-numeric string as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "|"}} +} {1 {can't use non-numeric string as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-old-5.16 {illegal string operations} { list [catch {expr {"a"||"b"}} msg] $msg @@ -486,11 +486,11 @@ # Various error conditions. test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * test expr-old-26.3 {error conditions} -body { expr 2+4*( @@ -500,14 +500,14 @@ list [catch {expr 2+$_non_existent_} msg] $msg } {1 {can't read "_non_existent_": no such variable}} set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * test expr-old-26.8 {error conditions} { list [catch {expr 2/0} msg] $msg $errorCode @@ -527,11 +527,11 @@ test expr-old-26.12 {error conditions} -body { expr a.b } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "/"}} +} {1 {can't use non-numeric string as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * test expr-old-26.15 {error conditions} -body { expr a@b @@ -939,18 +939,17 @@ expr round(1.0e30) } 1000000000000000019884624838656 test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 - test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 } -returnCodes error -match glob -result {*invalid octal number*} test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string "0o289" as operand of "+"}} +} {1 {can't use invalid octal number as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} test expr-old-36.4 {ExprLooksLikeInt procedure} { set x 0289.1 @@ -986,23 +985,23 @@ # tests for [Bug #587140] test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string "10;" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string " +" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} } 123456789012345678901234567891 test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string "0o99 " as operand of "+"}} +} {1 {can't use invalid octal number as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} } [expr 0x100000000000000000000000000000000000000] Index: tests/expr.test ================================================================== --- tests/expr.test +++ tests/expr.test @@ -14,10 +14,11 @@ package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] @@ -249,11 +250,11 @@ set i 7 expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} test expr-4.12 {CompileLorExpr: error compiling land arms} { list [catch {expr {0||"a"}} msg] $msg @@ -296,14 +297,14 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2^x } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of "^"}} +} {1 {can't use floating-point value as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "^"}} +} {1 {can't use non-numeric string as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1 test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0 @@ -320,14 +321,14 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { expr 2&x } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of "&"}} +} {1 {can't use floating-point value as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "&"}} +} {1 {can't use non-numeric string as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { expr xne3 } -returnCodes error -match glob -result * @@ -465,14 +466,14 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { expr 2<>43}} msg] $msg -} {1 {can't use floating-point value "24.0" as operand of ">>"}} +} {1 {can't use floating-point value as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "<<"}} +} {1 {can't use non-numeric string as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1 test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6 @@ -487,14 +488,14 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body { expr 2-x } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "-"}} +} {1 {can't use non-numeric string as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} test expr-11.13a {CompileAddExpr: runtime error} !ieeeFloatingPoint { list [catch {expr {2.3/0.0}} msg] $msg @@ -518,14 +519,14 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*x } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "*"}} +} {1 {can't use non-numeric string as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "/"}} +} {1 {can't use non-numeric string as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36 test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0 @@ -538,14 +539,14 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { expr !1.x } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "~"}} +} {1 {can't use non-numeric string as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value "4.0" as operand of "~"}} +} {1 {can't use floating-point value as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 expr $a } 27 @@ -726,11 +727,11 @@ test expr-18.1 {expr and conversion of operands to numbers} { set x [lindex 11 0] catch {expr int($x)} expr {$x} } 11 -test expr-18.2 {whitespace strings should not be == 0 (buggy strtod)} { +test expr-18.2 {whitespace strings should not be == 0 (buggy strtol/strtoul)} { expr {" "} } { } # Check "expr" and interpreter result object resetting before appending # an error msg during evaluation of exprs not in {}s @@ -818,19 +819,19 @@ test expr-21.13 {non-numeric boolean literals} -body { expr !truef } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err -} {1 {can't use non-numeric string "truef" as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string "truef" as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string "true " as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err } {0 0} test expr-21.18 {non-numeric boolean variables} { @@ -846,27 +847,27 @@ list [catch {expr {!$v}} err] $err } {0 1} test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string "o" as operand of "!"}} +} {1 {can't use non-numeric string as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string "" as operand of "!"}} +} {1 {can't use empty string as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} +} {1 {can't use non-numeric floating-point value as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} +} {1 {can't use non-numeric floating-point value as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.5 {non-numeric floats} { @@ -875,11 +876,11 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr Inf} msg] $msg } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg -} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}} +} {1 {can't use non-numeric floating-point value as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} # Make sure [Bug 761471] stays fixed. test expr-22.9 {non-numeric floats: shared object equality and NaN} { @@ -911,14 +912,14 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { expr 2**x } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg -} {1 {can't use non-numeric string "xx" as operand of "**"}} +} {1 {can't use non-numeric string as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg -} {1 {can't use non-numeric string "a" as operand of "**"}} +} {1 {can't use non-numeric string as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} test expr-23.12 {CompileExponentialExpr: runtime error} { list [catch {expr {0.0**-1.0}} msg] $msg @@ -6818,10 +6819,76 @@ expr 1.0e2147483630 } Inf test expr-41.2 {exponent underflow} { expr 1.0e-2147483630 } 0.0 + +test expr-41.3 {exponent overflow} { + expr 1e2147483647 +} Inf +test expr-41.4 {exponent overflow} { + expr 1e2147483648 +} Inf +test expr-41.5 {exponent overflow} { + expr 100e2147483645 +} Inf +test expr-41.6 {exponent overflow} { + expr 100e2147483646 +} Inf +test expr-41.7 {exponent overflow} { + expr 1.0e2147483647 +} Inf +test expr-41.8 {exponent overflow} { + expr 1.0e2147483648 +} Inf +test expr-41.9 {exponent overflow} { + expr 1.2e2147483647 +} Inf +test expr-41.10 {exponent overflow} { + expr 1.2e2147483648 +} Inf + +test expr-41.11 {exponent overflow} { + expr 1e-2147483648 +} 0.0 +test expr-41.12 {exponent overflow} { + expr 1e-2147483649 +} 0.0 +test expr-41.13 {exponent overflow} { + expr 100e-2147483650 +} 0.0 +test expr-41.14 {exponent overflow} { + expr 100e-2147483651 +} 0.0 +test expr-41.15 {exponent overflow} { + expr 1.0e-2147483648 +} 0.0 +test expr-41.16 {exponent overflow} { + expr 1.0e-2147483649 +} 0.0 +test expr-41.17 {exponent overflow} { + expr 1.23e-2147483646 +} 0.0 +test expr-41.18 {exponent overflow} { + expr 1.23e-2147483647 +} 0.0 + +test expr-41.19 {numSigDigs == 0} { + expr 0e309 +} 0.0 +test expr-41.20 {numSigDigs == 0} { + expr 0e310 +} 0.0 +test expr-41.21 {negative zero, large exponent} { + expr -0e309 +} -0.0 +test expr-41.22 {negative zero, large exponent} { + expr -0e310 +} -0.0 +test expr-41.23 {floating point overflow on significand (Bug 1de6b0629e)} { + expr 123[string repeat 0 309]1e-310 +} 123.0 test expr-42.1 {denormals} ieeeFloatingPoint { expr 7e-324 } 5e-324 Index: tests/fCmd.test ================================================================== --- tests/fCmd.test +++ tests/fCmd.test @@ -274,11 +274,11 @@ file mkdir td1 file rename ~_totally_bogus_user td1 } -result {user "_totally_bogus_user" doesn't exist} test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { cleanup -} -constraints {notRoot unixOrPc} -returnCodes error -body { +} -constraints {notRoot unixOrWin} -returnCodes error -body { file mkdir td1 file rename / td1 } -result {error renaming "/" to "td1": file already exists} test fCmd-3.16 {FileCopyRename: break on first error} -setup { cleanup @@ -414,11 +414,11 @@ file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] } -cleanup {cleanup} -result {1 1 1 0 0 0} test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { cleanup -} -constraints {notRoot unixOrPc} -body { +} -constraints {notRoot unixOrWin} -body { createfile tf1 createfile tf2 file mkdir td1 catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] @@ -1114,11 +1114,11 @@ set a5 [catch {file copy -force tds4 tdd4}] list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}] test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup -} -constraints {notRoot unixOrPc testchmod} -body { +} -constraints {notRoot unixOrWin testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] testchmod 0o555 tds2 Index: tests/fileName.test ================================================================== --- tests/fileName.test +++ tests/fileName.test @@ -1087,17 +1087,17 @@ file rename $horribleglobname globTest file delete -force $tildeglobname set globname globTest unset horribleglobname tildeglobname -test filename-12.1 {simple globbing} {unixOrPc} { +test filename-12.1 {simple globbing} {unixOrWin} { glob {} } {.} -test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body { +test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body { glob -types f {} } -returnCodes error -result {no files matched glob pattern ""} -test filename-12.1.2 {simple globbing} {unixOrPc} { +test filename-12.1.2 {simple globbing} {unixOrWin} { glob -types d {} } {.} test filename-12.1.3 {simple globbing} {unix} { glob -types hidden {} } {.} @@ -1114,11 +1114,11 @@ glob -nocomplain \{a1,a2\} } {} set globPreResult globTest/ set x1 x1.c set y1 y1.c -test filename-12.4 {simple globbing} {unixOrPc} { +test filename-12.4 {simple globbing} {unixOrWin} { lsort [glob globTest/x1.c globTest/y1.c globTest/foo] } "$globPreResult$x1 $globPreResult$y1" test filename-12.5 {simple globbing} { glob globTest\\/x1.c } "$globPreResult$x1" @@ -1176,46 +1176,46 @@ lsort [glob globTest/\{x,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.10 {globbing with brace substitution} { lsort [glob globTest/\{x,,y\}1.c] } [list $globPreResult$x1 $globPreResult$y1] -test filename-13.11 {globbing with brace substitution} {unixOrPc} { +test filename-13.11 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/\{x,x\\,z,z\}1.c] } [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}] test filename-13.13 {globbing with brace substitution} { lsort [glob globTest/{a,b,x,y}1.c] } [list $globPreResult$x1 $globPreResult$y1] -test filename-13.14 {globbing with brace substitution} {unixOrPc} { +test filename-13.14 {globbing with brace substitution} {unixOrWin} { lsort [glob {globTest/{x1,y2,weird name}.c}] } {{globTest/weird name.c} globTest/x1.c} -test filename-13.16 {globbing with brace substitution} {unixOrPc} { +test filename-13.16 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} -test filename-13.18 {globbing with brace substitution} {unixOrPc} { +test filename-13.18 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{x1.c,{a},a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} -test filename-13.20 {globbing with brace substitution} {unixOrPc} { +test filename-13.20 {globbing with brace substitution} {unixOrWin} { lsort [glob globTest/{a,x}1/*/{x,y}*] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-13.22 {globbing with brace substitution} -body { glob globTest/\{a,x\}1/*/\{ } -returnCodes error -result {unmatched open-brace in file name} -test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob glo*/*.c] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} -test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/?1.c] } {globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.5 {asterisks, question marks, and brackets} -setup { # The current directory could be anywhere; do this to stop spurious # matches file mkdir globTestContext file rename globTest [file join globTestContext globTest] set savepwd [pwd] cd globTestContext -} -constraints {unixOrPc} -body { +} -constraints {unixOrWin} -body { lsort [glob */*/*/*.c] } -cleanup { # Reset to where we were cd $savepwd file rename [file join globTestContext globTest] globTest @@ -1225,20 +1225,20 @@ lsort [glob globTest/*] } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.7.1 {asterisks, question marks, and brackets} {win} { lsort [glob globTest/*] } {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} -test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/.*] } {globTest/. globTest/.. globTest/.1} -test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/*] } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} -test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob {globTest/[xyab]1.*}] } {globTest/x1.c globTest/y1.c} -test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*/] } {globTest/a1/ globTest/a2/ globTest/a3/} test filename-14.17 {asterisks, question marks, and brackets} -setup { global env set temp $env(HOME) @@ -1246,11 +1246,11 @@ set env(HOME) [file join $env(HOME) globTest] glob ~/z* } -cleanup { set env(HOME) $temp } -result [list [file join $env(HOME) globTest z1.c]] -test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} { +test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} { lsort [glob globTest/*.c goo/*] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.20 {asterisks, question marks, and brackets} { glob -nocomplain goo/* } {} @@ -1285,20 +1285,20 @@ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]] test filename-14.26 {type specific globbing} { glob -nocomplain -dir globTest -types {readonly} * } {} -test filename-14.27 {Bug 2710920} {unixOrPc} { +test filename-14.27 {Bug 2710920} {unixOrWin} { file tail [lindex [lsort [glob globTest/*/]] 0] } a1 -test filename-14.28 {Bug 2710920} {unixOrPc} { +test filename-14.28 {Bug 2710920} {unixOrWin} { file dirname [lindex [lsort [glob globTest/*/]] 0] } globTest -test filename-14.29 {Bug 2710920} {unixOrPc} { +test filename-14.29 {Bug 2710920} {unixOrWin} { file extension [lindex [lsort [glob globTest/*/]] 0] } {} -test filename-14.30 {Bug 2710920} {unixOrPc} { +test filename-14.30 {Bug 2710920} {unixOrWin} { file rootname [lindex [lsort [glob globTest/*/]] 0] } globTest/a1/ test filename-14.31 {Bug 2918610} -setup { set d [makeDirectory foo] Index: tests/fileSystem.test ================================================================== --- tests/fileSystem.test +++ tests/fileSystem.test @@ -32,10 +32,11 @@ # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] cd [tcltest::temporaryDirectory] makeFile "test file" gorp.file makeDirectory dir.dir makeDirectory [file join dir.dir dirinside.dir] @@ -310,11 +311,11 @@ set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." file norm $fname } -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] -} -constraints {win moreThanOneDrive} -body { +} -constraints {win moreThanOneDrive knownMsvcBug} -body { set path "[string range [lindex $drives 0] 0 1]foo" cd [lindex $drives 1] file norm $path } -cleanup { cd $dir ADDED tests/fileSystemEncoding.test Index: tests/fileSystemEncoding.test ================================================================== --- /dev/null +++ tests/fileSystemEncoding.test @@ -0,0 +1,52 @@ +#! /usr/bin/env tclsh + +# Copyright (c) 2019 Poor Yorick + +if {[string equal $::tcl_platform(os) "Windows NT"]} { + return +} + +namespace eval ::tcl::test::fileSystemEncoding { + package require tcltest 2 + namespace import ::tcltest::* + + variable fname1 \u767b\u9e1b\u9d72\u6a13 + + proc autopath {} { + global auto_path + set scriptpath [info script] + set scriptpathnorm [file dirname [file normalize $scriptpath/...]] + set dirnorm [file dirname $scriptpathnorm] + set idx [lsearch -exact $auto_path $dirnorm] + if {$idx >= 0} { + set auto_path [lreplace $auto_path[set auto_path {}] $idx $idx {}] + } + set auto_path [linsert $auto_path[set auto_path {}] 0 0 $dirnorm] + } + autopath + + package require tcltests + + test filesystemEncoding-1.0 { + issue bcd100410465 + } -body { + set dir [tcltests::tempdir] + set saved [encoding system] + encoding system iso8859-1 + set fname1a $dir/$fname1 + set utf8name [encoding convertto utf-8 $fname1a] + makeFile {} $utf8name + set globbed [lindex [glob -directory $dir *] 0] + encoding system utf-8 + set res [file exists $globbed] + encoding system iso8859-1 + lappend res [file exists $globbed] + return $res + } -cleanup { + removeFile $utf8name + file delete -force $dir + encoding system $saved + } -result {0 1} + + cleanupTests +} Index: tests/format.test ================================================================== --- tests/format.test +++ tests/format.test @@ -18,10 +18,11 @@ # %u output depends on word length, so this test is not portable. testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} test format-1.2 {integer formatting} { @@ -77,17 +78,17 @@ test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] } {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} test format-1.13 {integer formatting} { format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1 -} {0 6 34 16923 -12} +} {0 0d6 0d34 0d16923 -0d12} test format-1.14 {integer formatting} { format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1 -} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012} +} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} test format-1.15 {integer formatting} { format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1 -} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012} +} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} test format-2.1 {string formatting} { format "%s %s %c %s" abcd {This is a very long test string.} 120 x } {abcd This is a very long test string. x x} @@ -261,17 +262,17 @@ format "%e %f %g" 0.0 0.0 0.0 0.0 } {0.000000e+00 0.000000 0} test format-6.2 {floating-point zeroes} {eformat} { format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0} -test format-6.3 {floating-point zeroes} {eformat} { +test format-6.3 {floating-point zeroes} {eformat knownMsvcBug} { format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0 } {0.0000e+00 0.0000 0.000} test format-6.4 {floating-point zeroes} {eformat} { format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0 } {0e+00 0 0} -test format-6.5 {floating-point zeroes} {eformat} { +test format-6.5 {floating-point zeroes} {eformat knownMsvcBug} { format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0 } {0.e+00 0. 0.} test format-6.6 {floating-point zeroes} { format "%3.0f %3.0f %3.0f %3.0f" 0.0 0.0 0.0 0.0 } { 0 0 0 0} Index: tests/get.test ================================================================== --- tests/get.test +++ tests/get.test @@ -96,21 +96,27 @@ } set result } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} # Bug 7114ac6141 test get-3.3 {tcl_GetInt with iffy numbers} testgetint { - lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} { + lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} { catch {testgetint 44 $x} x set x } -} {44 44 44 44 54 54 52 46} +} {44 44 44 44 54 51 52 46} test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { - lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { + lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } -} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} +} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} +test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint { + lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " " 0_07 " " 0o_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } { + catch {testgetint $x} x + set x + } +} {0 10 2 33 1423324 10 7 8 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}} # cleanup ::tcltest::cleanupTests return Index: tests/http.test ================================================================== --- tests/http.test +++ tests/http.test @@ -184,11 +184,11 @@ } -result "HTTP/1.0 TEST
Hello, World!

GET $tail
" test http-3.8 {http::geturl} -body { - set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000] + set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST
Hello, World!
@@ -350,21 +350,21 @@ http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-3.25 {http::meta} -setup { unset -nocomplain m token } -body { - set token [http::geturl $url -timeout 2000] + set token [http::geturl $url -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date} test http-3.26 {http::meta} -setup { unset -nocomplain m token } -body { - set token [http::geturl $url -headers {X-Check 1} -timeout 2000] + set token [http::geturl $url -headers {X-Check 1} -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token @@ -586,11 +586,11 @@ } -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. - set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#] + set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#] http::wait $token http::status $token # error codes vary among platforms. } -cleanup { catch {http::cleanup $token} @@ -668,21 +668,21 @@ http::mapReply "\u2208" } -cleanup { http::config -urlencoding $enc } -result {%3F} -package require -exact tcl::idna 1.0 +package require tcl::idna 1.0 test http-idna-1.1 {IDNA package: basics} -returnCodes error -body { ::tcl::idna } -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} test http-idna-1.2 {IDNA package: basics} -returnCodes error -body { ::tcl::idna ? } -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} test http-idna-1.3 {IDNA package: basics} -body { ::tcl::idna version -} -result 1.0 +} -result 1.0.1 test http-idna-1.4 {IDNA package: basics} -returnCodes error -body { ::tcl::idna version what } -result {wrong # args: should be "::tcl::idna version"} test http-idna-1.5 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny Index: tests/httpcookie.test ================================================================== --- tests/httpcookie.test +++ tests/httpcookie.test @@ -23,52 +23,52 @@ }]}] testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch { package require cookiejar }]}] -set COOKIEJAR_VERSION 0.1 -test http-cookiejar-1.1 "cookie storage: packaging" {notOSXtravis sqlite3 cookiejar} { +set COOKIEJAR_VERSION 0.2.0 +test http-cookiejar-1.1 "cookie storage: packaging" {cookiejar} { package require cookiejar } $COOKIEJAR_VERSION -test http-cookiejar-1.2 "cookie storage: packaging" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-1.2 "cookie storage: packaging" {cookiejar} { package require cookiejar package require cookiejar } $COOKIEJAR_VERSION test http-cookiejar-2.1 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar } -result {wrong # args: should be "http::cookiejar method ?arg ...?"} test http-cookiejar-2.2 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar ? } -result {unknown method "?": must be configure, create, destroy or new} test http-cookiejar-2.3 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -body { http::cookiejar configure } -result {-domainfile -domainlist -domainrefresh -loglevel -offline -purgeold -retain -vacuumtrigger} test http-cookiejar-2.4 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar configure a b c d e } -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} test http-cookiejar-2.5 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar configure a } -result {bad option "a": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger} test http-cookiejar-2.6 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar configure -d } -result {ambiguous option "-d": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger} test http-cookiejar-2.7 "cookie storage: basics" -setup { set old [http::cookiejar configure -loglevel] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [http::cookiejar configure -loglevel] \ [http::cookiejar configure -loglevel debug] \ [http::cookiejar configure -loglevel] \ [http::cookiejar configure -loglevel error] \ [http::cookiejar configure -loglevel] @@ -75,11 +75,11 @@ } -cleanup { http::cookiejar configure -loglevel $old } -result {info debug debug error error} test http-cookiejar-2.8 "cookie storage: basics" -setup { set old [http::cookiejar configure -loglevel] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [http::cookiejar configure -loglevel] \ [http::cookiejar configure -loglevel d] \ [http::cookiejar configure -loglevel i] \ [http::cookiejar configure -loglevel w] \ [http::cookiejar configure -loglevel e] @@ -86,51 +86,51 @@ } -cleanup { http::cookiejar configure -loglevel $old } -result {info debug info warn error} test http-cookiejar-2.9 "cookie storage: basics" -body { http::cookiejar configure -off -} -constraints {notOSXtravis sqlite3 cookiejar} -match glob -result * +} -constraints {cookiejar} -match glob -result * test http-cookiejar-2.10 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline true } -cleanup { catch {http::cookiejar configure -offline $oldval} } -result 1 test http-cookiejar-2.11 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline nonbool } -cleanup { catch {http::cookiejar configure -offline $oldval} } -returnCodes error -result {expected boolean value but got "nonbool"} test http-cookiejar-2.12 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -purgeold] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -purge nonint } -cleanup { catch {http::cookiejar configure -purgeold $oldval} } -returnCodes error -result {expected positive integer but got "nonint"} test http-cookiejar-2.13 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -domainrefresh] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -domainref nonint } -cleanup { catch {http::cookiejar configure -domainrefresh $oldval} } -returnCodes error -result {expected positive integer but got "nonint"} test http-cookiejar-2.14 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -domainrefresh] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -domainref -42 } -cleanup { catch {http::cookiejar configure -domainrefresh $oldval} } -returnCodes error -result {expected positive integer but got "-42"} test http-cookiejar-2.15 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -domainrefresh] set result unset set tracer [http::cookiejar create tracer] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { oo::objdefine $tracer method PostponeRefresh {} { set ::result set next } http::cookiejar configure -domainref 12345 @@ -138,119 +138,119 @@ } -cleanup { $tracer destroy catch {http::cookiejar configure -domainrefresh $oldval} } -result set -test http-cookiejar-3.1 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.1 "cookie storage: class" {cookiejar} { info object isa object http::cookiejar } 1 -test http-cookiejar-3.2 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.2 "cookie storage: class" {cookiejar} { info object isa class http::cookiejar } 1 -test http-cookiejar-3.3 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.3 "cookie storage: class" {cookiejar} { lsort [info object methods http::cookiejar] } {configure} -test http-cookiejar-3.4 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.4 "cookie storage: class" {cookiejar} { lsort [info object methods http::cookiejar -all] } {configure create destroy new} test http-cookiejar-3.5 "cookie storage: class" -setup { catch {rename ::cookiejar ""} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { namespace eval :: {http::cookiejar create cookiejar} } -cleanup { catch {rename ::cookiejar ""} } -result ::cookiejar test http-cookiejar-3.6 "cookie storage: class" -setup { catch {rename ::cookiejar ""} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [http::cookiejar create ::cookiejar] [info commands ::cookiejar] \ [::cookiejar destroy] [info commands ::cookiejar] } -cleanup { catch {rename ::cookiejar ""} } -result {::cookiejar ::cookiejar {} {}} test http-cookiejar-3.7 "cookie storage: class" -setup { catch {rename ::cookiejar ""} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar foo bar } -returnCodes error -cleanup { catch {rename ::cookiejar ""} } -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"} test http-cookiejar-3.8 "cookie storage: class" -setup { catch {rename ::cookiejar ""} set f [makeFile "" cookiejar] file delete $f -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [file exists $f] [http::cookiejar create ::cookiejar $f] \ [file exists $f] } -cleanup { catch {rename ::cookiejar ""} removeFile $f } -result {0 ::cookiejar 1} test http-cookiejar-3.9 "cookie storage: class" -setup { catch {rename ::cookiejar ""} set f [makeFile "bogus content for a database" cookiejar] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $f } -returnCodes error -cleanup { catch {rename ::cookiejar ""} removeFile $f } -match glob -result * test http-cookiejar-3.10 "cookie storage: class" -setup { catch {rename ::cookiejar ""} set dir [makeDirectory cookiejar] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $dir } -returnCodes error -cleanup { catch {rename ::cookiejar ""} removeDirectory $dir } -match glob -result * test http-cookiejar-4.1 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar method ?arg ...?"} test http-cookiejar-4.2 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar ? } -returnCodes error -cleanup { ::cookiejar destroy } -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup, policyAllow or storeCookie} test http-cookiejar-4.3 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lsort [info object methods cookiejar -all] } -cleanup { ::cookiejar destroy } -result {destroy forceLoadDomainData getCookies lookup policyAllow storeCookie} test http-cookiejar-4.4 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar getCookies } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar getCookies proto host path"} test http-cookiejar-4.5 "cookie storage" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar getCookies http www.example.com / } -cleanup { ::cookiejar destroy } -result {} test http-cookiejar-4.6 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar storeCookie options"} test http-cookiejar-4.7 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar secure 0 domain www.example.com @@ -262,11 +262,11 @@ ::cookiejar destroy } -result {} test http-cookiejar-4.8 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar secure 0 domain www.example.com @@ -280,11 +280,11 @@ ::cookiejar destroy } -result 1 test http-cookiejar-4.9 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar secure 0 domain www.example.com @@ -297,11 +297,11 @@ } -cleanup { ::cookiejar destroy } -result 0 test http-cookiejar-4.10 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie [dict replace { key foo value bar secure 0 domain www.example.com @@ -313,11 +313,11 @@ ::cookiejar destroy } -result {} test http-cookiejar-4.11 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie [dict replace { key foo value bar secure 0 domain www.example.com @@ -331,11 +331,11 @@ ::cookiejar destroy } -result 0 test http-cookiejar-4.12 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie [dict replace { key foo value bar secure 0 domain www.example.com @@ -349,11 +349,11 @@ ::cookiejar destroy } -result 1 test http-cookiejar-4.13 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo value bar secure 0 @@ -367,11 +367,11 @@ ::cookiejar destroy } -result {{} {foo bar}} test http-cookiejar-4.14 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie [dict replace { key foo value bar secure 0 @@ -385,11 +385,11 @@ ::cookiejar destroy } -result {{} {foo bar}} test http-cookiejar-4.15 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo value bar secure 0 @@ -412,11 +412,11 @@ ::cookiejar destroy } -result {{} {foo bar}} test http-cookiejar-4.16 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo1 value bar secure 0 @@ -438,19 +438,19 @@ } -cleanup { ::cookiejar destroy } -result {{} {foo1 bar foo2 bar}} test http-cookiejar-4.17 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar lookup a b c d } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar lookup ?host? ?key?"} test http-cookiejar-4.18 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar lookup] lappend result [cookiejar lookup www.example.com] lappend result [catch {cookiejar lookup www.example.com foo} value] $value cookiejar storeCookie { key foo @@ -468,11 +468,11 @@ ::cookiejar destroy } -result {{} {} 1 {no such key for that host} www.example.com foo bar} test http-cookiejar-4.19 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar secure 0 domain www.example.com @@ -498,11 +498,11 @@ ::cookiejar destroy } -result {{www.example.com www.example.org} foo bar bar foo} test http-cookiejar-4.20 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value bar1 secure 0 domain www.example.com @@ -527,11 +527,11 @@ ::cookiejar destroy } -result {www.example.com {foo1 foo2} bar1 bar2} test http-cookiejar-4.21 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value bar1 secure 0 domain www.example.com @@ -556,35 +556,35 @@ ::cookiejar destroy } -result {www.example.com {foo1 foo2} bar1 bar2} test http-cookiejar-4.22 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar forceLoadDomainData x y z } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar forceLoadDomainData"} test http-cookiejar-4.23 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar forceLoadDomainData } -cleanup { ::cookiejar destroy } -result {} test http-cookiejar-4.23.a {cookie storage: instance} -setup { set off [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline 1 [http::cookiejar create ::cookiejar] destroy } -cleanup { catch {::cookiejar destroy} http::cookiejar configure -offline $off } -result {} test http-cookiejar-4.23.b {cookie storage: instance} -setup { set off [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline 0 [http::cookiejar create ::cookiejar] destroy } -cleanup { catch {::cookiejar destroy} http::cookiejar configure -offline $off @@ -591,11 +591,11 @@ } -result {} test http-cookiejar-5.1 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar secure 0 domain com @@ -608,11 +608,11 @@ ::cookiejar destroy } -result {} test http-cookiejar-5.2 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar secure 0 domain foo.example.com @@ -625,11 +625,11 @@ ::cookiejar destroy } -result {} test http-cookiejar-5.3 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value bar secure 0 domain com @@ -651,11 +651,11 @@ ::cookiejar destroy } -result {example.com} test http-cookiejar-5.4 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar1 secure 0 domain www.example.com @@ -677,11 +677,11 @@ ::cookiejar destroy } -result {example.com www.example.com} test http-cookiejar-5.5 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value 1 secure 0 domain com @@ -775,11 +775,11 @@ set result {} proc values cookies { global result lappend result [lsort [lmap {k v} $cookies {set v}]] } -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { values [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo value session secure 0 @@ -831,11 +831,11 @@ test http-cookiejar-7.1 "cookie storage: persistence of persistent cookies" -setup { catch {rename ::cookiejar ""} set f [makeFile "" cookiejar] file delete $f -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $f ::cookiejar destroy http::cookiejar create ::cookiejar $f } -cleanup { catch {rename ::cookiejar ""} @@ -844,11 +844,11 @@ test http-cookiejar-7.2 "cookie storage: persistence of persistent cookies" -setup { catch {rename ::cookiejar ""} set f [makeFile "" cookiejar] file delete $f set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $f cookiejar storeCookie [dict replace { key foo value cookie secure 0 Index: tests/init.test ================================================================== --- tests/init.test +++ tests/init.test @@ -16,10 +16,23 @@ } # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} +test init-0.1 {no error on initialization phase (init.tcl)} -setup { + interp create slave +} -body { + slave eval { + list [set v [info exists ::errorInfo]] \ + [if {$v} {set ::errorInfo}] \ + [set v [info exists ::errorCode]] \ + [if {$v} {set ::errorCode}] + } +} -cleanup { + interp delete slave +} -result {0 {} 0 {}} + # Six cases - white box testing test init-1.1 {auto_qualify - absolute cmd - namespace} { auto_qualify ::foo::bar ::blue } ::foo::bar ADDED tests/internals.tcl Index: tests/internals.tcl ================================================================== --- /dev/null +++ tests/internals.tcl @@ -0,0 +1,96 @@ +# This file contains internal facilities for Tcl tests. +# +# Source this file in the related tests to include from tcl-tests: +# +# source [file join [file dirname [info script]] internals.tcl] +# +# Copyright (c) 2020 Sergey G. Brester (sebres). +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals { + +namespace path ::tcltest + +::tcltest::ConstraintInitializer testWithLimit { expr {[testConstraint macOrUnix] && ![catch { exec prlimit --version }]} } + +# test-with-limit -- +# +# Usage: test-with-limit ?-addmem bytes? ?-maxmem bytes? command +# Options: +# -addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test) +# -maxmem - set absolute maximum address space limit (in bytes) +# +proc testWithLimit args { + set body [lindex $args end] + array set in [lrange $args 0 end-1] + # test in child process (with limits): + set pipe {} + if {[catch { + # start new process: + set pipe [open |[list [interpreter]] r+] + set ppid [pid $pipe] + # create prlimit args: + set args {} + # with limited address space: + if {[info exists in(-addmem)] || [info exists in(-maxmem)]} { + if {[info exists in(-addmem)]} { + # as differnce to normal usage, so try to retrieve current memory usage: + if {[catch { + # using ps (vsz is in KB): + incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}] + }]} { + # ps failed, use default size 20MB: + incr in(-addmem) 20000000 + # + size of locale-archive (may be up to 100MB): + incr in(-addmem) [expr { + [file exists /usr/lib/locale/locale-archive] ? + [file size /usr/lib/locale/locale-archive] : 0 + }] + } + if {![info exists in(-maxmem)]} { + set in(-maxmem) $in(-addmem) + } + set in(-maxmem) [expr { max($in(-addmem), $in(-maxmem)) }] + } + append args --as=$in(-maxmem) + } + # apply limits: + exec prlimit -p $ppid {*}$args + } msg opt]} { + catch {close $pipe} + tcltest::Warn "testWithLimit: error - [regsub {^\s*([^\n]*).*$} $msg {\1}]" + tcltest::Skip testWithLimit + } + # execute body, close process and return: + set ret [catch { + chan configure $pipe -buffering line + puts $pipe "puts \[$body\]" + puts $pipe exit + set result [read $pipe] + close $pipe + set pipe {} + set result + } result opt] + if {$pipe ne ""} { catch { close $pipe } } + if {$ret && [dict get $opt -errorcode] eq "BYPASS-SKIPPED-TEST"} { + return {*}$opt $result + } + if { ( [info exists in(-warn-on-code)] && $ret in $in(-warn-on-code) ) + || ( $ret && [info exists in(-warn-on-alloc-error)] && $in(-warn-on-alloc-error) + && [regexp {\munable to (?:re)?alloc\M} $result] ) + } { + tcltest::Warn "testWithLimit: wrong limit, result: $result" + tcltest::Skip testWithLimit + } + return {*}$opt $result +} + +# export all routines starting with test +namespace export test* + +# for script path & as mark for loaded +proc scriptpath {} [list return [info script]] + +}}; # end of internals. Index: tests/interp.test ================================================================== --- tests/interp.test +++ tests/interp.test @@ -1834,11 +1834,11 @@ interp delete a } -result {{} bar {} bar bar {} {}} test interp-23.2 {testing hiding vs aliases: safe interp} -setup { catch {interp delete a} set l "" -} -constraints {unixOrPc} -body { +} -constraints {unixOrWin} -body { interp create a -safe lappend l [lsort [interp hidden a]] a alias bar bar lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a hide bar Index: tests/io.test ================================================================== --- tests/io.test +++ tests/io.test @@ -41,10 +41,11 @@ testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] @@ -916,11 +917,11 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} { # Tcl_ExternalToUtf() set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none - fconfigure $f -encoding unicode + fconfigure $f -encoding utf-16 puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] @@ -1160,11 +1161,11 @@ fileevent $f read [namespace code "ready $f"] proc ready {f} { variable x lappend x [gets $f line] $line [testchannel inputbuffered $f] } - fconfigure $f -encoding unicode -buffersize 16 -blocking 0 + fconfigure $f -encoding utf-16 -buffersize 16 -blocking 0 vwait [namespace which -variable x] fconfigure $f -translation auto -encoding ascii -blocking 1 # here vwait [namespace which -variable x] close $f @@ -2209,11 +2210,11 @@ lappend l [file size $path(test1)] close $f set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ - {unixOrPc} { + {unixOrWin} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 -eofchar {} set l "" lappend l [file size $path(test1)] @@ -2226,11 +2227,11 @@ set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ - {stdio asyncPipeClose openpipe} { + {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] @@ -2824,17 +2825,17 @@ set result "file size only [file size $path(output)]" } else { set result ok } # allow a little time for the background process to close. - # otherwise, the following test fails on the [file delete $path(output) + # otherwise, the following test fails on the [file delete $path(output)] # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ - {stdio asyncPipeClose openpipe} { + {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] @@ -5962,12 +5963,12 @@ set x } {initial foo eof} close $f -test chan-io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { -} -constraints {stdio unixExecs fileevent openpipe} -body { +test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { +} -constraints {stdio fileevent openpipe} -body { namespace eval refchan { namespace ensemble create namespace export * @@ -6014,16 +6015,17 @@ if {$count > 262144} { chan event $f writable {} set x done } }] - after 10000 [namespace code { + set token [after 10000 [namespace code { set x timeout - }] + }]] vwait [namespace which -variable x] return $x } -cleanup { + after cancel $token catch {chan close $f} } -result done makeFile "foo bar" foo @@ -7443,11 +7445,11 @@ set f [open $path(test1)] lappend result [read $f] close $f set result } "ready line1 line2 {done\n}" -test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileevent fcopy} { +test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { append big $big } @@ -8081,11 +8083,11 @@ close $outChan close $c removeFile out } -result {line 100 line} -test io-54.1 {Recursive channel events} {socket fileevent} { +test io-54.1 {Recursive channel events} {socket fileevent knownMsvcBug} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. proc accept {s a p} { variable as @@ -8290,11 +8292,11 @@ close $s2 close $server set result } {1 readable 234567890 timer} -test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} { +test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} { set out [open $path(script) w] puts $out { puts "normal message from pipe" puts stderr "error message from pipe" exit 1 Index: tests/ioCmd.test ================================================================== --- tests/ioCmd.test +++ tests/ioCmd.test @@ -239,27 +239,27 @@ } -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform} test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] - fconfigure $f1 -translation lf -eofchar {} -encoding unicode + fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ - -eofchar {} -encoding unicode + -eofchar {} -encoding utf-16 lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] } -cleanup { catch {close $f1} -} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ @@ -292,11 +292,11 @@ } -result [expectedOpts "-buffer" {}] removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 -test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup { +test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} set cli [socket 127.0.0.1 $port] } -body { @@ -400,22 +400,22 @@ } 0 set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] -test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} { +test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} { set f [open $path(test4) w] close $f list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode } {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}} -test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} { +test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} -test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} { +test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} -test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrPc} { +test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} { list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}} test iocmd-12.1 {POSIX open access modes: RDONLY} { file delete $path(test1) @@ -822,15 +822,15 @@ return } } set ch [chan create {read write} foo] } -body { - list [catch {chan configure $ch -blocking 0} m] $m + chan configure $ch -blocking 0 } -cleanup { close $ch rename foo {} -} -match glob -result {1 {*nested eval*}} +} -match glob -returnCodes 1 -result {*(infinite loop?)*} test iocmd-21.21 {[close] in [read] segfaults} -setup { proc foo {method chan args} { switch -- $method initialize { return {initialize finalize watch read} } finalize {} watch {} read { @@ -2013,11 +2013,11 @@ set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] set tock {} note [fileevent $c readable {lappend res TOCK; set tock 1}] - set stop [after 10000 {lappend res TIMEOUT; set tock 1}] + set stop [after 15000 {lappend res TIMEOUT; set tock 1}] after 1000 {note [chan postevent $c r]} vwait ::tock catch {after cancel $stop} close $c rename foo {} @@ -2026,11 +2026,11 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] note [fileevent $c writable {lappend res TOCK; set tock 1}] - set stop [after 10000 {lappend res TIMEOUT; set tock 1}] + set stop [after 15000 {lappend res TIMEOUT; set tock 1}] after 1000 {note [chan postevent $c w]} vwait ::tock catch {after cancel $stop} close $c rename foo {} Index: tests/lindex.test ================================================================== --- tests/lindex.test +++ tests/lindex.test @@ -49,47 +49,47 @@ list [catch { testevalex {lindex {a b c} $x} } result] $result } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers -test lindex-3.1 {integer -1} testevalex { +test lindex-3.1 {integer -1} -constraints testevalex -body { set x ${minus}1 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] -} {{} {}} -test lindex-3.2 {integer 0} testevalex { +} -result {{} {}} +test lindex-3.2 {integer 0} -constraints testevalex -body { set x [string range 00 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] -} {a a} -test lindex-3.3 {integer 2} testevalex { +} -result {a a} +test lindex-3.3 {integer 2} -constraints testevalex -body { set x [string range 22 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] -} {c c} -test lindex-3.4 {integer 3} testevalex { +} -result {c c} +test lindex-3.4 {integer 3} -constraints testevalex -body { set x [string range 33 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] -} {{} {}} +} -result {{} {}} test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test lindex-3.6 {bad octal} -constraints testevalex -body { set x -0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*}} -test lindex-3.7 {indexes don't shimmer wide ints} { +} -match glob -result {1 {*invalid octal number*}} +test lindex-3.7 {indexes don't shimmer wide ints} -body { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] -} {2147483646 {} 2147483647 2147483648} -test lindex-3.8 {compiled with static indices out of range, negative} { +} -result {2147483646 {} 2147483647 2147483648} +test lindex-3.8 {compiled with static indices out of range, negative} -body { list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3] -} [lrepeat 3 {}] -test lindex-3.9 {compiled with calculated indices out of range, negative constant} { +} -result [lrepeat 3 {}] +test lindex-3.9 {compiled with calculated indices out of range, negative constant} -body { list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1] -} [lrepeat 3 {}] -test lindex-3.10 {compiled with calculated indices out of range, after end} { +} -result [lrepeat 3 {}] +test lindex-3.10 {compiled with calculated indices out of range, after end} -body { list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3] -} [lrepeat 3 {}] +} -result [lrepeat 3 {}] # Indices relative to end test lindex-4.1 {index = end} testevalex { set x end @@ -112,15 +112,15 @@ list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test lindex-4.7 {bad octal} -constraints testevalex -body { set x end--0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-4.9 {obsolete test} testevalex { @@ -163,38 +163,42 @@ } {c d " x} test lindex-7.4 {quoted elements} { lindex {a b {c d "e} {f g"}} 2 } {c d "e} -test lindex-8.1 {data reuse} testevalex { +test lindex-8.1 {data reuse} -constraints testevalex -body { set x 0 testevalex {lindex $x $x} -} {0} -test lindex-8.2 {data reuse} testevalex { +} -result 0 +test lindex-8.2 {data reuse} -constraints testevalex -body { set a 0 testevalex {lindex $a $a $a} -} 0 -test lindex-8.3 {data reuse} testevalex { +} -result 0 +test lindex-8.3 {data reuse} -constraints { + testevalex +} -body { set a 1 testevalex {lindex $a $a $a} -} {} -test lindex-8.4 {data reuse} testevalex { +} -result {} +test lindex-8.4 {data reuse} -constraints testevalex -body { set x [list 0 0] testevalex {lindex $x $x} -} {0} -test lindex-8.5 {data reuse} testevalex { +} -result 0 +test lindex-8.5 {data reuse} -constraints testevalex -body { set x 0 testevalex {lindex $x [list $x $x]} -} {0} -test lindex-8.6 {data reuse} testevalex { +} -result 0 +test lindex-8.6 {data reuse} -constraints testevalex -body { set x [list 1 1] testevalex {lindex $x $x} -} {} -test lindex-8.7 {data reuse} testevalex { +} -result {} +test lindex-8.7 {data reuse} -constraints { + testevalex +} -body { set x 1 testevalex {lindex $x [list $x $x]} -} {} +} -result {} #---------------------------------------------------------------------- # Compilation tests for lindex @@ -268,15 +272,15 @@ set result } {{} {}} test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test lindex-11.6 {bad octal} -body { set x -0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} # Indices relative to end test lindex-12.1 {index = end} { set x end @@ -314,15 +318,15 @@ set result } {{} {}} test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test lindex-12.7 {bad octal} -body { set x end--0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-12.9 {obsolete test} { @@ -379,84 +383,73 @@ catch { lindex {ab "c d \" x" y} 1 } result set result } {c d " x} -test lindex-15.4 {quoted elements} { - catch { - lindex {a b {c d "e} {f g"}} 2 - } result - set result -} {c d "e} - -test lindex-16.1 {data reuse} { - set x 0 - catch { - lindex $x $x - } result - set result -} {0} -test lindex-16.2 {data reuse} { - set a 0 - catch { - lindex $a $a $a - } result - set result -} 0 -test lindex-16.3 {data reuse} { - set a 1 - catch { - lindex $a $a $a - } result - set result -} {} -test lindex-16.4 {data reuse} { - set x [list 0 0] - catch { - lindex $x $x - } result - set result -} {0} -test lindex-16.5 {data reuse} { - set x 0 - catch { - lindex $x [list $x $x] - } result - set result -} {0} -test lindex-16.6 {data reuse} { - set x [list 1 1] - catch { - lindex $x $x - } result - set result -} {} -test lindex-16.7 {data reuse} { - set x 1 - catch { - lindex $x [list $x $x] - } result - set result -} {} - -test lindex-17.0 {Bug 1718580} {*}{ - -body { - lindex {} end foo - } - -match glob - -result {bad index "foo"*} - -returnCodes 1 -} - -test lindex-17.1 {Bug 1718580} {*}{ - -body { - lindex a end foo - } - -match glob - -result {bad index "foo"*} - -returnCodes 1 -} +test lindex-15.4 {quoted elements} -body { + catch { + lindex {a b {c d "e} {f g"}} 2 + } result + set result +} -result {c d "e} + +test lindex-16.1 {data reuse} -body { + set x 0 + catch { + lindex $x $x + } result + set result +} -result {0} +test lindex-16.2 {data reuse} -body { + set a 0 + catch { + lindex $a $a $a + } result + set result +} -result 0 +test lindex-16.3 {data reuse} -body { + set a 1 + catch { + lindex $a $a $a + } result + set result +} -result {} +test lindex-16.4 {data reuse} -body { + set x [list 0 0] + catch { + lindex $x $x + } result + set result +} -result {0} +test lindex-16.5 {data reuse} -body { + set x 0 + catch { + lindex $x [list $x $x] + } result + set result +} -result {0} +test lindex-16.6 {data reuse} -body { + set x [list 1 1] + catch { + lindex $x $x + } result + set result +} -result {} +test lindex-16.7 {data reuse} -body { + set x 1 + catch { + lindex $x [list $x $x] + } result + set result +} -result {} + +test lindex-17.0 {Bug 1718580} -body { + lindex {} end foo +} -match glob -result {bad index "foo"*} -returnCodes 1 +test lindex-17.1 {Bug 1718580} -body { + lindex a end foo +} -match glob -result {bad index "foo"*} -returnCodes 1 catch { unset minus } # cleanup ::tcltest::cleanupTests Index: tests/link.test ================================================================== --- tests/link.test +++ tests/link.test @@ -408,33 +408,33 @@ list [catch { testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {} } msg] $msg $int } {0 {} 47} -test link-9.1 {linkarray usage messages} -returnCodes error -body { +test link-9.1 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body { testlinkarray } -result {wrong # args: should be "testlinkarray option args"} -test link-9.2 {linkarray usage messages} -returnCodes error -body { +test link-9.2 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body { testlinkarray x } -result {bad option "x": must be update, remove, or create} -test link-9.3 {linkarray usage messages} -body { +test link-9.3 {linkarray usage messages} -constraints testlinkarray -body { testlinkarray update } -result {} -test link-9.4 {linkarray usage messages} -body { +test link-9.4 {linkarray usage messages} -constraints testlinkarray -body { testlinkarray remove } -result {} -test link-9.5 {linkarray usage messages} -returnCodes error -body { +test link-9.5 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body { testlinkarray create } -result {wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"} -test link-9.6 {linkarray usage messages} -returnCodes error -body { +test link-9.6 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body { testlinkarray create xx 1 my } -result {bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary} -test link-9.7 {linkarray usage messages} -returnCodes error -body { +test link-9.7 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body { testlinkarray create char* 0 my } -result {wrong array size given} -test link-10.1 {linkarray char*} -setup { +test link-10.1 {linkarray char*} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create char* 1 ::my(var) lappend mylist [set ::my(var) ""] catch {set ::my(var) x} msg @@ -441,29 +441,29 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{} {can't set "::my(var)": wrong size of char* value}} -test link-10.2 {linkarray char*} -body { +test link-10.2 {linkarray char*} -constraints testlinkarray -body { testlinkarray create char* 4 ::my(var) set ::my(var) x catch {set ::my(var) xyzz} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": wrong size of char* value} -test link-10.3 {linkarray char*} -body { +test link-10.3 {linkarray char*} -constraints testlinkarray -body { testlinkarray create -r char* 4 ::my(var) catch {set ::my(var) x} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-11.1 {linkarray char} -setup { +test link-11.1 {linkarray char} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create char 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -472,11 +472,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have char value} 120 {can't set "::my(var)": variable must have char value}} -test link-11.2 {linkarray char} -setup { +test link-11.2 {linkarray char} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create char 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -484,20 +484,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-11.3 {linkarray char} -body { +test link-11.3 {linkarray char} -constraints testlinkarray -body { testlinkarray create -r char 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-12.1 {linkarray unsigned char} -setup { +test link-12.1 {linkarray unsigned char} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create uchar 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -508,11 +508,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have unsigned char value} 120 {can't set "::my(var)": variable must have unsigned char value} {can't set "::my(var)": variable must have unsigned char value}} -test link-12.2 {linkarray unsigned char} -setup { +test link-12.2 {linkarray unsigned char} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create uchar 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -520,20 +520,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-12.3 {linkarray unsigned char} -body { +test link-12.3 {linkarray unsigned char} -constraints testlinkarray -body { testlinkarray create -r uchar 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-13.1 {linkarray short} -setup { +test link-13.1 {linkarray short} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create short 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -542,11 +542,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have short value} 120 {can't set "::my(var)": variable must have short value}} -test link-13.2 {linkarray short} -setup { +test link-13.2 {linkarray short} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create short 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -554,20 +554,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-13.3 {linkarray short} -body { +test link-13.3 {linkarray short} -constraints testlinkarray -body { testlinkarray create -r short 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-14.1 {linkarray unsigned short} -setup { +test link-14.1 {linkarray unsigned short} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create ushort 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -578,11 +578,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have unsigned short value} 120 {can't set "::my(var)": variable must have unsigned short value} {can't set "::my(var)": variable must have unsigned short value}} -test link-14.2 {linkarray unsigned short} -setup { +test link-14.2 {linkarray unsigned short} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create ushort 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -590,20 +590,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-14.3 {linkarray unsigned short} -body { +test link-14.3 {linkarray unsigned short} -constraints testlinkarray -body { testlinkarray create -r ushort 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-15.1 {linkarray int} -setup { +test link-15.1 {linkarray int} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create int 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -612,11 +612,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have integer value} 120 {can't set "::my(var)": variable must have integer value}} -test link-15.2 {linkarray int} -setup { +test link-15.2 {linkarray int} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create int 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -624,20 +624,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-15.3 {linkarray int} -body { +test link-15.3 {linkarray int} -constraints testlinkarray -body { testlinkarray create -r int 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-16.1 {linkarray unsigned int} -setup { +test link-16.1 {linkarray unsigned int} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create uint 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -648,11 +648,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain ::my } -result {{can't set "::my(var)": variable must have unsigned int value} 120 {can't set "::my(var)": variable must have unsigned int value} {can't set "::my(var)": variable must have unsigned int value}} -test link-16.2 {linkarray unsigned int} -setup { +test link-16.2 {linkarray unsigned int} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create uint 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -660,20 +660,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain ::my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-16.3 {linkarray unsigned int} -body { +test link-16.3 {linkarray unsigned int} -constraints testlinkarray -body { testlinkarray create -r uint 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-17.1 {linkarray long} -setup { +test link-17.1 {linkarray long} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create long 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -682,11 +682,11 @@ lappend mylist $msg } -match glob -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have * value} 120 {can't set "::my(var)": variable must have * value}} -test link-17.2 {linkarray long} -setup { +test link-17.2 {linkarray long} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create long 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -694,20 +694,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-17.3 {linkarray long} -body { +test link-17.3 {linkarray long} -constraints testlinkarray -body { testlinkarray create -r long 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-18.1 {linkarray unsigned long} -setup { +test link-18.1 {linkarray unsigned long} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create ulong 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -716,20 +716,20 @@ lappend mylist $msg } -match glob -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have unsigned * value} 120 {can't set "::my(var)": variable must have unsigned * value}} -test link-18.2 {linkarray unsigned long} -body { +test link-18.2 {linkarray unsigned long} -constraints testlinkarray -body { testlinkarray create ulong 1 ::my(var) set ::my(var) 120 catch {set ::my(var) -1} msg return $msg } -match glob -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": variable must have unsigned * value} -test link-18.3 {linkarray unsigned long} -setup { +test link-18.3 {linkarray unsigned long} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create ulong 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -737,20 +737,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-18.4 {linkarray unsigned long} -body { +test link-18.4 {linkarray unsigned long} -constraints testlinkarray -body { testlinkarray create -r ulong 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-19.1 {linkarray wide} -setup { +test link-19.1 {linkarray wide} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create wide 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -759,11 +759,11 @@ lappend mylist $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have wide integer value} 120 {can't set "::my(var)": variable must have wide integer value}} -test link-19.2 {linkarray wide} -setup { +test link-19.2 {linkarray wide} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create wide 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -771,20 +771,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-19.3 {linkarray wide} -body { +test link-19.3 {linkarray wide} -constraints testlinkarray -body { testlinkarray create -r wide 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-20.1 {linkarray unsigned wide} -setup { +test link-20.1 {linkarray unsigned wide} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create uwide 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg @@ -794,20 +794,20 @@ lappend mylist [set ::my(var) 0xbabed00dbabed00d] } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": variable must have unsigned wide int value} 120 {can't set "::my(var)": variable must have unsigned wide int value} 0xbabed00dbabed00d} -test link-20.2 {linkarray unsigned wide} -body { +test link-20.2 {linkarray unsigned wide} -constraints testlinkarray -body { testlinkarray create uwide 1 ::my(var) set ::my(var) 120 catch {set ::my(var) -1} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": variable must have unsigned wide int value} -test link-20.3 {linkarray unsigned wide} -setup { +test link-20.3 {linkarray unsigned wide} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create uwide 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg @@ -815,20 +815,20 @@ lappend mylist $my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} -test link-20.4 {linkarray unsigned wide} -body { +test link-20.4 {linkarray unsigned wide} -constraints testlinkarray -body { testlinkarray create -r uwide 2 ::my(var) catch {set ::my(var) {1 2}} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-21.1 {linkarray string} -setup { +test link-21.1 {linkarray string} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create string 1 ::my(var) lappend mylist [set ::my(var) ""] lappend mylist [set ::my(var) "xyz"] @@ -835,20 +835,20 @@ lappend mylist $::my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{} xyz xyz} -test link-21.2 {linkarray string} -body { +test link-21.2 {linkarray string} -constraints testlinkarray -body { testlinkarray create -r string 4 ::my(var) catch {set ::my(var) x} msg return $msg } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {can't set "::my(var)": linked variable is read-only} -test link-22.1 {linkarray binary} -setup { +test link-22.1 {linkarray binary} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create binary 1 ::my(var) set ::my(var) x catch {set ::my(var) xy} msg @@ -856,11 +856,11 @@ lappend mylist $::my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong size of binary value} x} -test link-22.2 {linkarray binary} -setup { +test link-22.2 {linkarray binary} -constraints testlinkarray -setup { set mylist [list] } -body { testlinkarray create binary 4 ::my(var) catch {set ::my(var) abc} msg lappend mylist $msg @@ -870,11 +870,11 @@ lappend mylist $::my(var) } -cleanup { testlinkarray remove ::my(var) unset -nocomplain my } -result {{can't set "::my(var)": wrong size of binary value} {can't set "::my(var)": wrong size of binary value} abcd} -test link-22.3 {linkarray binary} -body { +test link-22.3 {linkarray binary} -constraints testlinkarray -body { testlinkarray create -r binary 4 ::my(var) catch {set ::my(var) xyzv} msg return $msg } -cleanup { testlinkarray remove ::my(var) Index: tests/lpop.test ================================================================== --- tests/lpop.test +++ tests/lpop.test @@ -14,43 +14,48 @@ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } +unset -nocomplain no; # following tests expecting var "no" does not exists test lpop-1.1 {error conditions} -returnCodes error -body { lpop no } -result {can't read "no": no such variable} test lpop-1.2 {error conditions} -returnCodes error -body { lpop no 0 } -result {can't read "no": no such variable} test lpop-1.3 {error conditions} -returnCodes error -body { - set no "x {}x" - lpop no + set l "x {}x" + lpop l } -result {list element in braces followed by "x" instead of space} test lpop-1.4 {error conditions} -returnCodes error -body { - set no "x y" - lpop no -1 -} -result {list index out of range} + set l "x y" + lpop l -1 +} -result {index "-1" out of range} +test lpop-1.4b {error conditions (also check SF on empty list variable, bug [234d6c811d])} -body { + set l "x y" + list [lpop l] [lpop l] [catch {lpop l} v] $v [catch {lpop l 0} v] $v $l +} -result {y x 1 {index "end" out of range} 1 {index "0" out of range} {}} test lpop-1.5 {error conditions} -returnCodes error -body { - set no "x y z" - lpop no 3 -} -result {list index out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX} + set l "x y z" + lpop l 3 +} -result {index "3" out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX} test lpop-1.6 {error conditions} -returnCodes error -body { - set no "x y" - lpop no end+1 -} -result {list index out of range} + set l "x y" + lpop l end+1 +} -result {index "end+1" out of range} test lpop-1.7 {error conditions} -returnCodes error -body { - set no "x y" - lpop no {} + set l "x y" + lpop l {} } -match glob -result {bad index *} test lpop-1.8 {error conditions} -returnCodes error -body { - set no "x y" - lpop no 0 0 0 0 1 -} -result {list index out of range} + set l "x y" + lpop l 0 0 0 0 1 +} -result {index "1" out of range} test lpop-1.9 {error conditions} -returnCodes error -body { - set no "x y" - lpop no {1 0} + set l "x y" + lpop l {1 0} } -match glob -result {bad index *} test lpop-2.1 {basic functionality} -body { set l "x y z" list [lpop l 0] $l Index: tests/lrange.test ================================================================== --- tests/lrange.test +++ tests/lrange.test @@ -18,11 +18,10 @@ ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testpurebytesobj [llength [info commands testpurebytesobj]] - test lrange-1.1 {range of list elements} { lrange {a b c d} 1 2 } {b c} test lrange-1.2 {range of list elements} { @@ -100,13 +99,13 @@ list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3] } [lrepeat 4 {}] test lrange-3.3 {compiled with calculated indices out of range, negative constant} { list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1] } [lrepeat 4 {}] -test lrange-3.4 {compiled with calculated indices out of range, after end} { +test lrange-3.4 {compiled with calculated indices out of range, after end} -body { list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2] -} [lrepeat 4 {}] +} -result [lrepeat 4 {}] test lrange-3.5 {compiled with calculated indices, start out of range (negative)} { list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1] } [lrepeat 4 {a b}] test lrange-3.6 {compiled with calculated indices, end out of range (after end)} { @@ -115,35 +114,39 @@ test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \ [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1] } [lrepeat 6 {}] -test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { +test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -body { set cmd lrange list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \ [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1] -} [lrepeat 6 {}] +} -result [lrepeat 6 {}] # following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep # (as before the fix [58c46e74b931d3a1]): test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} { list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \ [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1] } [lrepeat 6 {}] -test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} { +test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -body { set cmd lrange list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \ [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1] -} [lrepeat 6 {}] -test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} { +} -result [lrepeat 6 {}] +test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { + testpurebytesobj +} -body { list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \ [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1] -} [lrepeat 6 {}] -test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} { +} -result [lrepeat 6 {}] +test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { + testpurebytesobj +} -body { set cmd lrange list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \ [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1] -} [lrepeat 6 {}] +} -result [lrepeat 6 {}] test lrange-4.1 {lrange pure promise} -body { set ll1 [list $tcl_version 2 3 4] # Shared set ll2 $ll1 @@ -220,28 +223,28 @@ set expected [list [catch {$lrange $ls $a $b} m] $m] # Shared, compiled set tester [list lrange $ls $a $b] set script [list catch $tester m] set script "list \[$script\] \$m" - test lrange-5.[incr n].1 {lrange shared compiled} \ - [list apply [list {} $script]] $expected + test lrange-5.[incr n].1 {lrange shared compiled} -body \ + [list apply [list {} $script]] -result $expected # Unshared, uncompiled set tester [string map [list %l [list $ls] %a $a %b $b] { [string cat l range] [lrange %l 0 end] %a %b }] set script [list catch $tester m] set script "list \[$script\] \$m" - test lrange-5.$n.2 {lrange unshared uncompiled} \ - [list apply [list {} $script]] $expected + test lrange-5.$n.2 {lrange unshared uncompiled} -body \ + [list apply [list {} $script]] -result $expected # Unshared, compiled set tester [string map [list %l [list $ls] %a $a %b $b] { lrange [lrange %l 0 end] %a %b }] set script [list catch $tester m] set script "list \[$script\] \$m" - test lrange-5.$n.3 {lrange unshared compiled} \ - [list apply [list {} $script]] $expected + test lrange-5.$n.3 {lrange unshared compiled} -body \ + [list apply [list {} $script]] -result $expected } } } }} Index: tests/lreplace.test ================================================================== --- tests/lreplace.test +++ tests/lreplace.test @@ -109,31 +109,31 @@ } -returnCodes 1 -result {foo} test lreplace-1.30 {lreplace command} -body { lreplace {not {}alist} 0 0 [error foo] } -returnCodes 1 -result {foo} -test lreplace-2.1 {lreplace errors} { +test lreplace-2.1 {lreplace errors} -body { list [catch lreplace msg] $msg -} {1 {wrong # args: should be "lreplace list first last ?element ...?"}} -test lreplace-2.2 {lreplace errors} { +} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}} +test lreplace-2.2 {lreplace errors} -body { list [catch {lreplace a b} msg] $msg -} {1 {wrong # args: should be "lreplace list first last ?element ...?"}} -test lreplace-2.3 {lreplace errors} { +} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}} +test lreplace-2.3 {lreplace errors} -body { list [catch {lreplace x a 10} msg] $msg -} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} -test lreplace-2.4 {lreplace errors} { +} -result {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} +test lreplace-2.4 {lreplace errors} -body { list [catch {lreplace x 10 x} msg] $msg -} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} -test lreplace-2.5 {lreplace errors} { +} -result {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} +test lreplace-2.5 {lreplace errors} -body { list [catch {lreplace x 10 1x} msg] $msg -} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} -test lreplace-2.6 {lreplace errors} { +} -result {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} +test lreplace-2.6 {lreplace errors} -body { list [catch {lreplace x 3 2} msg] $msg -} {0 x} -test lreplace-2.7 {lreplace errors} { +} -result {0 x} +test lreplace-2.7 {lreplace errors} -body { list [catch {lreplace x 2 2} msg] $msg -} {0 x} +} -result {0 x} test lreplace-3.1 {lreplace won't modify shared argument objects} { proc p {} { lreplace "a b c" 1 1 "x y" return "a b c" @@ -226,12 +226,12 @@ foreach i $ins { set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m] set tester [list lreplace $ls $a $b {*}$i] set script [list catch $tester m] set script "list \[$script\] \$m" - test lreplace-6.[incr n] {lreplace battery} \ - [list apply [list {} $script]] $expected + test lreplace-6.[incr n] {lreplace battery} -body \ + [list apply [list {} $script]] -result $expected } } } } }} Index: tests/lsearch.test ================================================================== --- tests/lsearch.test +++ tests/lsearch.test @@ -147,18 +147,18 @@ lappend res [lsearch -integer -decreasing -sorted \ $decreasingIntegers $i] } set res } $decreasingIntegers -test lsearch-5.3 {binary search finds leftmost occurances} { +test lsearch-5.3 {binary search finds leftmost occurrences} { set res {} for {set i 0} {$i < 10} {incr i} { lappend res [lsearch -integer -sorted $repeatingIncreasingIntegers $i] } set res } [list 0 5 10 15 20 25 30 35 40 45] -test lsearch-5.4 {binary search -decreasing finds leftmost occurances} { +test lsearch-5.4 {binary search -decreasing finds leftmost occurrences} { set res {} for {set i 9} {$i >= 0} {incr i -1} { lappend res [lsearch -sorted -integer -decreasing \ $repeatingDecreasingIntegers $i] } @@ -430,23 +430,23 @@ test lsearch-17.11 {lsearch -index option, empty argument} { lsearch -index {} [list \{] \{ } [lsearch [list \{] \{] test lsearch-17.12 {lsearch -index option, encoding aliasing} -body { lsearch -index -2 a a -} -returnCodes error -result {index "-2" cannot select an element from any list} +} -returnCodes error -result {index "-2" out of range} test lsearch-17.13 {lsearch -index option, encoding aliasing} -body { lsearch -index -1-1 a a -} -returnCodes error -result {index "-1-1" cannot select an element from any list} +} -returnCodes error -result {index "-1-1" out of range} test lsearch-17.14 {lsearch -index option, encoding aliasing} -body { lsearch -index end--1 a a -} -returnCodes error -result {index "end--1" cannot select an element from any list} +} -returnCodes error -result {index "end--1" out of range} test lsearch-17.15 {lsearch -index option, encoding aliasing} -body { lsearch -index end+1 a a -} -returnCodes error -result {index "end+1" cannot select an element from any list} +} -returnCodes error -result {index "end+1" out of range} test lsearch-17.16 {lsearch -index option, encoding aliasing} -body { lsearch -index end+2 a a -} -returnCodes error -result {index "end+2" cannot select an element from any list} +} -returnCodes error -result {index "end+2" out of range} test lsearch-18.1 {lsearch -index option, list as index basic functionality} { lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a } 1 Index: tests/lset.test ================================================================== --- tests/lset.test +++ tests/lset.test @@ -95,35 +95,35 @@ test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list -1] w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "-1" out of range}} test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list 4] w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "4" out of range}} test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list end--2] w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "end--2" out of range}} test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list end+2] w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "end+2" out of range}} test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a [list end-3] w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "end-3" out of range}} test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex { set a "x \{" list [catch { testevalex {lset a 0 y} } msg] $msg @@ -137,35 +137,35 @@ test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a -1 w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "-1" out of range}} test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a 4 w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "4" out of range}} test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a end--2 w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "end--2" out of range}} test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a end+2 w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "end+2" out of range}} test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} list [catch { testevalex {lset a end-3 w} } msg] $msg -} {1 {list index out of range}} +} {1 {index "end-3" out of range}} test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex { list [catch { testevalex {lset noWrite 0 d} } msg] $msg $noWrite @@ -279,47 +279,47 @@ list [catch {testevalex {lset a {0 2a2} f}} msg] $msg } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.5 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 -1 h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "-1" out of range}} test lset-8.6 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 -1} h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "-1" out of range}} test lset-8.7 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 3 h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "3" out of range}} test lset-8.8 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 3} h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "3" out of range}} test lset-8.9a {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 end--2 h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "end--2" out of range}} test lset-8.9b {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 end+2 h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "end+2" out of range}} test lset-8.10a {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 end--2} h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "end--2" out of range}} test lset-8.10b {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 end+2} h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "end+2" out of range}} test lset-8.11 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a 2 end-2 h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "end-2" out of range}} test lset-8.12 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} list [catch {testevalex {lset a {2 end-2} h}} msg] $msg -} {1 {list index out of range}} +} {1 {index "end-2" out of range}} test lset-9.1 {lset, not compiled, entire variable} testevalex { set a x list [testevalex {lset a y}] $a } {y y} Index: tests/lsetComp.test ================================================================== --- tests/lsetComp.test +++ tests/lsetComp.test @@ -217,11 +217,11 @@ test lsetComp-2.8 {lset, compiled, list of args, error } { evalInProc { set x { {1 2} {3 4} } lset x {1 5} 5 } -} "1 {list index out of range}" +} {1 {index "5" out of range}} test lsetComp-2.9 {lset, compiled, list of args, error - is string preserved} { set ::x { { 1 2 } { 3 4 } } evalInProc { lset ::x { 1 5 } 5 @@ -410,11 +410,11 @@ test lsetComp-3.8 {lset, compiled, flat args, error } { evalInProc { set x { {1 2} {3 4} } lset x 1 5 5 } -} "1 {list index out of range}" +} {1 {index "5" out of range}} test lsetComp-3.9 {lset, compiled, flat args, error - is string preserved} { set ::x { { 1 2 } { 3 4 } } evalInProc { lset ::x 1 5 5 Index: tests/main.test ================================================================== --- tests/main.test +++ tests/main.test @@ -611,11 +611,11 @@ type $f "chan configure stdin -eofchar \\032 if 1 \{\n\032" variable wait chan event $f readable \ [list set [namespace which -variable wait] "child exit"] - set id [after 2000 [list set [namespace which -variable wait] timeout]] + set id [after 5000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { if {$wait eq "timeout" && [testConstraint unix]} { @@ -634,11 +634,11 @@ catch {chan configure $f -blocking 0} } -body { variable wait chan event $f readable \ [list set [namespace which -variable wait] "child exit"] - set id [after 2000 [list set [namespace which -variable wait] timeout]] + set id [after 5000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { if {$wait eq "timeout" && [testConstraint unix]} { Index: tests/mathop.test ================================================================== --- tests/mathop.test +++ tests/mathop.test @@ -112,26 +112,26 @@ test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003 test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005 test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 - } -result {can't use non-numeric string "x" as operand of "+"} + } -result {can't use non-numeric string as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "+"} + } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x - } -result {can't use non-numeric string "x" as operand of "+"} + } -result {can't use non-numeric string as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "+"} + } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "+"} + } -result {can't use invalid octal number as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "+"} + } -result {can't use invalid octal number as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError test mathop-1.18 {compiled +: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments @@ -150,26 +150,26 @@ test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003 test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005 test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string "x" as operand of "+"} + } -result {can't use non-numeric string as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "+"} + } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string "x" as operand of "+"} + } -result {can't use non-numeric string as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "+"} + } -result {can't use non-numeric floating-point value as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "+"} + } -result {can't use invalid octal number as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "+"} + } -result {can't use invalid octal number as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-1.36 {interpreted +: argument processing order} -body { list [catch { @@ -187,26 +187,26 @@ test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000 test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000 test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 - } -result {can't use non-numeric string "x" as operand of "*"} + } -result {can't use non-numeric string as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "*"} + } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x - } -result {can't use non-numeric string "x" as operand of "*"} + } -result {can't use non-numeric string as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "*"} + } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "*"} + } -result {can't use invalid octal number as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "*"} + } -result {can't use invalid octal number as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError test mathop-2.18 {compiled *: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments @@ -225,26 +225,26 @@ test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000 test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000 test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string "x" as operand of "*"} + } -result {can't use non-numeric string as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "*"} + } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string "x" as operand of "*"} + } -result {can't use non-numeric string as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "*"} + } -result {can't use non-numeric floating-point value as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "*"} + } -result {can't use invalid octal number as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "*"} + } -result {can't use invalid octal number as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-2.36 {interpreted *: argument processing order} -body { list [catch { @@ -259,11 +259,11 @@ test mathop-3.5 {compiled !} {! 0.0} 1 test mathop-3.6 {compiled !} {! 10000000000} 0 test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar - } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} + } -returnCodes error -result {can't use non-numeric string as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.10 {compiled !: errors} -body { ! @@ -276,23 +276,23 @@ test mathop-3.15 {interpreted !} {$op 0.0} 1 test mathop-3.16 {interpreted !} {$op 10000000000} 0 test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} + } -returnCodes error -result {can't use non-numeric string as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.20 {interpreted !: errors} -body { $op } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN - } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} + } -result {can't use non-numeric floating-point value as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} + } -result {can't use non-numeric floating-point value as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 test mathop-4.3 {compiled ~} {~ 31} -32 test mathop-4.4 {compiled ~} {~ -127} 126 @@ -299,23 +299,23 @@ test mathop-4.5 {compiled ~} {~ -0} -1 test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001 test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar - } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} + } -returnCodes error -result {can't use non-numeric string as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.10 {compiled ~: errors} -body { ~ } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 - } -result {can't use floating-point value "0.0" as operand of "~"} + } -result {can't use floating-point value as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN - } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} + } -result {can't use non-numeric floating-point value as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 test mathop-4.15 {interpreted ~} {$op 31} -32 test mathop-4.16 {interpreted ~} {$op -127} 126 @@ -322,23 +322,23 @@ test mathop-4.17 {interpreted ~} {$op -0} -1 test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001 test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} + } -returnCodes error -result {can't use non-numeric string as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.22 {interpreted ~: errors} -body { $op } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 - } -result {can't use floating-point value "0.0" as operand of "~"} + } -result {can't use floating-point value as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} + } -result {can't use non-numeric floating-point value as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 test mathop-5.3 {compiled eq} {eq a {}} 0 test mathop-5.4 {compiled eq} {eq a b} 0 @@ -375,36 +375,36 @@ test mathop-6.2 {compiled &} { & 1 } 1 test mathop-6.3 {compiled &} { & 1 2 } 0 test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 - } -result {can't use floating-point value "1.0" as operand of "&"} + } -result {can't use floating-point value as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 - } -result {can't use floating-point value "3.0" as operand of "&"} + } -result {can't use floating-point value as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 - } -result {can't use non-numeric string "x" as operand of "&"} + } -result {can't use non-numeric string as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "&"} + } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x - } -result {can't use non-numeric string "x" as operand of "&"} + } -result {can't use non-numeric string as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "&"} + } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "&"} + } -result {can't use invalid octal number as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "&"} + } -result {can't use invalid octal number as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError test mathop-6.18 {compiled &: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments @@ -417,36 +417,36 @@ test mathop-6.20 {interpreted &} { $op 1 } 1 test mathop-6.21 {interpreted &} { $op 1 2 } 0 test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value "1.0" as operand of "&"} + } -result {can't use floating-point value as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value "3.0" as operand of "&"} + } -result {can't use floating-point value as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string "x" as operand of "&"} + } -result {can't use non-numeric string as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "&"} + } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string "x" as operand of "&"} + } -result {can't use non-numeric string as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "&"} + } -result {can't use non-numeric floating-point value as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "&"} + } -result {can't use invalid octal number as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "&"} + } -result {can't use invalid octal number as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-6.36 {interpreted &: argument processing order} -body { list [catch { @@ -485,36 +485,36 @@ test mathop-7.2 {compiled |} { | 1 } 1 test mathop-7.3 {compiled |} { | 1 2 } 3 test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 - } -result {can't use floating-point value "1.0" as operand of "|"} + } -result {can't use floating-point value as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 - } -result {can't use floating-point value "3.0" as operand of "|"} + } -result {can't use floating-point value as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 - } -result {can't use non-numeric string "x" as operand of "|"} + } -result {can't use non-numeric string as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "|"} + } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x - } -result {can't use non-numeric string "x" as operand of "|"} + } -result {can't use non-numeric string as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "|"} + } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "|"} + } -result {can't use invalid octal number as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "|"} + } -result {can't use invalid octal number as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError test mathop-7.18 {compiled |: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments @@ -527,36 +527,36 @@ test mathop-7.20 {interpreted |} { $op 1 } 1 test mathop-7.21 {interpreted |} { $op 1 2 } 3 test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value "1.0" as operand of "|"} + } -result {can't use floating-point value as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value "3.0" as operand of "|"} + } -result {can't use floating-point value as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string "x" as operand of "|"} + } -result {can't use non-numeric string as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "|"} + } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string "x" as operand of "|"} + } -result {can't use non-numeric string as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "|"} + } -result {can't use non-numeric floating-point value as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "|"} + } -result {can't use invalid octal number as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "|"} + } -result {can't use invalid octal number as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-7.36 {interpreted |: argument processing order} -body { list [catch { @@ -595,36 +595,36 @@ test mathop-8.2 {compiled ^} { ^ 1 } 1 test mathop-8.3 {compiled ^} { ^ 1 2 } 3 test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 - } -result {can't use floating-point value "1.0" as operand of "^"} + } -result {can't use floating-point value as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 - } -result {can't use floating-point value "3.0" as operand of "^"} + } -result {can't use floating-point value as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 - } -result {can't use non-numeric string "x" as operand of "^"} + } -result {can't use non-numeric string as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "^"} + } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x - } -result {can't use non-numeric string "x" as operand of "^"} + } -result {can't use non-numeric string as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "^"} + } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "^"} + } -result {can't use invalid octal number as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "^"} + } -result {can't use invalid octal number as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError test mathop-8.18 {compiled ^: argument processing order} -body { # Bytecode compilation known hard for 3+ arguments @@ -637,36 +637,36 @@ test mathop-8.20 {interpreted ^} { $op 1 } 1 test mathop-8.21 {interpreted ^} { $op 1 2 } 3 test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value "1.0" as operand of "^"} + } -result {can't use floating-point value as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value "3.0" as operand of "^"} + } -result {can't use floating-point value as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string "x" as operand of "^"} + } -result {can't use non-numeric string as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value "nan" as operand of "^"} + } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string "x" as operand of "^"} + } -result {can't use non-numeric string as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value "nan" as operand of "^"} + } -result {can't use non-numeric floating-point value as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use non-numeric string "0o8" as operand of "^"} + } -result {can't use invalid octal number as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use non-numeric string "0o8" as operand of "^"} + } -result {can't use invalid octal number as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError test mathop-8.36 {interpreted ^: argument processing order} -body { list [catch { @@ -773,17 +773,17 @@ set exp {} foreach vals {x {1 x} {1 1 x} {1 x 1}} { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] - lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\ + lappend exp "can't use non-numeric string as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] - lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\ + lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} } 0 test mathop-20.7 { multi arg } { @@ -848,19 +848,19 @@ 2.8196218755553604e-15 8.10000006561e-27] test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] - lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] - lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] - lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] - lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] - lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { set exp {} foreach op {~ !} { @@ -963,13 +963,13 @@ test mathop-22.4 { unary ops, bad values } { set res {} set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] - lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] - lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 test mathop-23.1 { comparison ops, numerical } { @@ -1078,19 +1078,19 @@ test mathop-24.3 { binary ops, bad values } { set res {} set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] - lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] - lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] - lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] - lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] lappend exp "unmatched open brace in list TCL VALUE LIST BRACE" } @@ -1264,13 +1264,13 @@ lappend res [TestOp ** 2 $big] lappend exp "exponent too large NONE" lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] - lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] - lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-26.1 { misc ops, size combinations } { Index: tests/namespace-old.test ================================================================== --- tests/namespace-old.test +++ tests/namespace-old.test @@ -291,17 +291,16 @@ namespace eval test_ns_hier3b {} } namespace eval test_ns_hier2a {} namespace eval test_ns_hier2b {} } -# TIP 278: secondary lookup disabled for vars, tests disabled with # test namespace-old-5.4 {nested namespaces can access global namespace} { - list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \ + list [namespace eval test_ns_hier1 {set test_ns_var_global}] \ [namespace eval test_ns_hier1 {test_ns_cmd_global}] \ - [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \ + [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \ [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}] -} {{} {cmd in ::} {} {cmd in ::}} +} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}} test namespace-old-5.5 {variables in different namespaces don't conflict} { list [set test_ns_hier1::test_ns_level] \ [set test_ns_hier1::test_ns_hier2::test_ns_level] } {1 2} test namespace-old-5.6 {commands in different namespaces don't conflict} { @@ -467,42 +466,39 @@ proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} { return "cache2 version" } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{cache2 version} {cache2 version}} -# TIP 278: secondary lookup disabled, catch added, result changed from {global version} test namespace-old-6.12 {define test variables} { variable test_ns_cache_var "global version" set trigger {set test_ns_cache_var} - list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg -} {1 {can't read "test_ns_cache_var": no such variable}} + namespace eval test_ns_cache1 $trigger +} {global version} set trigger {set test_ns_cache_var} test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } namespace eval test_ns_cache1 $trigger } {cache1 version} variable ::test_ns_cache_var "global version" -# TIP 278: secondary lookup disabled, catch added, result changed from {global version} test namespace-old-6.14 {deleting variables changes variable epoch} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 {unset test_ns_cache_var}] \ - [catch {namespace eval test_ns_cache1 $trigger}] -} {{cache1 version} {} 1} -# TIP 278: secondary lookup disabled, catch added, result changed + [namespace eval test_ns_cache1 $trigger] +} {{cache1 version} {} {global version}} test namespace-old-6.15 {define test namespaces} { namespace eval test_ns_cache2 { variable test_ns_cache_var "global cache2 version" } set trigger2 {set test_ns_cache2::test_ns_cache_var} - catch {list [namespace eval test_ns_cache1 $trigger2] \ - [namespace eval test_ns_cache1::test_ns_cache2 $trigger]} -} 1 + list [namespace eval test_ns_cache1 $trigger2] \ + [namespace eval test_ns_cache1::test_ns_cache2 $trigger] +} {{global cache2 version} {global version}} set trigger2 {set test_ns_cache2::test_ns_cache_var} test namespace-old-6.16 {public variables affect all parent namespaces} { variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" list [namespace eval test_ns_cache1 $trigger2] \ [namespace eval test_ns_cache1::test_ns_cache2 $trigger] Index: tests/namespace.test ================================================================== --- tests/namespace.test +++ tests/namespace.test @@ -44,13 +44,13 @@ } {:: :: ::} test namespace-2.2 {Tcl_GetCurrentNamespace} { set l {} lappend l [namespace current] namespace eval test_ns_1 { - lappend ::l [namespace current] + lappend l [namespace current] namespace eval foo { - lappend ::l [namespace current] + lappend l [namespace current] } } lappend l [namespace current] } {:: ::test_ns_1 ::test_ns_1::foo ::} @@ -644,12 +644,10 @@ namespace eval test_ns_1 { list [catch {set ::test_ns_777::v} msg] $msg \ [catch {namespace children test_ns_777} msg] $msg } } -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} - -# TIP 278: secondary lookup disabled, results changed from {10 20} test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 namespace eval test_ns_1::test_ns_2 { variable v 20 @@ -657,15 +655,13 @@ namespace eval test_ns_2 { variable v 30 } } -body { namespace eval test_ns_1 { - # list $v $test_ns_2::v - list [catch {set v} msg] $msg [catch {set test_ns_2::v} msg] $msg + list $v $test_ns_2::v } -} -result {1 {can't read "v": no such variable} 0 20} - +} -result {10 20} test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { namespace eval foo {} } namespace eval test_ns_1 { @@ -722,21 +718,19 @@ } -body { lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} lappend l [test_ns_1::test_ns_2:: hello] } -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} - -# TIP 278: secondary lookup disabled, added catch, result changed from y test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { variable {} - catch {set test_ns_1::(x) y} ::msg + set test_ns_1::(x) y } - list $::msg [catch {set test_ns_1::(x)} msg] $msg -} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}} + set test_ns_1::(x) +} -result y test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -returnCodes error -body { namespace eval test_ns_1 { proc {} {} {} @@ -905,19 +899,17 @@ } -body { namespace eval test_ns_1 { set x } } -result {777} - -# TIP 278: secondary lookup disabled, catch added, result changed from 314159 test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { namespace eval test_ns_1 { variable x 777 unset x - list [catch {set x} msg] $msg ;# must not be global x now + set x ;# must be global x now } -} {1 {can't read "x": no such variable}} +} {314159} test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body { namespace eval test_ns_1 { set wuzzat } } -returnCodes error -result {can't read "wuzzat": no such variable} @@ -925,12 +917,10 @@ namespace eval test_ns_1 { variable a hello } set test_ns_1::a } {hello} - -# TIP 278: secondary lookup disabled, result changed from 1 test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup { namespace eval test_ns_1 {} } -body { proc test_ns {} { set ::test_ns_1::a 0 @@ -940,11 +930,11 @@ namespace eval test_ns_1 unset a set a 0 namespace eval test_ns_1 set a 1 namespace delete test_ns_1 return $a -} -result 0 +} -result 1 catch {unset a} catch {unset x} catch {unset l} catch {rename foo {}} @@ -1561,12 +1551,10 @@ [namespace which p] \ [namespace which cmd1] \ [namespace which ::test_ns_2::cmd2] } } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} - -# TIP 278: secondary lookup disabled, catch added, result changed test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { namespace export cmd* proc cmd1 {args} {return "cmd1: $args"} @@ -1582,16 +1570,16 @@ variable v3 333 namespace import ::test_ns_2::* } } -body { namespace eval test_ns_3 { - list [catch {namespace which -variable env } msg] $msg \ + list [namespace which -variable env] \ [namespace which -variable v3] \ [namespace which -variable ::test_ns_2::v2] \ [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg } -} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}} +} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { @@ -2634,10 +2622,11 @@ lappend result [::test_ns_1::test_ns_2::pathtestA] } -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1} {global,global,global,:: ::test_ns_1}" -cleanup { namespace delete ::test_ns_1 catch {rename ::pathtestB {}} catch {rename ::pathtestD {}} + catch {rename ::pathtestC {}} } test namespace-51.7 {name resolution path control} -body { namespace eval ::test_ns_1 { } namespace eval ::test_ns_2 { Index: tests/oo.test ================================================================== --- tests/oo.test +++ tests/oo.test @@ -109,12 +109,12 @@ } -cleanup { foo destroy } -result 0 test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ - [package present TclOO] [package versions TclOO] -} [list TclOO $::oo::patchlevel $::oo::patchlevel] + [package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}] +} [list TclOO $::oo::patchlevel 1] test oo-1.1 {basic test of OO functionality: no classes} { set result {} lappend result [oo::object create foo] lappend result [oo::objdefine foo { @@ -311,10 +311,44 @@ oo::class destroy } } -cleanup { interp delete slave } +test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup { + interp create slave +} -body { + slave eval { + oo::class create A + oo::class create B { + superclass oo::class + constructor {} { + next {superclass A} + next {superclass -append A} + } + } + [B create C] create d + } +} -returnCodes error -cleanup { + interp delete slave +} -result {class should only be a direct superclass once} +test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup { + interp create slave +} -body { + slave eval { + oo::class create A + oo::class create B { + superclass oo::class + constructor {c} { + next {superclass A} + next [list superclass -append {*}$c] + } + } + [B create C {B C}] create d + } +} -returnCodes error -cleanup { + interp delete slave +} -result {attempt to form circular dependency graph} test oo-1.19 {basic test of OO functionality: teardown order} -body { oo::object create o namespace delete [info object namespace o] o destroy # Crashes on error @@ -1420,10 +1454,39 @@ oo::define boo {mixin mixin} oo::class create spong {superclass boo} return } } -result {} +test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { + set ::result "" + oo::class create c1 { + method m1 {} { + lappend ::result c1::m1 + } + } + oo::class create c2 { + superclass c1 + destructor { + lappend ::result c2::destructor + my m1 + lappend ::result /c2::destructor + } + method m1 {} { + lappend ::result c2::m1 + rename [self] {} + lappend ::result no-self + next + lappend ::result /c2::m1 + } + } +} -body { + c2 create o + lappend ::result [catch {o m1} msg] $msg +} -cleanup { + c1 destroy + unset ::result +} -result {c2::m1 c2::destructor c2::m1 no-self c1::m1 /c2::m1 /c2::destructor no-self 1 {no next method implementation}} test oo-8.1 {OO: global must work in methods} { oo::object create foo oo::objdefine foo method bar x {global result; lappend result $x} set result {} Index: tests/opt.test ================================================================== --- tests/opt.test +++ tests/opt.test @@ -15,11 +15,11 @@ package require tcltest namespace import -force ::tcltest::* } # the package we are going to test -package require opt 0.4.6 +package require opt 0.4.7 # we are using implementation specifics to test the package #### functions tests ##### Index: tests/parse.test ================================================================== --- tests/parse.test +++ tests/parse.test @@ -374,16 +374,16 @@ set aresult $result set acode $code return "new result" } set handler1 [testasync create async1] - set ::aresult xxx - set ::acode yyy + set aresult xxx + set acode yyy } -cleanup { testasync delete } -body { - list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult + list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult } -result {{new result} 0 original} test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { list [catch {testevalobjv 0 error message} msg] $msg } {1 message} test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv { Index: tests/pid.test ================================================================== --- tests/pid.test +++ tests/pid.test @@ -19,11 +19,11 @@ testConstraint pidDefined [llength [info commands pid]] test pid-1.1 {pid command} pidDefined { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 -test pid-1.2 {pid command} -constraints {unixOrPc unixExecs pidDefined} -setup { +test pid-1.2 {pid command} -constraints {unixOrWin unixExecs pidDefined} -setup { set path(test1) [makeFile {} test1] file delete $path(test1) } -body { set f [open |[list echo foo | cat >$path(test1)] w] set pids [pid $f] Index: tests/reg.test ================================================================== --- tests/reg.test +++ tests/reg.test @@ -624,10 +624,11 @@ expectMatch 13.13 P "a\\nb" "a\nb" "a\nb" expectMatch 13.14 P "a\\rb" "a\rb" "a\rb" expectMatch 13.15 P "a\\tb" "a\tb" "a\tb" expectMatch 13.16 P "a\\u0008x" "a\bx" "a\bx" expectMatch 13.17 P {a\u008x} "a\bx" "a\bx" +expectError 13.17.1 - {a\ux} EESCAPE expectMatch 13.18 P "a\\u00088x" "a\b8x" "a\b8x" expectMatch 13.19 P "a\\U00000008x" "a\bx" "a\bx" expectMatch 13.20 P {a\U0000008x} "a\bx" "a\bx" expectMatch 13.21 P "a\\vb" "a\vb" "a\vb" expectMatch 13.22 MP "a\\x08x" "a\bx" "a\bx" Index: tests/regexp.test ================================================================== --- tests/regexp.test +++ tests/regexp.test @@ -540,137 +540,137 @@ exec [interpreter] $junk } -cleanup { removeFile junk.tcl } -result 1 -test regexp-15.1 {regexp -start} { +test regexp-15.1 {regexp -start} -body { unset -nocomplain x list [regexp -start -10 {\d} 1abc2de3 x] $x -} {1 1} -test regexp-15.2 {regexp -start} { +} -result {1 1} +test regexp-15.2 {regexp -start} -body { unset -nocomplain x list [regexp -start 2 {\d} 1abc2de3 x] $x -} {1 2} -test regexp-15.3 {regexp -start} { +} -result {1 2} +test regexp-15.3 {regexp -start} -body { unset -nocomplain x list [regexp -start 4 {\d} 1abc2de3 x] $x -} {1 2} -test regexp-15.4 {regexp -start} { +} -result {1 2} +test regexp-15.4 {regexp -start} -body { unset -nocomplain x list [regexp -start 5 {\d} 1abc2de3 x] $x -} {1 3} -test regexp-15.5 {regexp -start, over end of string} { +} -result {1 3} +test regexp-15.5 {regexp -start, over end of string} -body { unset -nocomplain x list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] -} {0 0} -test regexp-15.6 {regexp -start, loss of ^$ behavior} { +} -result {0 0} +test regexp-15.6 {regexp -start, loss of ^$ behavior} -body { list [regexp -start 2 {^$} {}] -} {0} -test regexp-15.7 {regexp -start, double option} { +} -result {0} +test regexp-15.7 {regexp -start, double option} -body { regexp -start 2 -start 0 a abc -} 1 -test regexp-15.8 {regexp -start, double option} { +} -result 1 +test regexp-15.8 {regexp -start, double option} -body { regexp -start 0 -start 2 a abc -} 0 -test regexp-15.9 {regexp -start, end relative index} { +} -result 0 +test regexp-15.9 {regexp -start, end relative index} -body { unset -nocomplain x list [regexp -start end {\d} 1abc2de3 x] [info exists x] -} {0 0} -test regexp-15.10 {regexp -start, end relative index} { +} -result {0 0} +test regexp-15.10 {regexp -start, end relative index} -body { unset -nocomplain x list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x -} {1 1 3} -test regexp-15.11 {regexp -start, over end of string} { +} -result {1 1 3} +test regexp-15.11 {regexp -start, over end of string} -body { set x NA list [regexp -start 2 {.*} ab x] $x -} {1 {}} +} -result {1 {}} -test regexp-16.1 {regsub -start} { +test regexp-16.1 {regsub -start} -body { unset -nocomplain x list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x -} {4 a1b/2c/3d/4e/5} -test regexp-16.2 {regsub -start} { +} -result {4 a1b/2c/3d/4e/5} +test regexp-16.2 {regsub -start} -body { unset -nocomplain x list [regsub -all -start -25 {z} hello {/&} x] $x -} {0 hello} -test regexp-16.3 {regsub -start} { +} -result {0 hello} +test regexp-16.3 {regsub -start} -body { unset -nocomplain x list [regsub -all -start 3 {z} hello {/&} x] $x -} {0 hello} -test regexp-16.4 {regsub -start, \A behavior} { +} -result {0 hello} +test regexp-16.4 {regsub -start, \A behavior} -body { set out {} lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x -} {5 /a/b/c/d/e 3 ab/c/d/e} -test regexp-16.5 {regsub -start, double option} { +} -result {5 /a/b/c/d/e 3 ab/c/d/e} +test regexp-16.5 {regsub -start, double option} -body { list [regsub -start 2 -start 0 a abc c x] $x -} {1 cbc} -test regexp-16.6 {regsub -start, double option} { +} -result {1 cbc} +test regexp-16.6 {regsub -start, double option} -body { list [regsub -start 0 -start 2 a abc c x] $x -} {0 abc} -test regexp-16.7 {regexp -start, end relative index} { +} -result {0 abc} +test regexp-16.7 {regexp -start, end relative index} -body { list [regsub -start end a aaa b x] $x -} {0 aaa} -test regexp-16.8 {regexp -start, end relative index} { +} -result {0 aaa} +test regexp-16.8 {regexp -start, end relative index} -body { list [regsub -start end-1 a aaa b x] $x -} {1 aab} -test regexp-16.9 {regsub -start and -all} { +} -result {1 aab} +test regexp-16.9 {regsub -start and -all} -body { set foo {} list [regsub -start 0 -all x+ axxxbxx |&| foo] $foo -} {2 a|xxx|b|xx|} -test regexp-16.10 {regsub -start and -all} { +} -result {2 a|xxx|b|xx|} +test regexp-16.10 {regsub -start and -all} -body { set foo {} list [regsub -start 1 -all x+ axxxbxx |&| foo] $foo -} {2 a|xxx|b|xx|} -test regexp-16.11 {regsub -start and -all} { +} -result {2 a|xxx|b|xx|} +test regexp-16.11 {regsub -start and -all} -body { set foo {} list [regsub -start 4 -all x+ axxxbxx |&| foo] $foo -} {1 axxxb|xx|} -test regexp-16.12 {regsub -start} { +} -result {1 axxxb|xx|} +test regexp-16.12 {regsub -start} -body { set foo {} list [regsub -start 4 x+ axxxbxx |&| foo] $foo -} {1 axxxb|xx|} -test regexp-16.13 {regsub -start and -all} { +} -result {1 axxxb|xx|} +test regexp-16.13 {regsub -start and -all} -body { set foo {} list [regsub -start 1 -all a+ "" & foo] $foo -} {0 {}} -test regexp-16.14 {regsub -start} { +} -result {0 {}} +test regexp-16.14 {regsub -start} -body { set foo {} list [regsub -start 1 a+ "" & foo] $foo -} {0 {}} -test regexp-16.15 {regsub -start and -all} { +} -result {0 {}} +test regexp-16.15 {regsub -start and -all} -body { set foo {} list [regsub -start 2 -all a+ "xy" & foo] $foo -} {0 xy} -test regexp-16.16 {regsub -start} { +} -result {0 xy} +test regexp-16.16 {regsub -start} -body { set foo {} list [regsub -start 2 a+ "xy" & foo] $foo -} {0 xy} -test regexp-16.17 {regsub -start and -all} { +} -result {0 xy} +test regexp-16.17 {regsub -start and -all} -body { set foo {} list [regsub -start 1 -all y+ "xy" & foo] $foo -} {1 xy} -test regexp-16.18 {regsub -start} { +} -result {1 xy} +test regexp-16.18 {regsub -start} -body { set foo {} list [regsub -start 1 y+ "xy" & foo] $foo -} {1 xy} -test regexp-16.19 {regsub -start} { +} -result {1 xy} +test regexp-16.19 {regsub -start} -body { set foo {} list [regsub -start -1 a+ "" & foo] $foo -} {0 {}} -test regexp-16.20 {regsub -start, loss of ^$ behavior} { +} -result {0 {}} +test regexp-16.20 {regsub -start, loss of ^$ behavior} -body { set foo NA list [regsub -start 1 {^$} {} & foo] $foo -} {0 {}} -test regexp-16.21 {regsub -start, loss of ^$ behavior} { +} -result {0 {}} +test regexp-16.21 {regsub -start, loss of ^$ behavior} -body { set foo NA list [regsub -start 1 {^.*$} abc & foo] $foo -} {0 abc} -test regexp-16.22 {regsub -start, loss of ^$ behavior} { +} -result {0 abc} +test regexp-16.22 {regsub -start, loss of ^$ behavior} -body { set foo NA list [regsub -all -start 1 {^.*$} abc & foo] $foo -} {0 abc} +} -result {0 abc} test regexp-17.1 {regexp -inline} { regexp -inline b ababa } {b} test regexp-17.2 {regexp -inline} { @@ -752,49 +752,49 @@ regsub -all {@} {@hel@lo@} "\0a\0" result set expected "\0a\0hel\0a\0lo\0a\0" string equal $result $expected } 1 -test regexp-20.1 {regsub shared object shimmering} { +test regexp-20.1 {regsub shared object shimmering} -body { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d list $d [string length $d] [string bytelength $d] -} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] -test regexp-20.2 {regsub shared object shimmering with -about} { +} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] +test regexp-20.2 {regsub shared object shimmering with -about} -body { eval regexp -about abc -} {0 {}} +} -result {0 {}} -test regexp-21.1 {regsub works with empty string} { +test regexp-21.1 {regsub works with empty string} -body { regsub -- ^ {} foo -} {foo} -test regexp-21.2 {regsub works with empty string} { +} -result {foo} +test regexp-21.2 {regsub works with empty string} -body { regsub -- \$ {} foo -} {foo} -test regexp-21.3 {regsub works with empty string offset} { +} -result {foo} +test regexp-21.3 {regsub works with empty string offset} -body { regsub -start 0 -- ^ {} foo -} {foo} -test regexp-21.4 {regsub works with empty string offset} { +} -result {foo} +test regexp-21.4 {regsub works with empty string offset} -body { regsub -start 0 -- \$ {} foo -} {foo} -test regexp-21.5 {regsub works with empty string offset} { +} -result {foo} +test regexp-21.5 {regsub works with empty string offset} -body { regsub -start 3 -- \$ {123} foo -} {123foo} -test regexp-21.6 {regexp works with empty string} { +} -result {123foo} +test regexp-21.6 {regexp works with empty string} -body { regexp -- ^ {} -} {1} -test regexp-21.7 {regexp works with empty string} { +} -result {1} +test regexp-21.7 {regexp works with empty string} -body { regexp -start 0 -- ^ {} -} {1} -test regexp-21.8 {regexp works with empty string offset} { +} -result {1} +test regexp-21.8 {regexp works with empty string offset} -body { regexp -start 3 -- ^ {123} -} {0} -test regexp-21.9 {regexp works with empty string offset} { +} -result {0} +test regexp-21.9 {regexp works with empty string offset} -body { regexp -start 3 -- \$ {123} -} {1} +} -result {1} test regexp-21.10 {multiple matches handle newlines} { regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n } "foo\nfoo\nfoo\n" test regexp-21.11 {multiple matches handle newlines} { regsub -all -line -- ^ "a\nb\nc" \# @@ -1094,17 +1094,17 @@ regexp -all -inline -- {^a+} "aab\naaa" } {aa} test regexp-26.2 {matches start of line(s) 2 times} { regexp -all -inline -line -- {^a+} "aab\naaa" } {aa aaa} -test regexp-26.3 {effect of -line -all and -start} { +test regexp-26.3 {effect of -line -all and -start} -body { list \ [regexp -all -inline -line -start 0 -- {^a+} "aab\naaa"] \ [regexp -all -inline -line -start 1 -- {^a+} "aab\naaa"] \ [regexp -all -inline -line -start 3 -- {^a+} "aab\naaa"] \ [regexp -all -inline -line -start 4 -- {^a+} "aab\naaa"] \ -} {{aa aaa} aaa aaa aaa} +} -result {{aa aaa} aaa aaa aaa} # No regexp-26.4 test regexp-26.5 {match length 0, match length 1} { regexp -all -inline -line -- {^b*} "a\nb" } {{} b} test regexp-26.6 {non reporting capture group} { Index: tests/regexpComp.test ================================================================== --- tests/regexpComp.test +++ tests/regexpComp.test @@ -663,58 +663,58 @@ exec [interpreter] $junk } -cleanup { removeFile junk.tcl } -result 1 -test regexpComp-15.1 {regexp -start} { +test regexpComp-15.1 {regexp -start} -body { unset -nocomplain x list [regexp -start -10 {\d} 1abc2de3 x] $x -} {1 1} -test regexpComp-15.2 {regexp -start} { +} -result {1 1} +test regexpComp-15.2 {regexp -start} -body { unset -nocomplain x list [regexp -start 2 {\d} 1abc2de3 x] $x -} {1 2} -test regexpComp-15.3 {regexp -start} { +} -result {1 2} +test regexpComp-15.3 {regexp -start} -body { unset -nocomplain x list [regexp -start 4 {\d} 1abc2de3 x] $x -} {1 2} -test regexpComp-15.4 {regexp -start} { +} -result {1 2} +test regexpComp-15.4 {regexp -start} -body { unset -nocomplain x list [regexp -start 5 {\d} 1abc2de3 x] $x -} {1 3} -test regexpComp-15.5 {regexp -start, over end of string} { +} -result {1 3} +test regexpComp-15.5 {regexp -start, over end of string} -body { unset -nocomplain x list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] -} {0 0} -test regexpComp-15.6 {regexp -start, loss of ^$ behavior} { +} -result {0 0} +test regexpComp-15.6 {regexp -start, loss of ^$ behavior} -body { list [regexp -start 2 {^$} {}] -} {0} +} -result {0} -test regexpComp-16.1 {regsub -start} { +test regexpComp-16.1 {regsub -start} -body { unset -nocomplain x list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x -} {4 a1b/2c/3d/4e/5} -test regexpComp-16.2 {regsub -start} { +} -result {4 a1b/2c/3d/4e/5} +test regexpComp-16.2 {regsub -start} -body { unset -nocomplain x list [regsub -all -start -25 {z} hello {/&} x] $x -} {0 hello} -test regexpComp-16.3 {regsub -start} { +} -result {0 hello} +test regexpComp-16.3 {regsub -start} -body { unset -nocomplain x list [regsub -all -start 3 {z} hello {/&} x] $x -} {0 hello} -test regexpComp-16.4 {regsub -start, \A behavior} { +} -result {0 hello} +test regexpComp-16.4 {regsub -start, \A behavior} -body { set out {} lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x -} {5 /a/b/c/d/e 3 ab/c/d/e} +} -result {5 /a/b/c/d/e 3 ab/c/d/e} -test regexpComp-17.1 {regexp -inline} { +test regexpComp-17.1 {regexp -inline} -body { regexp -inline b ababa -} {b} -test regexpComp-17.2 {regexp -inline} { +} -result {b} +test regexpComp-17.2 {regexp -inline} -body { regexp -inline (b) ababa -} {b b} +} -result {b b} test regexpComp-17.3 {regexp -inline -indices} { regexp -inline -indices (b) ababa } {{1 1} {1 1}} test regexpComp-17.4 {regexp -inline} { regexp -inline {\w(\d+)\w} " hello 23 there456def " Index: tests/registry.test ================================================================== --- tests/registry.test +++ tests/registry.test @@ -17,11 +17,11 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - set ::regver [package require registry 1.3.3] + set ::regver [package require registry 1.3.5] }]} { testConstraint reg 1 } } @@ -31,11 +31,11 @@ && [string match "English*" [testlocale all ""]] }] test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver -} {1.3.3} +} {1.3.5} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1a {argument parsing for registry command} {win reg} { list [catch {registry -32bit} msg] $msg Index: tests/result.test ================================================================== --- tests/result.test +++ tests/result.test @@ -29,11 +29,11 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult append {set x 42} 0 } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 -} {dynamic result freed} +} {dynamic result presentOrFreed} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} test result-1.5 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult small {set x 42} 1 @@ -41,11 +41,11 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult append {set x 42} 1 } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 -} {42 freed} +} {42 presentOrFreed} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} # Tcl_RestoreInterpResult is mostly tested by the previous tests except Index: tests/scan.test ================================================================== --- tests/scan.test +++ tests/scan.test @@ -553,10 +553,15 @@ set a {}; } -body { list [scan "207698809136909011942886895" \ %llu a] $a } -result {1 207698809136909011942886895} +test scan-5.20 {ignore digit separators} -setup { + set a {}; set b {}; set c {}; +} -body { + list [scan "10_23_45" %d_%d_%d a b c] $a $b $c +} -result {3 10 23 45} test scan-6.1 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d @@ -598,10 +603,15 @@ test scan-6.8 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d } -result {2 4.6 5.2 {} {}} +test scan-6.8 {disallow diget separator in floating-point} -setup { + set a {}; set b {}; set c {}; +} -body { + list [scan "3.14_2.35_98.6" %f_%f_%f a b c ] $a $b $c +} -result {3 3.14 2.35 98.6} test scan-7.1 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} } -body { list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d Index: tests/socket.test ================================================================== --- tests/socket.test +++ tests/socket.test @@ -65,18 +65,20 @@ namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +::tcltest::loadTestedCommands if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} { return } # Some tests require the Thread package or exec command testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] testConstraint exec [llength [info commands exec]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # Produce a random port number in the Dynamic/Private range # from 49152 through 65535. proc randport {} { # firstly try dynamic port via server-socket(0): @@ -1081,11 +1083,11 @@ close $s1 } -result {1 3} test socket_$af-7.5 {testing socket specific options} -setup { set timer [after 10000 "set x timed_out"] set l "" -} -constraints [list socket supported_$af unixOrPc] -body { +} -constraints [list socket supported_$af unixOrWin] -body { set s [socket -server accept 0] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s @@ -1842,10 +1844,109 @@ } close $s thread::release $serverthread append result " " [llength [thread::names]] } -result {hello 1} -constraints [list socket supported_$af thread] + +proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { + try { + set ::count 0 + set ::testmode $testmode + set port 0 + set srvsock {} + # if binding on port 0 is not possible (system related, blocked on ISPs etc): + if {[catch {close [socket -async $::localhost $port]}]} { + # simplest server on random port (immediatelly closing a connect): + set port [randport] + set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port] + # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4): + if {$::tcl_platform(platform) eq "windows" && $maxIter > 50} { + set ::count [expr {$maxIter / 4 * 3 - 1}]; # bypass 3/4 iterations + } + } + tcltest::DebugPuts 1 "== test \[$::localhost\]:$port $testmode ==" + set ::master [thread::id] + # helper thread creating async connection and initiating transfer (detach) to master: + set ::helper [thread::create] + thread::send -async $::helper [list \ + lassign [list $::master $::localhost $port $testmode] \ + ::master ::localhost ::port ::testmode + ] + thread::send -async $::helper { + set ::helper [thread::id] + proc iteration {args} { + set fd [socket -async $::localhost $::port] + if {"helper-writable" in $::testmode} {;# to test both sides during connect + fileevent $fd writable [list apply {{fd} { + if {[thread::id] ne $::helper} { + thread::send -async $::master {set ::count "ERROR: invalid thread, $::helper is expecting"} + close $fd + return + } + }} $fd] + };# + thread::detach $fd + thread::send -async $::master [list transf_master $fd {*}$args] + } + iteration first + } + # master proc commiting transfer attempt (attach) and checking acquire was successful: + proc transf_master {fd args} { + tcltest::DebugPuts 1 "** trma / $::count ** $args **" + thread::attach $fd + if {"master-close" in $::testmode} {;# to test close during connect + set ::count $::count + close $fd + return + };# + fileevent $fd writable [list apply {{fd} { + if {[thread::id] ne $::master} { + thread::send -async $::master {set ::count "ERROR: invalid thread, $::master is expecting"} + close $fd + return + } + set ::count $::count + close $fd + }} $fd] + } + # repeat maxIter times (up to maxTime ms as timeout): + set tout [after $maxTime {set ::count "TIMEOUT"}] + while 1 { + vwait ::count + if {![string is integer $::count]} { + # if timeout just skip (test was successful until now): + if {$::count eq "TIMEOUT"} {::tcltest::Skip "timing issue"} + break + } + if {[incr ::count] >= $maxIter} break + tcltest::DebugPuts 1 "** iter / $::count **" + thread::send -async $::helper [list iteration nr $::count] + } + update + set ::count + } finally { + catch {after cancel $tout} + if {$srvsock ne {}} {close $srvsock} + if {[info exists ::helper]} {thread::release -wait $::helper} + tcltest::DebugPuts 1 "== stop / $::count ==" + unset -nocomplain ::count ::testmode ::master ::helper + } +} +test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body { + transf_test {transfer} 1000 +} -result 1000 -constraints [list socket supported_$af thread] +test socket_$af-13.2.tr2 {Testing socket transfer between threads during async connect} -body { + transf_test {transfer helper-writable} 100 +} -result 100 -constraints [list socket supported_$af thread] +test socket_$af-13.2.cl1 {Testing socket transfer between threads during async connect} -body { + transf_test {master-close} 100 +} -result 100 -constraints [list socket supported_$af thread] +test socket_$af-13.2.cl2 {Testing socket transfer between threads during async connect} -body { + transf_test {master-close helper-writable} 100 +} -result 100 -constraints [list socket supported_$af thread] +catch {rename transf_master {}} +rename transf_test {} # ---------------------------------------------------------------------- removeFile script1 removeFile script2 @@ -2283,11 +2384,11 @@ close $fd close $sock removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ - -constraints {socket} \ + -constraints {socket knownMsvcBug} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts $sock ok fileevent $sock writable {set x 1} Index: tests/source.test ================================================================== --- tests/source.test +++ tests/source.test @@ -238,16 +238,16 @@ # file that contains the byte \x1A, although not the character \u001A in # the indicated encoding. set sourcefile [makeFile {} source.file] file delete $sourcefile set f [open $sourcefile w] - fconfigure $f -encoding unicode + fconfigure $f -encoding utf-16 puts $f "set symbol(square-root) \u221A; set x correct" close $f } -body { set x unset - source -encoding unicode $sourcefile + source -encoding utf-16 $sourcefile set x } -cleanup { removeFile source.file } -result correct test source-7.3 {source -encoding: syntax} -body { Index: tests/split.test ================================================================== --- tests/split.test +++ tests/split.test @@ -69,12 +69,15 @@ } {12 34 56 {}} test split-1.14 {basic split commands} { split ",12,,,34,56," {,} } {{} 12 {} {} 34 56 {}} test split-1.15 {basic split commands} -body { - split "a\U01f4a9b" {} -} -result "a \U01f4a9 b" + split "a\U1F4A9b" {} +} -result "a \U1F4A9 b" +test split-1.16 {basic split commands} -body { + split "a\U1F4A9b" \U1F4A9 +} -result "a b" test split-2.1 {split errors} { list [catch split msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}} test split-2.2 {split errors} { Index: tests/string.test ================================================================== --- tests/string.test +++ tests/string.test @@ -29,11 +29,12 @@ # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] ne {}}] testConstraint testindexobj [expr {[info commands testindexobj] ne {}}] testConstraint testevalex [expr {[info commands testevalex] ne {}}] -testConstraint tip389 [expr {[string length \U010000] == 2}] +testConstraint utf16 [expr {[string length \U010000] == 2}] +testConstraint testbytestring [llength [info commands testbytestring]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { @@ -119,14 +120,14 @@ } {1 {expected integer but got "end-3"}} test string-2.11.$noComp {string compare, unicode} { run {string compare ab\u7266 ab\u7267} } -1 test string-2.11.1.$noComp {string compare, unicode} { - run {string compare \334 \u00dc} + run {string compare \334 \xDC} } 0 test string-2.11.2.$noComp {string compare, unicode} { - run {string compare \334 \u00fc} + run {string compare \334 \xFC} } -1 test string-2.11.3.$noComp {string compare, unicode} { run {string compare \334\334\334\374\374 \334\334\334\334\334} } 1 test string-2.12.$noComp {string compare, high bit} { @@ -149,14 +150,14 @@ } 0 test string-2.15.$noComp {string compare -nocase} { run {string compare -nocase abcde abcde} } 0 test string-2.15.1.$noComp {string compare -nocase} { - run {string compare -nocase \334 \u00dc} + run {string compare -nocase \334 \xDC} } 0 test string-2.15.2.$noComp {string compare -nocase} { - run {string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334} + run {string compare -nocase \334\334\334\374\xFC \334\334\334\334\334} } 0 test string-2.16.$noComp {string compare -nocase with length} { run {string compare -length 2 -nocase abcde Abxyz} } 0 test string-2.17.$noComp {string compare -nocase with length} { @@ -274,14 +275,14 @@ test string-3.16.$noComp {string equal, unicode} { run {string equal ab\u7266 ab\u7267} } 0 test string-3.17.$noComp {string equal, unicode} { - run {string equal \334 \u00dc} + run {string equal \334 \xDC} } 1 test string-3.18.$noComp {string equal, unicode} { - run {string equal \334 \u00fc} + run {string equal \334 \xFC} } 0 test string-3.19.$noComp {string equal, unicode} { run {string equal \334\334\334\374\374 \334\334\334\334\334} } 0 test string-3.20.$noComp {string equal, high bit} { @@ -295,14 +296,14 @@ } 0 test string-3.21.$noComp {string equal -nocase} { run {string equal -nocase abcde Abdef} } 0 test string-3.22.$noComp {string equal, -nocase unicode} { - run {string equal -nocase \334 \u00dc} + run {string equal -nocase \334 \xDC} } 1 test string-3.23.$noComp {string equal, -nocase unicode} { - run {string equal -nocase \334\334\334\374\u00fc \334\334\334\334\334} + run {string equal -nocase \334\334\334\374\xFC \334\334\334\334\334} } 1 test string-3.24.$noComp {string equal -nocase with length} { run {string equal -length 2 -nocase abcde Abxyz} } 1 test string-3.25.$noComp {string equal -nocase with length} { @@ -396,48 +397,48 @@ run {string first \u7266 abc\u7266x} } 3 test string-4.11.$noComp {string first, start index} { run {string first \u7266 abc\u7266x 3} } 3 -test string-4.12.$noComp {string first, start index} { +test string-4.12.$noComp {string first, start index} -body { run {string first \u7266 abc\u7266x 4} -} -1 -test string-4.13.$noComp {string first, start index} { +} -result -1 +test string-4.13.$noComp {string first, start index} -body { run {string first \u7266 abc\u7266x end-2} -} 3 -test string-4.14.$noComp {string first, negative start index} { +} -result 3 +test string-4.14.$noComp {string first, negative start index} -body { run {string first b abc -1} -} 1 -test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} { +} -result 1 +test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body { # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. - set uchar \u057e ;# character with two-byte encoding in utf-8 + set uchar \u057E ;# character with two-byte encoding in utf-8 run {string first % %#$uchar$uchar#$uchar$uchar#% 3} -} 8 -test string-4.16.$noComp {string first, normal string vs pure unicode string} { +} -result 8 +test string-4.16.$noComp {string first, normal string vs pure unicode string} -body { set s hello regexp ll $s m # Representation checks are canaries run {list [representationpoke $s] [representationpoke $m] \ [string first $m $s]} -} {{string 1} {string 0} 2} -test string-4.17.$noComp {string first, corner case} { +} -result {{string 1} {string 0} 2} +test string-4.17.$noComp {string first, corner case} -body { run {string first a aaa 4294967295} -} {-1} -test string-4.18.$noComp {string first, corner case} { +} -result {-1} +test string-4.18.$noComp {string first, corner case} -body { run {string first a aaa -1} -} {0} -test string-4.19.$noComp {string first, corner case} { +} -result {0} +test string-4.19.$noComp {string first, corner case} -body { run {string first a aaa end-5} -} {0} -test string-4.20.$noComp {string last, corner case} { +} -result {0} +test string-4.20.$noComp {string last, corner case} -body { run {string last a aaa 4294967295} -} {2} -test string-4.21.$noComp {string last, corner case} { +} -result {2} +test string-4.21.$noComp {string last, corner case} -body { run {string last a aaa -1} -} {-1} +} -result {-1} test string-4.22.$noComp {string last, corner case} { run {string last a aaa end-5} } {-1} test string-5.1.$noComp {string index} { @@ -471,13 +472,13 @@ run {string index abc\u7266d 4} } d test string-5.11.$noComp {string index, unicode} { run {string index abc\u7266d 3} } \u7266 -test string-5.12.$noComp {string index, unicode over char length, under byte length} { +test string-5.12.$noComp {string index, unicode over char length, under byte length} -body { run {string index \334\374\334\374 6} -} {} +} -result {} test string-5.13.$noComp {string index, bytearray object} { run {string index [binary format a5 fuz] 0} } f test string-5.14.$noComp {string index, bytearray object} { run {string index [binary format I* {0x50515253 0x52}] 3} @@ -493,23 +494,23 @@ binary scan $str H* dump run {string compare [run {string index $str 10}] \x00} } 0 test string-5.17.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" 0o8}} msg] $msg -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test string-5.18.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" end-0o0289}} msg] $msg -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test string-5.19.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] -1} } {} -test string-5.20.$noComp {string index, bytearray object out of bounds} { +test string-5.20.$noComp {string index, bytearray object out of bounds} -body { run {string index [binary format I* {0x50515253 0x52}] 20} -} {} -test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} tip389 { +} -result {} +test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body { run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]} -} [list \U100000 {} b] +} -result [list \U100000 {} b] proc largest_int {} { # This will give us what the largest valid int on this machine is, # so we can test for overflow properly below on >32 bit systems @@ -557,11 +558,11 @@ run {string is alnum abc123} } 1 test string-6.13.$noComp {string is alnum, false} { list [run {string is alnum -failindex var abc1.23}] $var } {0 4} -test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xfc}" 1 +test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xFC}" 1 test string-6.15.$noComp {string is alpha, true} { run {string is alpha abc} } 1 test string-6.16.$noComp {string is alpha, false} { list [run {string is alpha -fail var a1bcde}] $var @@ -568,14 +569,14 @@ } {0 1} test string-6.17.$noComp {string is alpha, unicode} { run {string is alpha abc\374} } 1 test string-6.18.$noComp {string is ascii, true} { - run {string is ascii abc\u007Fend\u0000} + run {string is ascii abc\x7Fend\x00} } 1 test string-6.19.$noComp {string is ascii, false} { - list [run {string is ascii -fail var abc\u0000def\u0080more}] $var + list [run {string is ascii -fail var abc\x00def\x80more}] $var } {0 7} test string-6.20.$noComp {string is boolean, true} { run {string is boolean true} } 1 test string-6.21.$noComp {string is boolean, true} { @@ -589,11 +590,11 @@ } {0 0} test string-6.24.$noComp {string is digit, true} { run {string is digit 0123456789} } 1 test string-6.25.$noComp {string is digit, false} { - list [run {string is digit -fail var 0123\u00dc567}] $var + list [run {string is digit -fail var 0123\xDC567}] $var } {0 4} test string-6.26.$noComp {string is digit, false} { list [run {string is digit -fail var +123567}] $var } {0 0} test string-6.27.$noComp {string is double, true} { @@ -712,20 +713,20 @@ } {0 5} test string-6.60.$noComp {string is lower, true} { run {string is lower abc} } 1 test string-6.61.$noComp {string is lower, unicode true} { - run {string is lower abc\u00fcue} + run {string is lower abc\xFCue} } 1 test string-6.62.$noComp {string is lower, false} { list [run {string is lower -fail var aBc}] $var } {0 1} test string-6.63.$noComp {string is lower, false} { list [run {string is lower -fail var abc1}] $var } {0 3} test string-6.64.$noComp {string is lower, unicode false} { - list [run {string is lower -fail var ab\u00dcUE}] $var + list [run {string is lower -fail var ab\xDCUE}] $var } {0 2} test string-6.65.$noComp {string is space, true} { run {string is space " \t\n\v\f"} } 1 test string-6.66.$noComp {string is space, false} { @@ -759,32 +760,32 @@ } {0 0} test string-6.75.$noComp {string is upper, true} { run {string is upper ABC} } 1 test string-6.76.$noComp {string is upper, unicode true} { - run {string is upper ABC\u00dcUE} + run {string is upper ABC\xDCUE} } 1 test string-6.77.$noComp {string is upper, false} { list [run {string is upper -fail var AbC}] $var } {0 1} test string-6.78.$noComp {string is upper, false} { list [run {string is upper -fail var AB2C}] $var } {0 2} test string-6.79.$noComp {string is upper, unicode false} { - list [run {string is upper -fail var ABC\u00fcue}] $var + list [run {string is upper -fail var ABC\xFCue}] $var } {0 3} test string-6.80.$noComp {string is wordchar, true} { run {string is wordchar abc_123} } 1 test string-6.81.$noComp {string is wordchar, unicode true} { - run {string is wordchar abc\u00fcab\u00dcAB\u5001} + run {string is wordchar abc\xFCab\xDCAB\u5001\U1D7CA} } 1 test string-6.82.$noComp {string is wordchar, false} { list [run {string is wordchar -fail var abcd.ef}] $var } {0 4} test string-6.83.$noComp {string is wordchar, unicode false} { - list [run {string is wordchar -fail var abc\u0080def}] $var + list [run {string is wordchar -fail var abc\x80def}] $var } {0 3} test string-6.84.$noComp {string is control} { ## Control chars are in the ranges ## 00..1F && 7F..9F list [run {string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60}] $var @@ -796,18 +797,18 @@ ## graph is any print char, except space list [run {string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "}] $var } {0 14} test string-6.87.$noComp {string is print} { ## basically any printable char - list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"}] $var + list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\x10"}] $var } {0 15} test string-6.88.$noComp {string is punct} { ## any graph char that isn't alnum - list [run {string is punct -fail var "_!@#\u00beq0"}] $var + list [run {string is punct -fail var "_!@#\xBEq0"}] $var } {0 4} test string-6.89.$noComp {string is xdigit} { - list [run {string is xdigit -fail var 0123456789\u0061bcdefABCDEFg}] $var + list [run {string is xdigit -fail var 0123456789\x61bcdefABCDEFg}] $var } {0 22} test string-6.90.$noComp {string is integer, bad integers} { # SF bug #634856 set result "" @@ -893,11 +894,11 @@ set x 2turtledoves run {string is double $x} run {string is double $x} } 0 test string-6.109.$noComp {string is double, Bug 1360532} { - run {string is double 1\u00a0} + run {string is double 1\xA0} } 0 test string-6.110.$noComp {string is entier, true} { run {string is entier +1234567890} } 1 test string-6.111.$noComp {string is entier, true on type} { @@ -1028,11 +1029,11 @@ } {1 {wrong # args: should be "string bytelength string"}} test string-8.2.$noComp {string bytelength} { list [catch {run {string bytelength a b}} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.3.$noComp {string bytelength} { - run {string bytelength "\u00c7"} + run {string bytelength "\xC7"} } 2 test string-8.4.$noComp {string bytelength} { run {string b ""} } 0 @@ -1376,39 +1377,39 @@ [binary format I 2028036707]} } 1 test string-11.52.$noComp {string match, null char in string} { set out "" set ptn "*abc*" - foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] { + foreach elem [list "\x00@abc" "@abc" "\x00@abc\x00" "blahabcblah"] { lappend out [run {string match $ptn $elem}] } set out } {1 1 1 1} test string-11.53.$noComp {string match, null char in pattern} { set out "" foreach {ptn elem} [list \ - "*\u0000abc\u0000" "\u0000abc\u0000" \ - "*\u0000abc\u0000" "\u0000abc\u0000ef" \ - "*\u0000abc\u0000*" "\u0000abc\u0000ef" \ - "*\u0000abc\u0000" "@\u0000abc\u0000ef" \ - "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \ + "*\x00abc\x00" "\x00abc\x00" \ + "*\x00abc\x00" "\x00abc\x00ef" \ + "*\x00abc\x00*" "\x00abc\x00ef" \ + "*\x00abc\x00" "@\x00abc\x00ef" \ + "*\x00abc\x00*" "@\x00abc\x00ef" \ ] { lappend out [run {string match $ptn $elem}] } set out } {1 0 1 0 1} test string-11.54.$noComp {string match, failure} { set longString "" for {set i 0} {$i < 10} {incr i} { - append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123" + append longString "abcdefghijklmnopqrstuvwxy\x00z01234567890123" } run {string first $longString 123} list [run {string match *cba* $longString}] \ - [run {string match *a*l*\u0000* $longString}] \ - [run {string match *a*l*\u0000*123 $longString}] \ - [run {string match *a*l*\u0000*123* $longString}] \ - [run {string match *a*l*\u0000*cba* $longString}] \ + [run {string match *a*l*\x00* $longString}] \ + [run {string match *a*l*\x00*123 $longString}] \ + [run {string match *a*l*\x00*123* $longString}] \ + [run {string match *a*l*\x00*cba* $longString}] \ [run {string match *===* $longString}] } {0 1 1 1 0 0} test string-11.55.$noComp {string match, invalid binary optimization} { [format string] match \u0141 [binary format c 65] } 0 @@ -1477,12 +1478,12 @@ set r1 [run {string range $b 1 end-1}] set r2 [run {string range $b 1 6}] run {string equal $r1 $r2} } 1 test string-12.20.$noComp {string range, out of bounds indices} { - run {string range \u00ff 0 1} -} \u00ff + run {string range \xFF 0 1} +} \xFF # Bug 1410553 test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} { set bytes "\x00 \x03 \x41" set rxBuffer {} foreach ch $bytes { @@ -1500,11 +1501,11 @@ test string-12.22.$noComp {string range, shimmering binary/index} { set s 0000000001 binary scan $s a* x run {string range $s $s end} } 000000001 -test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} tip389 { +test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf16 { run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]} } [list \U100000 {} b] test string-13.1.$noComp {string repeat} { list [catch {run {string repeat}} msg] $msg @@ -1562,13 +1563,13 @@ test string-14.4.$noComp {string replace} { } {} test string-14.5.$noComp {string replace} { run {string replace abcdefghijklmnop 2 14} } {abp} -test string-14.6.$noComp {string replace} { +test string-14.6.$noComp {string replace} -body { run {string replace abcdefghijklmnop 7 1000} -} {abcdefg} +} -result {abcdefg} test string-14.7.$noComp {string replace} { run {string replace abcdefghijklmnop 10 end} } {abcdefghij} test string-14.8.$noComp {string replace} { run {string replace abcdefghijklmnop 10 9} @@ -1577,13 +1578,13 @@ run {string replace abcdefghijklmnop -3 2} } {defghijklmnop} test string-14.10.$noComp {string replace} { run {string replace abcdefghijklmnop -3 -2} } {abcdefghijklmnop} -test string-14.11.$noComp {string replace} { +test string-14.11.$noComp {string replace} -body { run {string replace abcdefghijklmnop 1000 1010} -} {abcdefghijklmnop} +} -result {abcdefghijklmnop} test string-14.12.$noComp {string replace} { run {string replace abcdefghijklmnop -100 end} } {} test string-14.13.$noComp {string replace} { list [catch {run {string replace abc abc 1}} msg] $msg @@ -1646,11 +1647,11 @@ } string replace $val[unset val] 1 1 $y }} 4 x } 0x00 test stringComp-14.25.$noComp {} { - string length [string replace [string repeat a\u00fe 2] 3 end {}] + string length [string replace [string repeat a\xFE 2] 3 end {}] } 3 test string-15.1.$noComp {string tolower too few args} { list [catch {run {string tolower}} msg] $msg } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} @@ -1677,12 +1678,12 @@ } Abc test string-15.9.$noComp {string tolower} { run {string tolower ABC 0 end-1} } abC test string-15.10.$noComp {string tolower, unicode} { - run {string tolower ABCabc\xc7\xe7} -} "abcabc\xe7\xe7" + run {string tolower ABCabc\xC7\xE7} +} "abcabc\xE7\xE7" test string-15.11.$noComp {string tolower, compiled} { lindex [run {string tolower [list A B [list C]]}] 1 } b test string-16.1.$noComp {string toupper} { @@ -1711,12 +1712,12 @@ } aBC test string-16.9.$noComp {string toupper} { run {string toupper abc 0 end-1} } ABc test string-16.10.$noComp {string toupper, unicode} { - run {string toupper ABCabc\xc7\xe7} -} "ABCABC\xc7\xc7" + run {string toupper ABCabc\xC7\xE7} +} "ABCABC\xC7\xC7" test string-16.11.$noComp {string toupper, compiled} { lindex [run {string toupper [list a b [list c]]}] 1 } B test string-17.1.$noComp {string totitle} { @@ -1733,19 +1734,19 @@ } {Abc xyz} test string-17.5.$noComp {string totitle} { run {string totitle {123#$&*()}} } {123#$&*()} test string-17.6.$noComp {string totitle, unicode} { - run {string totitle ABCabc\xc7\xe7} -} "Abcabc\xe7\xe7" + run {string totitle ABCabc\xC7\xE7} +} "Abcabc\xE7\xE7" test string-17.7.$noComp {string totitle, unicode} { - run {string totitle \u01f3BCabc\xc7\xe7} -} "\u01f2bcabc\xe7\xe7" + run {string totitle \u01F3BCabc\xC7\xE7} +} "\u01F2bcabc\xE7\xE7" test string-17.8.$noComp {string totitle, compiled} { lindex [run {string totitle [list aa bb [list cc]]}] 0 } Aa -test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 { +test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} utf16 { run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \ [string totitle a\U118c0c 3 3]} } [list a\U118a0c a\U118c0C a\U118c0C] test string-18.1.$noComp {string trim} { @@ -1777,24 +1778,24 @@ } {} test string-18.10.$noComp {string trim} { run {string trim ABC DEF} } {ABC} test string-18.11.$noComp {string trim, unicode} { - run {string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8} -} " AB\xe7C " + run {string trim "\xE7\xE8 AB\xE7C \xE8\xE7" \xE7\xE8} +} " AB\xE7C " test string-18.12.$noComp {string trim, unicode default} { - run {string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000} + run {string trim \uFEFF\x00\x85\xA0\u1680\u180EABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 test string-19.1.$noComp {string trimleft} { list [catch {run {string trimleft}} msg] $msg } {1 {wrong # args: should be "string trimleft string ?chars?"}} test string-19.2.$noComp {string trimleft} { run {string trimleft " XYZ "} } {XYZ } test string-19.3.$noComp {string trimleft, unicode default} { - run {string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC} + run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC} } \u1361ABC test string-20.1.$noComp {string trimright errors} { list [catch {run {string trimright}} msg] $msg } {1 {wrong # args: should be "string trimright string ?chars?"}} @@ -1809,95 +1810,140 @@ } {} test string-20.5.$noComp {string trimright} { run {string trimright ""} } {} test string-20.6.$noComp {string trimright, unicode default} { - run {string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000} + run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 +test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} {testbytestring} { + set result {} + set a [testbytestring \xC0\x80\xA0] + set b foo$a + set m [list \x00 U \xA0 V [testbytestring \xA0] W] + lappend result [string map $m $b] + lappend result [string map $m [run {string trimright $b x}]] + lappend result [string map $m [run {string trimright $b \x00}]] + lappend result [string map $m [run {string trimleft $b fox}]] + lappend result [string map $m [run {string trimleft $b fo\x00}]] + lappend result [string map $m [run {string trim $b fox}]] + lappend result [string map $m [run {string trim $b fo\x00}]] +} [list {*}[lrepeat 3 fooUV] {*}[lrepeat 2 UV V]] +test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} {testbytestring} { + set result {} + set a [testbytestring \xE8\xA0] + set b foo$a + set m [list \xE8 U \xA0 V [testbytestring \xE8] W [testbytestring \xA0] X]] + lappend result [string map $m $b] + lappend result [string map $m [run {string trimright $b x}]] + lappend result [string map $m [run {string trimright $b \xE8}]] + lappend result [string map $m [run {string trimright $b [testbytestring \xE8]}]] + lappend result [string map $m [run {string trimright $b \xA0}]] + lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]] + lappend result [string map $m [run {string trimright $b \xE8\xA0}]] + lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]] + lappend result [string map $m [run {string trimright $b \u0000}]] +} [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV] -test string-21.1.$noComp {string wordend} { +test string-21.1.$noComp {string wordend} -body { list [catch {run {string wordend a}} msg] $msg -} {1 {wrong # args: should be "string wordend string index"}} -test string-21.2.$noComp {string wordend} { +} -result {1 {wrong # args: should be "string wordend string index"}} +test string-21.2.$noComp {string wordend} -body { list [catch {run {string wordend a b c}} msg] $msg -} {1 {wrong # args: should be "string wordend string index"}} -test string-21.3.$noComp {string wordend} { +} -result {1 {wrong # args: should be "string wordend string index"}} +test string-21.3.$noComp {string wordend} -body { list [catch {run {string wordend a gorp}} msg] $msg -} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} -test string-21.4.$noComp {string wordend} { +} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} +test string-21.4.$noComp {string wordend} -body { run {string wordend abc. -1} -} 3 -test string-21.5.$noComp {string wordend} { +} -result 3 +test string-21.5.$noComp {string wordend} -body { run {string wordend abc. 100} -} 4 -test string-21.6.$noComp {string wordend} { +} -result 4 +test string-21.6.$noComp {string wordend} -body { run {string wordend "word_one two three" 2} -} 8 -test string-21.7.$noComp {string wordend} { +} -result 8 +test string-21.7.$noComp {string wordend} -body { run {string wordend "one .&# three" 5} -} 6 -test string-21.8.$noComp {string wordend} { +} -result 6 +test string-21.8.$noComp {string wordend} -body { run {string worde "x.y" 0} -} 1 -test string-21.9.$noComp {string wordend} { +} -result 1 +test string-21.9.$noComp {string wordend} -body { run {string worde "x.y" end-1} -} 2 -test string-21.10.$noComp {string wordend, unicode} { - run {string wordend "xyz\u00c7de fg" 0} -} 6 -test string-21.11.$noComp {string wordend, unicode} { - run {string wordend "xyz\uc700de fg" 0} -} 6 -test string-21.12.$noComp {string wordend, unicode} { - run {string wordend "xyz\u203fde fg" 0} -} 6 -test string-21.13.$noComp {string wordend, unicode} { +} -result 2 +test string-21.10.$noComp {string wordend, unicode} -body { + run {string wordend "xyz\xC7de fg" 0} +} -result 6 +test string-21.11.$noComp {string wordend, unicode} -body { + run {string wordend "xyz\uC700de fg" 0} +} -result 6 +test string-21.12.$noComp {string wordend, unicode} -body { + run {string wordend "xyz\u203Fde fg" 0} +} -result 6 +test string-21.13.$noComp {string wordend, unicode} -body { run {string wordend "xyz\u2045de fg" 0} -} 3 -test string-21.14.$noComp {string wordend, unicode} { - run {string wordend "\uc700\uc700 abc" 8} -} 6 +} -result 3 +test string-21.14.$noComp {string wordend, unicode} -body { + run {string wordend "\uC700\uC700 abc" 8} +} -result 6 +test string-21.15.$noComp {string wordend, unicode} -body { + run {string wordend "\U1D7CA\U1D7CA abc" 0} +} -result 2 +test string-21.16.$noComp {string wordend, unicode} -constraints utf16 -body { + run {string wordend "\U1D7CA\U1D7CA abc" 10} +} -result 8 -test string-22.1.$noComp {string wordstart} { +test string-22.1.$noComp {string wordstart} -body { list [catch {run {string word a}} msg] $msg -} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} -test string-22.2.$noComp {string wordstart} { +} -result {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +test string-22.2.$noComp {string wordstart} -body { list [catch {run {string wordstart a}} msg] $msg -} {1 {wrong # args: should be "string wordstart string index"}} -test string-22.3.$noComp {string wordstart} { +} -result {1 {wrong # args: should be "string wordstart string index"}} +test string-22.3.$noComp {string wordstart} -body { list [catch {run {string wordstart a b c}} msg] $msg -} {1 {wrong # args: should be "string wordstart string index"}} -test string-22.4.$noComp {string wordstart} { +} -result {1 {wrong # args: should be "string wordstart string index"}} +test string-22.4.$noComp {string wordstart} -body { list [catch {run {string wordstart a gorp}} msg] $msg -} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} -test string-22.5.$noComp {string wordstart} { +} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} +test string-22.5.$noComp {string wordstart} -body { run {string wordstart "one two three_words" 400} -} 8 -test string-22.6.$noComp {string wordstart} { +} -result 8 +test string-22.6.$noComp {string wordstart} -body { run {string wordstart "one two three_words" 2} -} 0 -test string-22.7.$noComp {string wordstart} { +} -result 0 +test string-22.7.$noComp {string wordstart} -body { run {string wordstart "one two three_words" -2} -} 0 -test string-22.8.$noComp {string wordstart} { +} -result 0 +test string-22.8.$noComp {string wordstart} -body { run {string wordstart "one .*&^ three" 6} -} 6 -test string-22.9.$noComp {string wordstart} { +} -result 6 +test string-22.9.$noComp {string wordstart} -body { run {string wordstart "one two three" 4} -} 4 -test string-22.10.$noComp {string wordstart} { +} -result 4 +test string-22.10.$noComp {string wordstart} -body { run {string wordstart "one two three" end-5} -} 7 -test string-22.11.$noComp {string wordstart, unicode} { - run {string wordstart "one tw\u00c7o three" 7} -} 4 -test string-22.12.$noComp {string wordstart, unicode} { - run {string wordstart "ab\uc700\uc700 cdef ghi" 12} -} 10 -test string-22.13.$noComp {string wordstart, unicode} { - run {string wordstart "\uc700\uc700 abc" 8} -} 3 +} -result 7 +test string-22.11.$noComp {string wordstart, unicode} -body { + run {string wordstart "one tw\xC7o three" 7} +} -result 4 +test string-22.12.$noComp {string wordstart, unicode} -body { + run {string wordstart "ab\uC700\uC700 cdef ghi" 12} +} -result 10 +test string-22.13.$noComp {string wordstart, unicode} -body { + run {string wordstart "\uC700\uC700 abc" 8} +} -result 3 +test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbytestring -body { + # See Bug c61818e4c9 + set demo [testbytestring "abc def\xE0\xA9ghi"] + run {string index $demo [string wordstart $demo 10]} +} -result g +test string-22.15.$noComp {string wordstart, unicode} -body { + run {string wordstart "\U1D7CA\U1D7CA abc" 0} +} -result 0 +test string-22.16.$noComp {string wordstart, unicode} -constraints utf16 -body { + run {string wordstart "\U1D7CA\U1D7CA abc" 10} +} -result 5 test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj { set x 5 catch {testindexobj $x foo bar soom} run {string is boolean $x} @@ -1963,44 +2009,44 @@ set x abc set y de run {string reverse $x$y} } edcba test string-24.5.$noComp {string reverse command - shared unicode string} { - set x abcde\ud0ad + set x abcde\uD0AD run {string reverse $x} -} \ud0adedcba +} \uD0ADedcba test string-24.6.$noComp {string reverse command - unshared string} { set x abc - set y de\ud0ad + set y de\uD0AD run {string reverse $x$y} -} \ud0adedcba +} \uD0ADedcba test string-24.7.$noComp {string reverse command - simple case} { run {string reverse a} } a test string-24.8.$noComp {string reverse command - simple case} { - run {string reverse \ud0ad} -} \ud0ad + run {string reverse \uD0AD} +} \uD0AD test string-24.9.$noComp {string reverse command - simple case} { run {string reverse {}} } {} test string-24.10.$noComp {string reverse command - corner case} { - set x \ubeef\ud0ad + set x \uBEEF\uD0AD run {string reverse $x} -} \ud0ad\ubeef +} \uD0AD\uBEEF test string-24.11.$noComp {string reverse command - corner case} { - set x \ubeef - set y \ud0ad + set x \uBEEF + set y \uD0AD run {string reverse $x$y} -} \ud0ad\ubeef +} \uD0AD\uBEEF test string-24.12.$noComp {string reverse command - corner case} { - set x \ubeef - set y \ud0ad + set x \uBEEF + set y \uD0AD run {string is ascii [run {string reverse $x$y}]} } 0 test string-24.13.$noComp {string reverse command - pure Unicode string} { - run {string reverse [run {string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5}]} -} \ud0ad\ubeef\ud0ad\ubeef\ud0ad + run {string reverse [run {string range \uBEEF\uD0AD\uBEEF\uD0AD\uBEEF\uD0AD 1 5}]} +} \uD0AD\uBEEF\uD0AD\uBEEF\uD0AD test string-24.14.$noComp {string reverse command - pure bytearray} { binary scan [run {string reverse [binary format H* 010203]}] H* x set x } 030201 test string-24.15.$noComp {string reverse command - pure bytearray} { @@ -2052,11 +2098,11 @@ set x {} list [run {string is list -failindex x { {b c}d e}}] $x } {0 2} test string-25.14.$noComp {string is list} { set x {} - list [run {string is list -failindex x "\uabcd {b c}d e"}] $x + list [run {string is list -failindex x "\uABCD {b c}d e"}] $x } {0 2} test string-26.1.$noComp {tcl::prefix, too few args} -body { tcl::prefix match a } -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"} @@ -2473,11 +2519,11 @@ set x {} list [string is dict -failindex x { {b c}d e}] $x } {0 2} test string-32.14.$noComp {string is dict} { set x {} - list [string is dict -failindex x "\uabcd {b c}d e"] $x + list [string is dict -failindex x "\uABCD {b c}d e"] $x } {0 2} test string-32.15.$noComp {string is dict, valid dict} { string is dict {a b c d e f} } 1 test string-32.16.$noComp {string is dict, invalid dict} { Index: tests/stringObj.test ================================================================== --- tests/stringObj.test +++ tests/stringObj.test @@ -21,10 +21,12 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] +testConstraint tip389 [expr {[string length \U010000] == 2}] +testConstraint nodep [info exists tcl_precision] test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first != -1}] @@ -437,13 +439,13 @@ string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo - teststringobj getunicode 1 + teststringobj maxchars 1 teststringobj append 1 bar -1 - teststringobj getunicode 1 + teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj setlength 1 0 teststringobj append 1 bar -1 teststringobj get 1 } {bar} @@ -462,23 +464,23 @@ } fooo test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo -test stringObj-15.5 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo -test stringObj-15.6 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo -test stringObj-15.7 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo -test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj { +test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo if {[testConstraint testobj]} { Index: tests/tcltest.test ================================================================== --- tests/tcltest.test +++ tests/tcltest.test @@ -96,66 +96,66 @@ set code 1 append msg \n$err } return $code } -test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} { +test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} { set result [slave msg test.tcl] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} -test tcltest-2.1 {tcltest -verbose 'b'} {unixOrPc} { +test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} { set result [slave msg test.tcl -verbose 'b'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} -test tcltest-2.2 {tcltest -verbose 'p'} {unixOrPc} { +test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} { set result [slave msg test.tcl -verbose 'p'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 0 1} -test tcltest-2.3 {tcltest -verbose 's'} {unixOrPc} { +test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} { set result [slave msg test.tcl -verbose 's'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 0 1 1} -test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrPc} { +test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} { set result [slave msg test.tcl -verbose 'ps'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 0 1 1 1} -test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrPc} { +test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} { set result [slave msg test.tcl -verbose 'psb'] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} -test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} { +test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} { set result [slave msg test.tcl -verbose "pass skip body"] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 1 1} test tcltest-2.6 {tcltest -verbose 't'} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose 't'] list $result $msg } -result {^0 .*a-1.0 start.*b-1.0 start} -match regexp } test tcltest-2.6a {tcltest -verbose 'start'} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose start] list $result $msg } -result {^0 .*a-1.0 start.*b-1.0 start} @@ -174,35 +174,35 @@ } -result {body {}} } test tcltest-2.8 {tcltest -verbose 'error'} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { set result [slave msg test.tcl -verbose error] list $result $msg } -result {errorInfo: foo.*errorCode: 9} -match regexp } # -match, [match] -test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} { +test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} { set result [slave msg test.tcl -match a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} -test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} { +test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} { set result [slave msg test.tcl -match b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 1 0 1} -test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} { +test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} { set result [slave msg test.tcl -match c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg] } {0 0 0 1 1} -test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} { +test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} { set result [slave msg test.tcl -match {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 1 0 1} @@ -218,31 +218,31 @@ } -result {foo bar} } # -skip, [skip] -test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} { +test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} { set result [slave msg test.tcl -skip a* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg] } {0 0 1 1 1} -test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} { +test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} { set result [slave msg test.tcl -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg] } {0 1 0 1 1} -test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} { +test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} { set result [slave msg test.tcl -skip c* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 1 0 1} -test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} { +test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} { set result [slave msg test.tcl -skip {a* b*} -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg] } {0 0 0 1 1} -test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} { +test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} { set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 1 0 0 1} @@ -259,16 +259,16 @@ -result {foo bar} } # -constraints, -limitconstraints, [testConstraint], # $constraintsSpecified, [limitConstraints] -test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} { +test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} { set result [slave msg test.tcl -constraints knownBug -verbose 'ps'] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg] } {0 1 1 1 1} -test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrPc} { +test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} { set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg] } {0 0 0 1 1} @@ -353,33 +353,33 @@ ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\"" exit } printerror.tcl] test tcltest-6.1 {tcltest -outfile, -errfile defaults} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $printerror return $msg } -result {a test.*a really} -match regexp } -test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} { +test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} { slave msg $printerror -outfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} -test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} { +test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} { slave msg $printerror -errfile a.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {1 0 1 0 1 {}} -test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc unixExecs} { +test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} { slave msg $printerror -outfile a.tmp -errfile b.tmp set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" b.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 \ @@ -462,29 +462,29 @@ # -debug, [debug] # Must use child processes to test -debug because it always writes # messages to stdout, and we have no way to capture stdout of a # slave interp -test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrPc} { +test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 0} msg regexp "Flags passed into tcltest" $msg } {0} -test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrPc} { +test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg list [regexp userSpecifiedSkip $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} -test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrPc} { +test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 1 -match b*} msg list [regexp userSpecifiedNonMatch $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} -test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrPc} { +test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 2} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 0} -test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrPc} { +test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrWin} { catch {exec [interpreter] test.tcl -debug 3} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 1} test tcltest-7.6 {tcltest::debug} { @@ -520,20 +520,20 @@ set normaldirectory [makeDirectory normaldirectory] normalizePath normaldirectory # -tmpdir, [temporaryDirectory] -test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup { +test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { slave msg $a -tmpdir thisdirectorydoesnotexist file exists [file join thisdirectorydoesnotexist a.tmp] } -cleanup { file delete -force thisdirectorydoesnotexist } -result 1 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -tmpdir $tdiaf return $msg } -result {*not a directory*} @@ -542,11 +542,10 @@ # Test non-writeable directories, non-readable directories with directory flags set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable - switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 00333 file attributes $notWriteableDir -permissions 00555 } @@ -571,20 +570,20 @@ ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]] || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] # FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { - -constraints {unixOrPc notRoot notFAT} + -constraints {unixOrWin notRoot notFAT} -body { slave msg $a -tmpdir $notWriteableDir return $msg } -result {*not writeable*} -match glob } test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -tmpdir $normaldirectory # The join is necessary because the message can be split on multiple # lines file exists [file join $normaldirectory a.tmp] @@ -623,11 +622,11 @@ set ::tcltest::temporaryDirectory $old } -result [list $normaldirectory [workingDirectory] [workingDirectory]] cd [temporaryDirectory] # -testdir, [testsDirectory] test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} { - -constraints unixOrPc + -constraints unixOrWin -setup { file delete -force thisdirectorydoesnotexist } -body { slave msg $a -testdir thisdirectorydoesnotexist @@ -635,11 +634,11 @@ } -match glob -result {*does not exist*} } test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -testdir $tdiaf return $msg } -match glob @@ -653,11 +652,11 @@ } -match glob -result {*not readable*} } test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} { - -constraints unixOrPc + -constraints unixOrWin -body { slave msg $a -testdir $normaldirectory # The join is necessary because the message can be split on multiple # lines list [string first "testdir: $normaldirectory" [join $msg]] \ @@ -730,21 +729,21 @@ removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] -test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup { +test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] -file d*.test return $msg } -cleanup { testsDirectory $old } -match regexp -result {dstring\.test} -test tcltest-9.2 {-file d*.tcl} -constraints {unixOrPc} -setup { +test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] \ -file d*.test -notfile dstring* @@ -805,27 +804,27 @@ ::tcltest::cleanupTests return } makecore.tcl] cd [temporaryDirectory] -test tcltest-10.1 {-preservecore 0} {unixOrPc} { +test tcltest-10.1 {-preservecore 0} {unixOrWin} { slave msg $mc -preservecore 0 file delete core regexp "Core file produced" $msg } {0} -test tcltest-10.2 {-preservecore 1} {unixOrPc} { +test tcltest-10.2 {-preservecore 1} {unixOrWin} { slave msg $mc -preservecore 1 file delete core regexp "Core file produced" $msg } {1} -test tcltest-10.3 {-preservecore 2} {unixOrPc} { +test tcltest-10.3 {-preservecore 2} {unixOrWin} { slave msg $mc -preservecore 2 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} -test tcltest-10.4 {-preservecore 3} {unixOrPc} { +test tcltest-10.4 {-preservecore 3} {unixOrWin} { slave msg $mc -preservecore 3 file delete core list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} @@ -852,17 +851,17 @@ puts [outputChannel] $::tcltest::loadScript exit } set loadfile [makeFile $contents load.tcl] -test tcltest-12.1 {-load xxx} {unixOrPc} { +test tcltest-12.1 {-load xxx} {unixOrWin} { slave msg $loadfile -load xxx return $msg } {xxx} # Using child process because of -debug usage. -test tcltest-12.2 {-loadfile load.tcl} {unixOrPc} { +test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} { catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg list \ [regexp {tcltest} [join [list $msg] [split $msg \n]]] \ [regexp {loadScript} [join [list $msg] [split $msg \n]]] } {1 1} @@ -949,21 +948,21 @@ runAllTests } all-single.tcl $spd] cd [workingDirectory] test tcltest-14.1 {-singleproc - single process} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory] return $msg } -result {Test file error: can't unset .foo.: no such variable} -match regexp } test tcltest-14.2 {-singleproc - multiple process} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory] return $msg } -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0} @@ -1023,11 +1022,11 @@ testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3] runAllTests } all.tcl $dtd3 test tcltest-15.1 {basic directory walking} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -tmpdir [temporaryDirectory]] == 1} { error $msg @@ -1037,11 +1036,11 @@ -returnCodes 1 -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]} } test tcltest-15.2 {-asidefromdir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -asidefromdir dirtestdir2.3 \ -tmpdir [temporaryDirectory]] == 1} { @@ -1055,11 +1054,11 @@ Error: No test files remain after applying your match and skip patterns! Error: No test files remain after applying your match and skip patterns!$} } test tcltest-15.3 {-relateddir, non-existent dir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -relateddir [file join [temporaryDirectory] dirtestdir0] \ -tmpdir [temporaryDirectory]] == 1} { @@ -1070,11 +1069,11 @@ -match regexp -result {[^~]|dirtestdir[^2]} } test tcltest-15.4 {-relateddir, subdir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} { error $msg @@ -1083,11 +1082,11 @@ -returnCodes 1 -match regexp -result {Tests located in:.*dirtestdir2.[^23]} } test tcltest-15.5 {-relateddir, -asidefromdir} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { if {[slave msg \ [file join $dtd all.tcl] \ -relateddir "dirtestdir2.1 dirtestdir2.2" \ -asidefromdir dirtestdir2.2 \ @@ -1172,11 +1171,11 @@ # Begin testing of tcltest procs ... cd [temporaryDirectory] # PrintError -test tcltest-20.1 {PrintError} {unixOrPc} { +test tcltest-20.1 {PrintError} {unixOrWin} { set result [slave msg $printerror] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ [regexp " \"Really" $msg] [regexp Problem $msg] } {1 1 1 1 1 1} @@ -1408,11 +1407,11 @@ } test.test $atd # Must use a child process because stdout/stderr parsing can't be # duplicated in slave interp. test tcltest-22.1 {runAllTests} { - -constraints {unixOrPc} + -constraints {unixOrWin} -body { exec [interpreter] \ [file join $atd all.tcl] \ -verbose t -tmpdir [temporaryDirectory] } Index: tests/tcltests.tcl ================================================================== --- tests/tcltests.tcl +++ tests/tcltests.tcl @@ -1,13 +1,46 @@ #! /usr/bin/env tclsh package require tcltest 2.2 namespace import ::tcltest::* - testConstraint exec [llength [info commands exec]] testConstraint fcopy [llength [info commands fcopy]] testConstraint fileevent [llength [info commands fileevent]] testConstraint thread [ expr {0 == [catch {package require Thread 2.7-}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] -package provide tcltests 0.1 + +namespace eval ::tcltests { + + + proc init {} { + if {[namespace which ::tcl::file::tempdir] eq {}} { + interp alias {} [namespace current]::tempdir {} [ + namespace current]::tempdir_alternate + } else { + interp alias {} [namespace current]::tempdir {} ::tcl::file::tempdir + } + } + + + proc tempdir_alternate {} { + close [file tempfile tempfile] + set tmpdir [file dirname $tempfile] + set execname [info nameofexecutable] + regsub -all {[^[:alpha:][:digit:]]} $execname _ execname + for {set i 0} {$i < 10000} {incr i} { + set time [clock milliseconds] + set name $tmpdir/${execname}_${time}_$i + if {![file exists $name]} { + file mkdir $name + return $name + } + } + error [list {could not create temporary directory}] + } + + init + + package provide tcltests 0.1 +} + Index: tests/tm.test ================================================================== --- tests/tm.test +++ tests/tm.test @@ -198,11 +198,11 @@ proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] - lassign [split [package present Tcl] .] major minor + regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] for {set i 0} {$i <= $minor} {incr i} { lappend results [file join $base ${major}.$i] Index: tests/uplevel.test ================================================================== --- tests/uplevel.test +++ tests/uplevel.test @@ -81,10 +81,20 @@ set y zzz proc a1 {} {set y 55; uplevel #1 set y} a1 } 55 +test uplevel-4.0.1 {error: non-existent level} -body { + uplevel #0 { uplevel { set y 222 } } +} -returnCodes error -result {bad level "1"} +test uplevel-4.0.2 {error: non-existent level} -setup { + interp create i +} -body { + i eval { uplevel { set y 222 } } +} -returnCodes error -result {bad level "1"} -cleanup { + interp delete i +} test uplevel-4.1 {error: non-existent level} -returnCodes error -body { apply {{} { uplevel #2 {set y 222} }} } -result {bad level "#2"} Index: tests/upvar.test ================================================================== --- tests/upvar.test +++ tests/upvar.test @@ -302,10 +302,21 @@ } ok test upvar-8.3 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar a b c} p1 } -result {bad level "a"} +test upvar-8.3.1 {bad level for upvar (upvar at top-level, bug [775ee88560])} -body { + proc p1 {} { uplevel { upvar b b; lappend b UNEXPECTED } } + uplevel #0 { p1 } +} -returnCodes error -result {bad level "1"} +test upvar-8.3.2 {bad level for upvar (upvar at top-level, bug [775ee88560])} -setup { + interp create i +} -body { + i eval { upvar b b; lappend b UNEXPECTED } +} -returnCodes error -result {bad level "1"} -cleanup { + interp delete i +} test upvar-8.4 {errors in upvar command} -returnCodes error -body { proc p1 {} {upvar 0 b b} p1 } -result {can't upvar from variable to itself} test upvar-8.5 {errors in upvar command} -returnCodes error -body { @@ -353,11 +364,11 @@ upvar 0 upvarArray(elem) upvarArrayElemAlias(elem) } -returnCodes 1 -match glob -result * test upvar-9.1 {Tcl_UpVar2 procedure} testupvar { list [catch {testupvar xyz a {} x global} msg] $msg -} {1 {bad level "xyz"}} +} {1 {bad level "1"}} test upvar-9.1.1 {TclGetFrame, via Tcl_UpVar2} testupvar { apply {{} {testupvar xyz a {} x local; set x foo}} set a } foo test upvar-9.2 {Tcl_UpVar2 procedure} testupvar { Index: tests/utf.test ================================================================== --- tests/utf.test +++ tests/utf.test @@ -13,193 +13,967 @@ namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] + +testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] +testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] +testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}] +testConstraint ucs4 [expr {[testConstraint fullutf] + && [string length [format %c 0x10000]] == 1}] +testConstraint ucs2_utf16 [expr {![testConstraint ucs4]}] + +testConstraint Uesc [expr {"\U0041" eq "A"}] +testConstraint pre388 [expr {"\x741" eq "A"}] +testConstraint pairsTo4bytes [expr {[llength [info commands teststringbytes]] + && [string length [teststringbytes \uD83D\uDCA9]] == 4}] testConstraint testbytestring [llength [info commands testbytestring]] +testConstraint testfindfirst [llength [info commands testfindfirst]] +testConstraint testfindlast [llength [info commands testfindlast]] +testConstraint testnumutfchars [llength [info commands testnumutfchars]] +testConstraint teststringobj [llength [info commands teststringobj]] +testConstraint testutfnext [llength [info commands testutfnext]] +testConstraint testutfprev [llength [info commands testutfprev]] + +testConstraint tip413 [expr {[string trim \x00] eq {}}] catch {unset x} -# Some tests require support for 4-byte UTF-8 sequences -testConstraint tip389 [expr {[string length \U010000] == 2}] - test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring { - expr {"\x01" eq [testbytestring "\x01"]} + expr {"\x01" eq [testbytestring \x01]} } 1 test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { - expr {"\x00" eq [testbytestring "\xc0\x80"]} + expr {"\x00" eq [testbytestring \xC0\x80]} } 1 test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { - expr {"\xe0" eq [testbytestring "\xc3\xa0"]} + expr {"\xE0" eq [testbytestring \xC3\xA0]} } 1 test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring { - expr {"\u4e4e" eq [testbytestring "\xe4\xb9\x8e"]} + expr {"\u4E4E" eq [testbytestring \xE4\xB9\x8E]} } 1 test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { - expr {[format %c 0x110000] eq [testbytestring "\xef\xbf\xbd"]} + expr {[format %c 0x110000] eq [testbytestring \xEF\xBF\xBD]} } 1 test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { - expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]} + expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]} } 1 -test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints testbytestring -body { - expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]} -} -result 1 +test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf Uesc testbytestring} { + expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]} +} 1 +test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {ucs2 Uesc testbytestring} { + expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]} +} 0 test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { - expr {"\ud842" eq [testbytestring "\xed\xa1\x82"]} + expr {"\uD842" eq [testbytestring \xED\xA1\x82]} } 1 test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { - expr {"\udc42" eq [testbytestring "\xed\xb1\x82"]} + expr {"\uDC42" eq [testbytestring \xED\xB1\x82]} } 1 test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { - expr {[format %c 0xd842] eq [testbytestring "\xed\xa1\x82"]} + expr {[format %c 0xD842] eq [testbytestring \xED\xA1\x82]} } 1 test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { - expr {[format %c 0xdc42] eq [testbytestring "\xed\xb1\x82"]} + expr {[format %c 0xDC42] eq [testbytestring \xED\xB1\x82]} +} 1 +test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} { + expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]} +} 1 +test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring} { + expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]} } 1 test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" -} {3} +} 3 test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring { - string length [testbytestring "\x82\x83\x84"] -} {3} + string length [testbytestring \x82\x83\x84] +} 3 test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} testbytestring { - string length [testbytestring "\xC2"] -} {1} -test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} testbytestring { - string length [testbytestring "\xC2\xa2"] -} {1} + string length [testbytestring \xC2] +} 1 +test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} { + string length \xA2 +} 1 test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} testbytestring { - string length [testbytestring "\xE2"] -} {1} + string length [testbytestring \xE2] +} 1 test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring { - string length [testbytestring "\xE2\xA2"] -} {2} + string length [testbytestring \xE2\xA2] +} 2 test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring { - string length [testbytestring "\xE4\xb9\x8e"] -} {1} -test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body { - string length [testbytestring "\xF0\x90\x80\x80"] -} -result {2} -test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body { - string length [testbytestring "\xF4\x8F\xBF\xBF"] -} -result {2} + string length [testbytestring \xE4\xB9\x8E] +} 1 +test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2_utf16} { + string length [testbytestring \xF0\x90\x80\x80] +} 2 +test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} { + string length [testbytestring \xF0\x90\x80\x80] +} 1 +test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} { + string length [testbytestring \xF4\x8F\xBF\xBF] +} 2 +test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} { + string length \U10FFFF +} 1 test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring { - string length [testbytestring "\xF0\x8F\xBF\xBF"] -} {4} + string length [testbytestring \xF0\x8F\xBF\xBF] +} 4 test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring { - string length [testbytestring "\xF4\x90\x80\x80"] -} {4} + # Would decode to U+110000 but that is outside the Unicode range. + string length [testbytestring \xF4\x90\x80\x80] +} 4 test utf-2.12 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring { - string length [testbytestring "\xF8\xA2\xA2\xA2\xA2"] -} {5} + string length [testbytestring \xF8\xA2\xA2\xA2\xA2] +} 5 test utf-3.1 {Tcl_UtfCharComplete} { } {} -testConstraint testnumutfchars [llength [info commands testnumutfchars]] -testConstraint testfindfirst [llength [info commands testfindfirst]] -testConstraint testfindlast [llength [info commands testfindlast]] - test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" -} {0} -test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "\xC2\xA2"] -} {1} +} 0 +test utf-4.2 {Tcl_NumUtfChars: length 1} testnumutfchars { + testnumutfchars \xA2 +} 1 test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\xA2\x4E"] -} {7} -test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "\xC0\x80"] -} {1} + testnumutfchars abc\xA2[testbytestring \xE4\xB9\x8E\xA2\x4E] +} 7 +test utf-4.4 {Tcl_NumUtfChars: #x00} testnumutfchars { + testnumutfchars \x00 +} 1 test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars { testnumutfchars "" 0 -} {0} +} 0 test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "\xC2\xA2"] 2 -} {1} + testnumutfchars \xA2 end +} 1 test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\xA2\x4E"] 10 -} {7} -test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "\xC0\x80"] 2 -} {1} + testnumutfchars abc\xA2[testbytestring \xE4\xB9\x8E\xA2\x4E] end +} 7 +test utf-4.8 {Tcl_NumUtfChars: #x00, calc len} testnumutfchars { + testnumutfchars \x00 end +} 1 # Bug [2738427]: Tcl_NumUtfChars(...) no overflow check test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "\xE2\x82\xAC"] 2 -} {2} -test utf-4.10 {Tcl_NumUtfChars: #u0000, calc len, overcomplete} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "\x00"] 2 -} {2} + testnumutfchars [testbytestring \xE2\x82\xAC] end-1 +} 2 +test utf-4.10 {Tcl_NumUtfChars: #x00, calc len, overcomplete} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring \x00] end+1 +} 2 +test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1 +} 3 +test utf-4.12.0 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs2} { + testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end +} 2 +test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs4} { + testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end +} 1 +test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} { + testnumutfchars foobar[testbytestring \xF2\xC2\xA0] end +} 8 +test utf-4.14 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring \xF4\x90\x80\x80] end-1 +} 3 test utf-5.1 {Tcl_UtfFindFirst} {testfindfirst testbytestring} { - testfindfirst [testbytestring "abcbc"] 98 -} {bcbc} + testfindfirst [testbytestring abcbc] 98 +} bcbc test utf-5.2 {Tcl_UtfFindLast} {testfindlast testbytestring} { - testfindlast [testbytestring "abcbc"] 98 -} {bc} - -test utf-6.1 {Tcl_UtfNext} { -} {} - -test utf-7.1 {Tcl_UtfPrev} { -} {} + testfindlast [testbytestring abcbc] 98 +} bc + +test utf-6.1 {Tcl_UtfNext} {testutfnext testbytestring} { + # This takes the pointer one past the terminating NUL. + # This is really an invalid call. + testutfnext [testbytestring \x00] +} 1 +test utf-6.2 {Tcl_UtfNext} testutfnext { + testutfnext A +} 1 +test utf-6.3 {Tcl_UtfNext} testutfnext { + testutfnext AA +} 1 +test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext A[testbytestring \xA0] +} 1 +test utf-6.5 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext A[testbytestring \xD0] +} 1 +test utf-6.6 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext A[testbytestring \xE8] +} 1 +test utf-6.7 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext A[testbytestring \xF2] +} 1 +test utf-6.8 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext A[testbytestring \xF8] +} 1 +test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\x00] +} 1 +test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0]G +} 1 +test utf-6.11 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xA0\x00] +} 2 +test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xD0] +} 1 +test utf-6.13 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xE8] +} 1 +test utf-6.14 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xF2] +} 1 +test utf-6.15 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xF8] +} 1 +test utf-6.16 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\x00] +} 1 +test utf-6.17 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0]G +} 1 +test utf-6.18 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0] +} 2 +test utf-6.19 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xD0] +} 1 +test utf-6.20 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xE8] +} 1 +test utf-6.21 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xF2] +} 1 +test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xF8] +} 1 +test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8] +} -1 +test utf-6.24 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8]G +} 1 +test utf-6.25 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xA0\x00] +} 1 +test utf-6.26 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xD0] +} 1 +test utf-6.27 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xE8] +} 1 +test utf-6.28 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xF2] +} 1 +test utf-6.29 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xF8] +} 1 +test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2] +} 1 +test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2] +} -1 +test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2]G +} 1 +test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0] +} 1 +test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0] +} -1 +test utf-6.33 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xD0] +} 1 +test utf-6.34 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xE8] +} 1 +test utf-6.35 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xF2] +} 1 +test utf-6.36 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xF8] +} 1 +test utf-6.37 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8] +} 1 +test utf-6.38 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8]G +} 1 +test utf-6.39 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8\xA0] +} 1 +test utf-6.40 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8\xD0] +} 1 +test utf-6.41 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8\xE8] +} 1 +test utf-6.42 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8\xF2] +} 1 +test utf-6.43 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF8\xF8] +} 1 +test utf-6.44 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0]G +} 2 +test utf-6.45 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0\xA0] +} 2 +test utf-6.46 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0\xD0] +} 2 +test utf-6.47 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0\xE8] +} 2 +test utf-6.48 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0\xF2] +} 2 +test utf-6.49 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xD0\xA0\xF8] +} 2 +test utf-6.50 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xA0]G +} 1 +test utf-6.51 {Tcl_UtfNext} testutfnext { + testutfnext \u8820 +} 3 +test utf-6.52 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xA0\xD0] +} 1 +test utf-6.53 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xA0\xE8] +} 1 +test utf-6.54 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xA0\xF2] +} 1 +test utf-6.55 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xE8\xA0\xF8] +} 1 +test utf-6.56 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0]G +} 1 +test utf-6.57 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xA0\x00] +} 1 +test utf-6.58 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xD0] +} 1 +test utf-6.59 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xE8] +} 1 +test utf-6.60 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xF2] +} 1 +test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xF8] +} 1 +test utf-6.62 {Tcl_UtfNext} testutfnext { + testutfnext \u8820G +} 3 +test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext \u8820[testbytestring \xA0] +} 3 +test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext \u8820[testbytestring \xD0] +} 3 +test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext \u8820[testbytestring \xE8] +} 3 +test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext \u8820[testbytestring \xF2] +} 3 +test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext \u8820[testbytestring \xF8] +} 3 +test utf-6.68 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xA0]G +} 1 +test utf-6.69.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0] +} 1 +test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0] +} 4 +test utf-6.70 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xA0\xD0] +} 1 +test utf-6.71 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xA0\xE8] +} 1 +test utf-6.72 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xA0\xF2] +} 1 +test utf-6.73 {Tcl_UtfNext} {testutfnext testbytestring} { + testutfnext [testbytestring \xF2\xA0\xA0\xF8] +} 1 +test utf-6.74.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0]G +} 1 +test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0]G +} 4 +test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] +} 1 +test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] +} 4 +test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0] +} 1 +test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0] +} 4 +test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8] +} 1 +test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8] +} 4 +test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2] +} 1 +test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2] +} 4 +test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8] +} 1 +test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8] +} 4 +test utf-6.80 {Tcl_UtfNext - overlong sequences} testutfnext { + testutfnext \x00 +} 2 +test utf-6.81 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { + testutfnext [testbytestring \xC0\x81] +} 1 +test utf-6.82 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { + testutfnext [testbytestring \xC1\x80] +} 1 +test utf-6.83 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { + testutfnext [testbytestring \xC2\x80] +} 2 +test utf-6.84 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { + testutfnext [testbytestring \xE0\x80\x80] +} 1 +test utf-6.85 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { + testutfnext [testbytestring \xE0\xA0\x80] +} 3 +test utf-6.86 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} { + testutfnext [testbytestring \xF0\x80\x80\x80] +} 1 +test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF0\x90\x80\x80] +} 1 +test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF0\x90\x80\x80] +} 4 +test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xA0\x00] +} 2 +test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} { + testutfnext [testbytestring \x80\x80\x00] +} 2 +test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2_utf16} { + testutfnext [testbytestring \xF4\x8F\xBF\xBF] +} 1 +test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs4} { + testutfnext [testbytestring \xF4\x8F\xBF\xBF] +} 4 +test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} { + testutfnext [testbytestring \xF4\x90\x80\x80] +} 1 +test utf-6.92 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xA0\xA0] +} 3 +test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} { + testutfnext [testbytestring \x80\x80\x80] +} 3 +test utf-6.94 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} { + testutfnext [testbytestring \xA0\xA0\xA0\xA0] +} 3 +test utf-6.95 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} { + testutfnext [testbytestring \x80\x80\x80\x80] +} 3 + +test utf-7.1 {Tcl_UtfPrev} testutfprev { + testutfprev {} +} 0 +test utf-7.2 {Tcl_UtfPrev} testutfprev { + testutfprev A +} 0 +test utf-7.3 {Tcl_UtfPrev} testutfprev { + testutfprev AA +} 1 +test utf-7.4 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8] +} 1 +test utf-7.4.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 2 +} 1 +test utf-7.4.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xF8\xA0\xA0] 2 +} 1 +test utf-7.5 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF2] +} 1 +test utf-7.5.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 2 +} 1 +test utf-7.5.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF2\xF8\xA0\xA0] 2 +} 1 +test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE8] +} 1 +test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A\u8820[testbytestring \xA0] 2 +} 1 +test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2 +} 1 +test utf-7.7 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0] +} 1 +test utf-7.7.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 2 +} 1 +test utf-7.7.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xF8\xA0\xA0] 2 +} 1 +test utf-7.8 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xA0] +} 1 +test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 2 +} 1 +test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xA0\xF8\xA0\xA0] 2 +} 1 +test utf-7.9 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0] +} 2 +test utf-7.9.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 3 +} 2 +test utf-7.9.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0\xF8\xA0] 3 +} 2 +test utf-7.10.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0] +} 2 +test utf-7.10.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0] +} 1 +test utf-7.10.2 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 3 +} 2 +test utf-7.10.3 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 3 +} 1 +test utf-7.10.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3 +} 2 +test utf-7.10.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3 +} 1 +test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE8\xA0] +} 1 +test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A\u8820[testbytestring \xA0] 3 +} 1 +test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3 +} 1 +test utf-7.11.3 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE8\xA0\xF8] 3 +} 1 +test utf-7.12 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0] +} 1 +test utf-7.12.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 3 +} 1 +test utf-7.12.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0\xF8\xA0] 3 +} 1 +test utf-7.13 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xA0\xA0] +} 2 +test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 3 +} 2 +test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xA0\xA0\xF8\xA0] 3 +} 2 +test utf-7.14 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0\xA0] +} 3 +test utf-7.14.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 4 +} 3 +test utf-7.14.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF8\xA0\xA0\xF8] 4 +} 3 +test utf-7.15.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0\xA0] +} 3 +test utf-7.15.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0\xA0] +} 1 +test utf-7.15.2 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 4 +} 3 +test utf-7.15.3 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] 4 +} 1 +test utf-7.15.4 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4 +} 3 +test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4 +} 1 +test utf-7.16 {Tcl_UtfPrev} testutfprev { + testutfprev A\u8820 +} 1 +test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A\u8820[testbytestring \xA0] 4 +} 1 +test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A\u8820[testbytestring \xF8] 4 +} 1 +test utf-7.17 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0\xA0] +} 3 +test utf-7.17.1 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 4 +} 3 +test utf-7.17.2 {Tcl_UtfPrev} {testutfprev testbytestring} { + testutfprev A[testbytestring \xD0\xA0\xA0\xF8] 4 +} 3 +test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xA0\xA0\xA0] +} 1 +test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 4 +} 1 +test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xA0\xA0\xA0\xF8] 4 +} 1 +test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xF8\xA0\xA0\xA0] +} 2 +test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] +} 2 +test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A\u8820[testbytestring \xA0] +} 2 +test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xD0\xA0\xA0\xA0] +} 2 +test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xA0\xA0\xA0\xA0] +} 2 +test utf-7.24 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xC0\x81] +} 2 +test utf-7.25 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xC0\x81] 2 +} 1 +test utf-7.26 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\x80\x80] +} 3 +test utf-7.27 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\x80] +} 2 +test utf-7.27.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\x80\x80] 3 +} 2 +test utf-7.28 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0] +} 1 +test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\x80\x80] 2 +} 1 +test utf-7.29 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xF0\x80\x80\x80] +} 2 +test utf-7.30 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF0\x80\x80\x80] 4 +} 3 +test utf-7.31 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF0\x80\x80\x80] 3 +} 2 +test utf-7.32 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF0\x80\x80\x80] 2 +} 1 +test utf-7.33 {Tcl_UtfPrev -- overlong sequence} testutfprev { + testutfprev A\x00 +} 1 +test utf-7.34 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xC1\x80] +} 2 +test utf-7.35 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xC2\x80] +} 1 +test utf-7.36 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\xA0\x80] +} 1 +test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\xA0\x80] 3 +} 1 +test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xE0\xA0\x80] 2 +} 1 +test utf-7.39 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xF0\x90\x80\x80] +} 2 +test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF0\x90\x80\x80] 4 +} 3 +test utf-7.40.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF0\x90\x80\x80] 4 +} 1 +test utf-7.41.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF0\x90\x80\x80] 3 +} 2 +test utf-7.41.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF0\x90\x80\x80] 3 +} 1 +test utf-7.42 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF0\x90\x80\x80] 2 +} 1 +test utf-7.43 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { + testutfprev [testbytestring \xA0] +} 0 +test utf-7.44 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { + testutfprev [testbytestring \xA0\xA0] +} 1 +test utf-7.45 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring} { + testutfprev [testbytestring \xA0\xA0\xA0] +} 2 +test utf-7.46 {Tcl_UtfPrev -- no lead byte at start} {testutfprev testbytestring utf16} { + testutfprev [testbytestring \xA0\xA0\xA0\xA0] +} 1 +test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {testutfprev testbytestring} { + testutfprev [testbytestring \xE8\xA0] +} 0 +test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev { + testutfprev \u8820 2 +} 0 +test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} { + testutfprev [testbytestring \xE8\xA0\x00] 2 +} 0 +test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] +} 2 +test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 +} 3 +test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 +} 1 +test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 +} 2 +test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 +} 1 +test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2 +} 1 +test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} { + testutfprev A[testbytestring \xF4\x90\x80\x80] +} 2 +test utf-7.49.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF4\x90\x80\x80] 4 +} 3 +test utf-7.49.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF4\x90\x80\x80] 3 +} 2 +test utf-7.49.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { + testutfprev A[testbytestring \xF4\x90\x80\x80] 2 +} 1 test utf-8.1 {Tcl_UniCharAtIndex: index = 0} { string index abcd 0 -} {a} +} a test utf-8.2 {Tcl_UniCharAtIndex: index = 0} { - string index \u4e4e\u25a 0 -} "\u4e4e" + string index \u4E4E\u25A 0 +} \u4E4E test utf-8.3 {Tcl_UniCharAtIndex: index > 0} { string index abcd 2 -} {c} +} c test utf-8.4 {Tcl_UniCharAtIndex: index > 0} { - string index \u4e4e\u25a\xff\u543 2 -} "\uff" -test utf-8.5 {Tcl_UniCharAtIndex: high surrogate} { - string index \ud842 0 -} "\ud842" + string index \u4E4E\u25A\xFF\u543 2 +} \xFF +test utf-8.5.0 {Tcl_UniCharAtIndex: high surrogate} ucs2 { + string index \uD842 0 +} \uD842 +test utf-8.5.1 {Tcl_UniCharAtIndex: high surrogate} ucs4 { + string index \uD842 0 +} \uD842 +test utf-8.5.2 {Tcl_UniCharAtIndex: high surrogate} utf16 { + string index \uD842 0 +} \uD842 test utf-8.6 {Tcl_UniCharAtIndex: low surrogate} { - string index \udc42 0 -} "\udc42" + string index \uDC42 0 +} \uDC42 +test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { + string index \uD83D\uDE00G 0 +} \uD83D +test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { + string index \uD83D\uDE00G 0 +} \U1F600 +test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 { + string index \uD83D\uDE00G 0 +} \U1F600 +test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { + string index \uD83D\uDE00G 1 +} \uDE00 +test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { + string index \uD83D\uDE00G 1 +} G +test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 { + string index \uD83D\uDE00G 1 +} {} +test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 { + string index \uD83D\uDE00G 2 +} G +test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} ucs4 { + string index \uD83D\uDE00G 2 +} {} +test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 { + string index \uD83D\uDE00G 2 +} G +test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { + string index \U1F600G 0 +} \uFFFD +test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} { + string index \U1F600G 0 +} \U1F600 +test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} { + string index \U1F600G 0 +} \U1F600 +test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { + string index \U1F600G 1 +} G +test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} { + string index \U1F600G 1 +} G +test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} { + string index \U1F600G 1 +} {} +test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} { + string index \U1F600G 2 +} {} +test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} { + string index \U1F600G 2 +} {} +test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} { + string index \U1F600G 2 +} G test utf-9.1 {Tcl_UtfAtIndex: index = 0} { string range abcd 0 2 -} {abc} +} abc test utf-9.2 {Tcl_UtfAtIndex: index > 0} { - string range \u4e4e\u25a\xff\u543klmnop 1 5 -} "\u25a\xff\u543kl" - + string range \u4E4E\u25A\xFF\u543klmnop 1 5 +} \u25A\xFF\u543kl +test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 { + string range \uD83D\uDE00G 0 0 +} \uD83D +test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 { + string range \uD83D\uDE00G 0 0 +} \U1F600 +test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 { + string range \uD83D\uDE00G 0 0 +} \U1F600 +test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { + string range \uD83D\uDE00G 1 1 +} \uDE00 +test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { + string range \uD83D\uDE00G 1 1 +} G +test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { + string range \uD83D\uDE00G 1 1 +} {} +test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { + string range \uD83D\uDE00G 2 2 +} G +test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { + string range \uD83D\uDE00G 2 2 +} {} +test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { + string range \uD83D\uDE00G 2 2 +} G +test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} { + string range \U1f600G 0 0 +} \uFFFD +test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs4} { + string range \U1f600G 0 0 +} \U1F600 +test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc utf16} { + string range \U1f600G 0 0 +} \U1F600 +test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} { + string range \U1f600G 1 1 +} G +test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} { + string range \U1f600G 1 1 +} G +test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} { + string range \U1f600G 1 1 +} {} +test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} { + string range \U1f600G 2 2 +} {} +test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} { + string range \U1f600G 2 2 +} {} +test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} { + string range \U1f600G 2 2 +} G test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { set x \n } { } test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring { - expr {"\ua2" eq [testbytestring "\xc2\xa2"]} + expr {"\uA2" eq [testbytestring \xC2\xA2]} } 1 test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring { - expr {"\u4e21" eq [testbytestring "\xe4\xb8\xa1"]} + expr {"\u4E21" eq [testbytestring \xE4\xB8\xA1]} } 1 test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring { - expr {"\u4e2k" eq "[testbytestring \xd3\xa2]k"} + expr {"\u4E2k" eq "[testbytestring \xD3\xA2]k"} } 1 test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring { - expr {"\u4e216" eq "[testbytestring \xe4\xb8\xa1]6"} -} 1 -test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} testbytestring { - expr {"\U1e2165" eq "[testbytestring \xf0\x9e\x88\x96]5"} -} 1 -test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} testbytestring { - expr {"\U10e2165" eq "[testbytestring \xf4\x8e\x88\x96]5"} -} 1 -proc bsCheck {char num} { + expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"} +} 1 +test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {Uesc fullutf testbytestring} { + expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"} +} 1 +test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {Uesc fullutf testbytestring} { + expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"} +} 1 + +proc bsCheck {char num {constraints {}}} { global errNum - test utf-10.$errNum {backslash substitution} { + test utf-10.$errNum {backslash substitution} $constraints { scan $char %c value set value } $num incr errNum } @@ -230,97 +1004,117 @@ bsCheck b\0 98 bsCheck \x 120 bsCheck \xa 10 bsCheck \xA 10 bsCheck \x41 65 -bsCheck \x541 84 +bsCheck \x541 65 pre388 ;# == \x41 +bsCheck \x541 84 !pre388 ;# == \x54 1 bsCheck \u 117 bsCheck \uk 117 bsCheck \u41 65 bsCheck \ua 10 bsCheck \uA 10 bsCheck \340 224 -bsCheck \ua1 161 -bsCheck \u4e21 20001 -bsCheck \741 60 -bsCheck \U 85 -bsCheck \Uk 85 -bsCheck \U41 65 -bsCheck \Ua 10 -bsCheck \UA 10 -bsCheck \Ua1 161 -bsCheck \U4e21 20001 -bsCheck \U004e21 20001 -bsCheck \U00004e21 20001 -bsCheck \U0000004e21 78 -bsCheck \U00110000 69632 -bsCheck \U01100000 69632 -bsCheck \U11000000 69632 -bsCheck \U0010FFFF 1114111 -bsCheck \U010FFFF0 1114111 -bsCheck \U10FFFF00 1114111 -bsCheck \UFFFFFFFF 1048575 +bsCheck \uA1 161 +bsCheck \u4E21 20001 +bsCheck \741 225 pre388 ;# == \341 +bsCheck \741 60 !pre388 ;# == \74 1 +bsCheck \U 85 +bsCheck \Uk 85 +bsCheck \U41 65 Uesc +bsCheck \Ua 10 Uesc +bsCheck \UA 10 Uesc +bsCheck \UA1 161 Uesc +bsCheck \U4E21 20001 Uesc +bsCheck \U004E21 20001 Uesc +bsCheck \U00004E21 20001 Uesc +bsCheck \U0000004E21 78 Uesc +bsCheck \U00110000 69632 {Uesc fullutf} +bsCheck \U01100000 69632 {Uesc fullutf} +bsCheck \U11000000 69632 {Uesc fullutf} +bsCheck \U0010FFFF 1114111 {Uesc fullutf} +bsCheck \U010FFFF0 1114111 {Uesc fullutf} +bsCheck \U10FFFF00 1114111 {Uesc fullutf} +bsCheck \UFFFFFFFF 1048575 {Uesc fullutf} test utf-11.1 {Tcl_UtfToUpper} { string toupper {} } {} test utf-11.2 {Tcl_UtfToUpper} { string toupper abc } ABC test utf-11.3 {Tcl_UtfToUpper} { - string toupper \u00e3ab -} \u00c3AB + string toupper \xE3gh +} \xC3GH test utf-11.4 {Tcl_UtfToUpper} { - string toupper \u01e3ab -} \u01e2AB + string toupper \u01E3gh +} \u01E2GH test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} { - string toupper \u10d0\u1c90 -} \u1c90\u1c90 -test utf-11.6 {Tcl_UtfToUpper low/high surrogate)} { - string toupper \udc24\ud824 -} \udc24\ud824 + string toupper \u10D0\u1C90 +} \u1C90\u1C90 +test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} {Uesc fullutf} { + string toupper \U10428 +} \U10400 +test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf { + string toupper \uD801\uDC28 +} \uD801\uDC00 +test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} { + string toupper \uDC24\uD824 +} \uDC24\uD824 test utf-12.1 {Tcl_UtfToLower} { string tolower {} } {} test utf-12.2 {Tcl_UtfToLower} { string tolower ABC } abc test utf-12.3 {Tcl_UtfToLower} { - string tolower \u00c3AB -} \u00e3ab + string tolower \xC3GH +} \xE3gh test utf-12.4 {Tcl_UtfToLower} { - string tolower \u01e2AB -} \u01e3ab + string tolower \u01E2GH +} \u01E3gh test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { - string tolower \u10d0\u1c90 -} \u10d0\u10d0 -test utf-12.6 {Tcl_UtfToUpper low/high surrogate)} { - string tolower \udc24\ud824 -} \udc24\ud824 + string tolower \u10D0\u1C90 +} \u10D0\u10D0 +test utf-12.6 {Tcl_UtfToLower low/high surrogate)} { + string tolower \uDC24\uD824 +} \uDC24\uD824 +test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} {Uesc fullutf} { + string tolower \U10400 +} \U10428 +test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf { + string tolower \uD801\uDC00 +} \uD801\uDC28 test utf-13.1 {Tcl_UtfToTitle} { string totitle {} } {} test utf-13.2 {Tcl_UtfToTitle} { string totitle abc } Abc test utf-13.3 {Tcl_UtfToTitle} { - string totitle \u00e3ab -} \u00c3ab + string totitle \xE3GH +} \xC3gh test utf-13.4 {Tcl_UtfToTitle} { - string totitle \u01f3ab -} \u01f2ab + string totitle \u01F3AB +} \u01F2ab test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { - string totitle \u10d0\u1c90 -} \u10d0\u1c90 + string totitle \u10D0\u1C90 +} \u10D0\u1C90 test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { - string totitle \u1c90\u10d0 -} \u1c90\u10d0 + string totitle \u1C90\u10D0 +} \u1C90\u10D0 test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} { - string totitle \udc24\ud824 -} \udc24\ud824 + string totitle \uDC24\uD824 +} \uDC24\uD824 +test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} {Uesc fullutf} { + string totitle \U10428\U10400 +} \U10400\U10428 +test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf { + string totitle \uD801\uDC28\uD801\uDC00 +} \uD801\uDC00\uD801\uDC28 test utf-14.1 {Tcl_UtfNcasecmp} { string compare -nocase a b } -1 test utf-14.2 {Tcl_UtfNcasecmp} { @@ -335,38 +1129,38 @@ test utf-15.1 {Tcl_UniCharToUpper, negative delta} { string toupper aA } AA test utf-15.2 {Tcl_UniCharToUpper, positive delta} { - string toupper \u0178\u00ff + string toupper \u0178\xFF } \u0178\u0178 test utf-15.3 {Tcl_UniCharToUpper, no delta} { string toupper ! } ! test utf-16.1 {Tcl_UniCharToLower, negative delta} { string tolower aA } aa test utf-16.2 {Tcl_UniCharToLower, positive delta} { - string tolower \u0178\u00ff\uA78D\u01c5\U10400 -} \u00ff\u00ff\u0265\u01c6\U10428 + string tolower \u0178\xFF\uA78D\u01C5 +} \xFF\xFF\u0265\u01C6 test utf-17.1 {Tcl_UniCharToLower, no delta} { string tolower ! } ! test utf-18.1 {Tcl_UniCharToTitle, add one for title} { - string totitle \u01c4 -} \u01c5 + string totitle \u01C4 +} \u01C5 test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} { - string totitle \u01c6 -} \u01c5 + string totitle \u01C6 +} \u01C5 test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} { - string totitle \u017f -} \u0053 + string totitle \u017F +} \x53 test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} { - string totitle \u00ff + string totitle \xFF } \u0178 test utf-18.5 {Tcl_UniCharToTitle, no delta} { string totitle ! } ! @@ -374,162 +1168,163 @@ list [regexp \\d abc456def foo] $foo } -cleanup { unset -nocomplain foo } -result {1 4} -test utf-20.1 {TclUniCharNcmp} { -} {} +test utf-20.1 {TclUniCharNcmp} ucs4 { + string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0] +} -1 +test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} knownBug { + set one [format %c 0xFFFF] + set two [format %c 0x10000] + set first [string compare $one $two] + string range $one 0 0 + string range $two 0 0 + set second [string compare $one $two] + expr {($first == $second) ? "agree" : "disagree"} +} agree test utf-21.1 {TclUniCharIsAlnum} { # this returns 1 with Unicode 7 compliance - string is alnum \u1040\u021f\u0220 -} {1} + string is alnum \u1040\u021F\u0220 +} 1 test utf-21.2 {unicode alnum char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220_\u203f\u2040\u2054\ufe33\ufe34\ufe4d\ufe4e\ufe4f\uff3f] + list [regexp {^[[:alnum:]]+$} \u1040\u021F\u0220] [regexp {^\w+$} \u1040\u021F\u0220_\u203F\u2040\u2054\uFE33\uFE34\uFE4D\uFE4E\uFE4F\uFF3F] } {1 1} test utf-21.3 {unicode print char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - regexp {^[[:print:]]+$} \ufbc1 + regexp {^[[:print:]]+$} \uFBC1 } 1 test utf-21.4 {TclUniCharIsGraph} { # [Bug 3464428] string is graph \u0120 -} {1} +} 1 test utf-21.5 {unicode graph char in regc_locale.c} { # [Bug 3464428] regexp {^[[:graph:]]+$} \u0120 -} {1} +} 1 test utf-21.6 {TclUniCharIsGraph} { # [Bug 3464428] - string is graph \u00a0 -} {0} + string is graph \xA0 +} 0 test utf-21.7 {unicode graph char in regc_locale.c} { # [Bug 3464428] - regexp {[[:graph:]]} \u0020\u00a0\u2028\u2029 -} {0} + regexp {[[:graph:]]} \x20\xA0\u2028\u2029 +} 0 test utf-21.8 {TclUniCharIsPrint} { # [Bug 3464428] - string is print \u0009 -} {0} + string is print \x09 +} 0 test utf-21.9 {unicode print char in regc_locale.c} { # [Bug 3464428] - regexp {[[:print:]]} \u0009 -} {0} + regexp {[[:print:]]} \x09 +} 0 test utf-21.10 {unicode print char in regc_locale.c} { # [Bug 3464428] - regexp {[[:print:]]} \u0009 -} {0} + regexp {[[:print:]]} \x09 +} 0 test utf-21.11 {TclUniCharIsControl} { # [Bug 3464428] - string is control \u0000\u001f\u00ad\u0605\u061c\u180e\u2066\ufeff -} {1} + string is control \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF +} 1 test utf-21.12 {unicode control char in regc_locale.c} { # [Bug 3464428], [Bug a876646efe] - regexp {^[[:cntrl:]]*$} \u0000\u001f\u00ad\u0605\u061c\u180e\u2066\ufeff -} {1} + regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF +} 1 test utf-22.1 {TclUniCharIsWordChar} { string wordend "xyz123_bar fg" 0 } 10 test utf-22.2 {TclUniCharIsWordChar} { - string wordend "x\u5080z123_bar\u203c fg" 0 + string wordend "x\u5080z123_bar\u203C fg" 0 } 10 test utf-23.1 {TclUniCharIsAlpha} { # this returns 1 with Unicode 7 compliance - string is alpha \u021f\u0220\u037f\u052f -} {1} + string is alpha \u021F\u0220\u037F\u052F +} 1 test utf-23.2 {unicode alpha char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - regexp {^[[:alpha:]]+$} \u021f\u0220\u037f\u052f -} {1} + regexp {^[[:alpha:]]+$} \u021F\u0220\u037F\u052F +} 1 test utf-24.1 {TclUniCharIsDigit} { # this returns 1 with Unicode 7 compliance - string is digit \u1040\uabf0 -} {1} + string is digit \u1040\uABF0 +} 1 test utf-24.2 {unicode digit char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - list [regexp {^[[:digit:]]+$} \u1040\uabf0] [regexp {^\d+$} \u1040\uabf0] + list [regexp {^[[:digit:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0] } {1 1} test utf-24.3 {TclUniCharIsSpace} { - # this returns 1 with Unicode 7/TIP 413 compliance - string is space \u0085\u1680\u180e\u200b\u202f\u2060 -} {1} + # this returns 1 with Unicode 7 compliance + string is space \u1680\u180E\u202F +} 1 test utf-24.4 {unicode space char in regc_locale.c} { + # this returns 1 with Unicode 7 compliance + list [regexp {^[[:space:]]+$} \u1680\u180E\u202F] [regexp {^\s+$} \u1680\u180E\u202F] +} {1 1} +test utf-24.5 {TclUniCharIsSpace} tip413 { + # this returns 1 with Unicode 7/TIP 413 compliance + string is space \x85\u1680\u180E\u200B\u202F\u2060 +} 1 +test utf-24.6 {unicode space char in regc_locale.c} tip413 { # this returns 1 with Unicode 7/TIP 413 compliance - list [regexp {^[[:space:]]+$} \u0085\u1680\u180e\u200b\u202f\u2060] [regexp {^\s+$} \u0085\u1680\u180e\u200b\u202f\u2060] + list [regexp {^[[:space:]]+$} \x85\u1680\u180E\u200B\u202F\u2060] [regexp {^\s+$} \x85\u1680\u180E\u200B\u202F\u2060] } {1 1} -testConstraint teststringobj [llength [info commands teststringobj]] - -test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ - -setup { - testobj freeallvars - } \ - -body { - teststringobj set 1 a - teststringobj set 2 b - teststringobj getunicode 1 - teststringobj getunicode 2 - string compare -nocase [teststringobj get 1] [teststringobj get 2] - } \ - -cleanup { - testobj freeallvars - } \ - -result -1 -test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \ - -setup { - testobj freeallvars - } \ - -body { - teststringobj set 1 b - teststringobj set 2 a - teststringobj getunicode 1 - teststringobj getunicode 2 - string compare -nocase [teststringobj get 1] [teststringobj get 2] - } \ - -cleanup { - testobj freeallvars - } \ - -result 1 -test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \ - -setup { - testobj freeallvars - } \ - -body { - teststringobj set 1 B - teststringobj set 2 a - teststringobj getunicode 1 - teststringobj getunicode 2 - string compare -nocase [teststringobj get 1] [teststringobj get 2] - } \ - -cleanup { - testobj freeallvars - } \ - -result 1 - -test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \ - -setup { - testobj freeallvars - } \ - -body { - teststringobj set 1 aBcB - teststringobj set 2 abca - teststringobj getunicode 1 - teststringobj getunicode 2 - string compare -nocase [teststringobj get 1] [teststringobj get 2] - } \ - -cleanup { - testobj freeallvars - } \ - -result 1 +proc UniCharCaseCmpTest {order one two {constraints {}}} { + variable count + test utf-25.$count {Tcl_UniCharNcasecmp} -setup { + testobj freeallvars + } -constraints [linsert $constraints 0 teststringobj] -cleanup { + testobj freeallvars + } -body { + teststringobj set 1 $one + teststringobj set 2 $two + teststringobj maxchars 1 + teststringobj maxchars 2 + set result [string compare -nocase [teststringobj get 1] [teststringobj get 2]] + if {$result eq [string map {< -1 = 0 > 1} $order]} { + set result ok + } else { + set result "'$one' should be $order '$two' (no case)" + } + set result + } -result ok + incr count +} +variable count 1 +UniCharCaseCmpTest < a b +UniCharCaseCmpTest > b a +UniCharCaseCmpTest > B a +UniCharCaseCmpTest > aBcB abca +UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4 +UniCharCaseCmpTest < \uFFFF \U10000 {Uesc ucs4} +UniCharCaseCmpTest > [format %c 0x10000] \uFFFF ucs4 +UniCharCaseCmpTest > \U10000 \uFFFF {Uesc ucs4} + + +test utf-26.1 {Tcl_UniCharDString} -setup { + testobj freeallvars +} -constraints {teststringobj testbytestring} -cleanup { + testobj freeallvars +} -body { + teststringobj set 1 foo + teststringobj maxchars 1 + teststringobj append 1 [testbytestring barsoom\xF2\xC2\x80] 10 + scan [string index [teststringobj get 1] 11] %c +} -result 128 + + +unset count +rename UniCharCaseCmpTest {} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: Index: tests/util.test ================================================================== --- tests/util.test +++ tests/util.test @@ -19,10 +19,13 @@ testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] testConstraint testconcatobj [llength [info commands testconcatobj]] testConstraint testdoubledigits [llength [info commands testdoubledigits]] testConstraint testprint [llength [info commands testprint]] + +testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}] + # Big test for correct ordering of data in [expr] proc testIEEE {} { variable ieeeValues @@ -277,11 +280,11 @@ Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc" } 1 test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance: wrong answer would match on UTF trail byte of \u4e4f - Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8Fc] + Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8fc] } 0 test util-5.19 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance. Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc" @@ -382,17 +385,97 @@ Wrapper_Tcl_StringMatch *. "" } 0 test util-5.51 {Tcl_StringMatch} { Wrapper_Tcl_StringMatch "" "" } 1 +test util-5.52 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch \[a\u0000 a\x80 +} 0 + +test util-6.1 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { + set old_precision $::tcl_precision + set ::tcl_precision 12 +} -body { + concat x[expr 1.4] +} -cleanup { + set ::tcl_precision $old_precision +} -result {x1.4} +test util-6.2 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { + set old_precision $::tcl_precision + set ::tcl_precision 12 +} -body { + concat x[expr 1.39999999999] +} -cleanup { + set ::tcl_precision $old_precision +} -result {x1.39999999999} +test util-6.3 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { + set old_precision $::tcl_precision + set ::tcl_precision 12 +} -body { + concat x[expr 1.399999999999] +} -cleanup { + set ::tcl_precision $old_precision +} -result {x1.4} +test util-6.4 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { + set old_precision $::tcl_precision + set ::tcl_precision 5 +} -body { + concat x[expr 1.123412341234] +} -cleanup { + set tcl_precision $old_precision +} -result {x1.1234} test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr 2.0] } {x2.0} test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr 3.0e98] } {x3e+98} + +test util-7.1 {TclPrecTraceProc - unset callbacks} -constraints precision -setup { + set old_precision $::tcl_precision +} -body { + set tcl_precision 7 + set x $tcl_precision + unset tcl_precision + list $x $tcl_precision +} -cleanup { + set ::tcl_precision $old_precision +} -result {7 7} +test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} -constraints precision -setup { + set old_precision $::tcl_precision +} -body { + set tcl_precision 12 + interp create child + set x [child eval set tcl_precision] + child eval {set tcl_precision 6} + interp delete child + list $x $tcl_precision +} -cleanup { + set ::tcl_precision $old_precision +} -result {12 6} +test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} -constraints precision -setup { + set old_precision $::tcl_precision +} -body { + set tcl_precision 12 + interp create -safe child + set x [child eval { + list [catch {set tcl_precision 8} msg] $msg + }] + interp delete child + list $x $tcl_precision +} -cleanup { + set ::tcl_precision $old_precision +} -result {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12} +test util-7.4 {TclPrecTraceProc - write traces, bogus values} -constraints precision -setup { + set old_precision $::tcl_precision +} -body { + set tcl_precision 12 + list [catch {set tcl_precision abc} msg] $msg $tcl_precision +} -cleanup { + set ::tcl_precision $old_precision +} -result {1 {can't set "tcl_precision": improper value for precision} 12} # This test always succeeded in the C locale anyway... test util-8.1 {TclNeedSpace - correct UTF8 handling} { # Bug 411825 # Note that this test relies on the fact that @@ -431,29 +514,68 @@ testdstring append \{ -1 testdstring element foo llength [testdstring get] } 2 test util-8.5 {TclNeedSpace - correct UTF8 handling} testdstring { - # Note that in this test TclNeedSpace actually gets it wrong, - # claiming we need a space when we really do not. Extra space - # between list elements is harmless though, and better to have - # extra space in really weird string reps of lists, than to - # invest the effort required to make TclNeedSpace foolproof. testdstring free testdstring append {\\ } -1 testdstring element foo list [llength [testdstring get]] [string length [testdstring get]] -} {2 7} +} {2 6} test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { - # Another example of TclNeedSpace harmlessly getting it wrong. testdstring free testdstring append {\\ } -1 testdstring append \{ -1 testdstring element foo testdstring append \} -1 list [llength [testdstring get]] [string length [testdstring get]] -} {2 9} +} {2 8} +test util-8.7 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\ } -1 + testdstring start + testdstring end + + # Should make {\ {}} + list [llength [testdstring get]] [string index [testdstring get] 3] +} {2 \{} +test util-8.8 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\ } -1 + testdstring start + testdstring end + + # Should make {\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 3] +} {2 \{} +test util-8.9 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\\ } -1 + testdstring start + testdstring end + + # Should make {\\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 5] +} {2 \{} +test util-8.10 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\\\\\\ } -1 + testdstring start + testdstring end + + # Should make {\\\\\\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 9] +} {2 \{} +test util-8.11 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\\\\\\\ } -1 + testdstring start + testdstring end + + # Should make {\\\\\\\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 9] +} {2 \{} test util-9.0.0 {Tcl_GetIntForIndex} { string index abcd 0 } a test util-9.0.1 {Tcl_GetIntForIndex} { @@ -651,20 +773,20 @@ string index a 0+1.5e1 } -returnCodes error -match glob -result * test util-9.44 {Tcl_GetIntForIndex} -body { string index a 0+1000000000000 } -result {} -test util-9.45 {Tcl_GetIntForIndex} { +test util-9.45 {Tcl_GetIntForIndex} -body { string index abcd end+2305843009213693950 -} {} -test util-9.46 {Tcl_GetIntForIndex} { +} -result {} +test util-9.46 {Tcl_GetIntForIndex} -body { string index abcd end+4294967294 -} {} +} -result {} # TIP 502 -test util-9.47 {Tcl_GetIntForIndex} { +test util-9.47 {Tcl_GetIntForIndex} -body { string index abcd 0x10000000000000000 -} {} +} -result {} test util-9.48 {Tcl_GetIntForIndex} { string index abcd -0x10000000000000000 } {} test util-9.49 {Tcl_GetIntForIndex} -body { string index abcd end*1 @@ -682,22 +804,22 @@ string index abcd end-0.1 } -returnCodes error -match glob -result * test util-9.54 {Tcl_GetIntForIndex} { string index abcd end-0x10000000000000000 } {} -test util-9.55 {Tcl_GetIntForIndex} { +test util-9.55 {Tcl_GetIntForIndex} -body { string index abcd end+0x10000000000000000 -} {} -test util-9.56 {Tcl_GetIntForIndex} { +} -result {} +test util-9.56 {Tcl_GetIntForIndex} -body { string index abcd end--0x10000000000000000 -} {} +} -result {} test util-9.57 {Tcl_GetIntForIndex} { string index abcd end+-0x10000000000000000 } {} -test util-9.58 {Tcl_GetIntForIndex} { +test util-9.58 {Tcl_GetIntForIndex} -body { string index abcd end--0x8000000000000000 -} {} +} -result {} test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { convertDouble 0x0000000000000000 } {0.0} test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} { @@ -2102,10 +2224,1878 @@ -result 0x8010000000000000 -cleanup { unset x } } + +foreach ::tcl_precision {0 12} { + for {set e -312} {$e < -9} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 1.1e$e" 1.1e$e + } +} +set tcl_precision 0 +for {set e -9} {$e < -4} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 1.1e$e" 1.1e$e +} +set tcl_precision 12 +for {set e -9} {$e < -4} {incr e} { + test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} precision \ + "expr 1.1e$e" 1.1e[format %+03d $e] +} +foreach ::tcl_precision {0 12} { + test util-16.1.$::tcl_precision.-4 {shortening of numbers} \ + {expr 1.1e-4} \ + 0.00011 + test util-16.1.$::tcl_precision.-3 {shortening of numbers} \ + {expr 1.1e-3} \ + 0.0011 + test util-16.1.$::tcl_precision.-2 {shortening of numbers} \ + {expr 1.1e-2} \ + 0.011 + test util-16.1.$::tcl_precision.-1 {shortening of numbers} \ + {expr 1.1e-1} \ + 0.11 + test util-16.1.$::tcl_precision.0 {shortening of numbers} \ + {expr 1.1} \ + 1.1 + for {set e 1} {$e < 17} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 11[string repeat 0 [expr {$e-1}]].0" \ + 11[string repeat 0 [expr {$e-1}]].0 + } + for {set e 17} {$e < 309} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 1.1e$e" 1.1e+$e + } +} +set tcl_precision 17 +test util-16.1.17.-300 {8.4 compatible formatting of doubles} precision \ + {expr 1e-300} \ + 1e-300 +test util-16.1.17.-299 {8.4 compatible formatting of doubles} precision \ + {expr 1e-299} \ + 9.9999999999999999e-300 +test util-16.1.17.-298 {8.4 compatible formatting of doubles} precision \ + {expr 1e-298} \ + 9.9999999999999991e-299 +test util-16.1.17.-297 {8.4 compatible formatting of doubles} precision \ + {expr 1e-297} \ + 1e-297 +test util-16.1.17.-296 {8.4 compatible formatting of doubles} precision \ + {expr 1e-296} \ + 1e-296 +test util-16.1.17.-295 {8.4 compatible formatting of doubles} precision \ + {expr 1e-295} \ + 1.0000000000000001e-295 +test util-16.1.17.-294 {8.4 compatible formatting of doubles} precision \ + {expr 1e-294} \ + 1e-294 +test util-16.1.17.-293 {8.4 compatible formatting of doubles} precision \ + {expr 1e-293} \ + 1.0000000000000001e-293 +test util-16.1.17.-292 {8.4 compatible formatting of doubles} precision \ + {expr 1e-292} \ + 1.0000000000000001e-292 +test util-16.1.17.-291 {8.4 compatible formatting of doubles} precision \ + {expr 1e-291} \ + 9.9999999999999996e-292 +test util-16.1.17.-290 {8.4 compatible formatting of doubles} precision \ + {expr 1e-290} \ + 1.0000000000000001e-290 +test util-16.1.17.-289 {8.4 compatible formatting of doubles} precision \ + {expr 1e-289} \ + 1e-289 +test util-16.1.17.-288 {8.4 compatible formatting of doubles} precision \ + {expr 1e-288} \ + 1.0000000000000001e-288 +test util-16.1.17.-287 {8.4 compatible formatting of doubles} precision \ + {expr 1e-287} \ + 1e-287 +test util-16.1.17.-286 {8.4 compatible formatting of doubles} precision \ + {expr 1e-286} \ + 1.0000000000000001e-286 +test util-16.1.17.-285 {8.4 compatible formatting of doubles} precision \ + {expr 1e-285} \ + 1.0000000000000001e-285 +test util-16.1.17.-284 {8.4 compatible formatting of doubles} precision \ + {expr 1e-284} \ + 1e-284 +test util-16.1.17.-283 {8.4 compatible formatting of doubles} precision \ + {expr 1e-283} \ + 9.9999999999999995e-284 +test util-16.1.17.-282 {8.4 compatible formatting of doubles} precision \ + {expr 1e-282} \ + 1e-282 +test util-16.1.17.-281 {8.4 compatible formatting of doubles} precision \ + {expr 1e-281} \ + 1e-281 +test util-16.1.17.-280 {8.4 compatible formatting of doubles} precision \ + {expr 1e-280} \ + 9.9999999999999996e-281 +test util-16.1.17.-279 {8.4 compatible formatting of doubles} precision \ + {expr 1e-279} \ + 1.0000000000000001e-279 +test util-16.1.17.-278 {8.4 compatible formatting of doubles} precision \ + {expr 1e-278} \ + 9.9999999999999994e-279 +test util-16.1.17.-277 {8.4 compatible formatting of doubles} precision \ + {expr 1e-277} \ + 9.9999999999999997e-278 +test util-16.1.17.-276 {8.4 compatible formatting of doubles} precision \ + {expr 1e-276} \ + 1.0000000000000001e-276 +test util-16.1.17.-275 {8.4 compatible formatting of doubles} precision \ + {expr 1e-275} \ + 9.9999999999999993e-276 +test util-16.1.17.-274 {8.4 compatible formatting of doubles} precision \ + {expr 1e-274} \ + 9.9999999999999997e-275 +test util-16.1.17.-273 {8.4 compatible formatting of doubles} precision \ + {expr 1e-273} \ + 1.0000000000000001e-273 +test util-16.1.17.-272 {8.4 compatible formatting of doubles} precision \ + {expr 1e-272} \ + 9.9999999999999993e-273 +test util-16.1.17.-271 {8.4 compatible formatting of doubles} precision \ + {expr 1e-271} \ + 9.9999999999999996e-272 +test util-16.1.17.-270 {8.4 compatible formatting of doubles} precision \ + {expr 1e-270} \ + 1e-270 +test util-16.1.17.-269 {8.4 compatible formatting of doubles} precision \ + {expr 1e-269} \ + 9.9999999999999996e-270 +test util-16.1.17.-268 {8.4 compatible formatting of doubles} precision \ + {expr 1e-268} \ + 9.9999999999999996e-269 +test util-16.1.17.-267 {8.4 compatible formatting of doubles} precision \ + {expr 1e-267} \ + 9.9999999999999998e-268 +test util-16.1.17.-266 {8.4 compatible formatting of doubles} precision \ + {expr 1e-266} \ + 9.9999999999999998e-267 +test util-16.1.17.-265 {8.4 compatible formatting of doubles} precision \ + {expr 1e-265} \ + 9.9999999999999998e-266 +test util-16.1.17.-264 {8.4 compatible formatting of doubles} precision \ + {expr 1e-264} \ + 1e-264 +test util-16.1.17.-263 {8.4 compatible formatting of doubles} precision \ + {expr 1e-263} \ + 1e-263 +test util-16.1.17.-262 {8.4 compatible formatting of doubles} precision \ + {expr 1e-262} \ + 1e-262 +test util-16.1.17.-261 {8.4 compatible formatting of doubles} precision \ + {expr 1e-261} \ + 9.9999999999999998e-262 +test util-16.1.17.-260 {8.4 compatible formatting of doubles} precision \ + {expr 1e-260} \ + 9.9999999999999996e-261 +test util-16.1.17.-259 {8.4 compatible formatting of doubles} precision \ + {expr 1e-259} \ + 1.0000000000000001e-259 +test util-16.1.17.-258 {8.4 compatible formatting of doubles} precision \ + {expr 1e-258} \ + 9.9999999999999995e-259 +test util-16.1.17.-257 {8.4 compatible formatting of doubles} precision \ + {expr 1e-257} \ + 9.9999999999999998e-258 +test util-16.1.17.-256 {8.4 compatible formatting of doubles} precision \ + {expr 1e-256} \ + 9.9999999999999998e-257 +test util-16.1.17.-255 {8.4 compatible formatting of doubles} precision \ + {expr 1e-255} \ + 1e-255 +test util-16.1.17.-254 {8.4 compatible formatting of doubles} precision \ + {expr 1e-254} \ + 9.9999999999999991e-255 +test util-16.1.17.-253 {8.4 compatible formatting of doubles} precision \ + {expr 1e-253} \ + 1.0000000000000001e-253 +test util-16.1.17.-252 {8.4 compatible formatting of doubles} precision \ + {expr 1e-252} \ + 9.9999999999999994e-253 +test util-16.1.17.-251 {8.4 compatible formatting of doubles} precision \ + {expr 1e-251} \ + 1e-251 +test util-16.1.17.-250 {8.4 compatible formatting of doubles} precision \ + {expr 1e-250} \ + 1.0000000000000001e-250 +test util-16.1.17.-249 {8.4 compatible formatting of doubles} precision \ + {expr 1e-249} \ + 1.0000000000000001e-249 +test util-16.1.17.-248 {8.4 compatible formatting of doubles} precision \ + {expr 1e-248} \ + 9.9999999999999998e-249 +test util-16.1.17.-247 {8.4 compatible formatting of doubles} precision \ + {expr 1e-247} \ + 1e-247 +test util-16.1.17.-246 {8.4 compatible formatting of doubles} precision \ + {expr 1e-246} \ + 9.9999999999999996e-247 +test util-16.1.17.-245 {8.4 compatible formatting of doubles} precision \ + {expr 1e-245} \ + 9.9999999999999993e-246 +test util-16.1.17.-244 {8.4 compatible formatting of doubles} precision \ + {expr 1e-244} \ + 9.9999999999999993e-245 +test util-16.1.17.-243 {8.4 compatible formatting of doubles} precision \ + {expr 1e-243} \ + 1e-243 +test util-16.1.17.-242 {8.4 compatible formatting of doubles} precision \ + {expr 1e-242} \ + 9.9999999999999997e-243 +test util-16.1.17.-241 {8.4 compatible formatting of doubles} precision \ + {expr 1e-241} \ + 9.9999999999999997e-242 +test util-16.1.17.-240 {8.4 compatible formatting of doubles} precision \ + {expr 1e-240} \ + 9.9999999999999997e-241 +test util-16.1.17.-239 {8.4 compatible formatting of doubles} precision \ + {expr 1e-239} \ + 1.0000000000000001e-239 +test util-16.1.17.-238 {8.4 compatible formatting of doubles} precision \ + {expr 1e-238} \ + 9.9999999999999999e-239 +test util-16.1.17.-237 {8.4 compatible formatting of doubles} precision \ + {expr 1e-237} \ + 9.9999999999999999e-238 +test util-16.1.17.-236 {8.4 compatible formatting of doubles} precision \ + {expr 1e-236} \ + 1e-236 +test util-16.1.17.-235 {8.4 compatible formatting of doubles} precision \ + {expr 1e-235} \ + 9.9999999999999996e-236 +test util-16.1.17.-234 {8.4 compatible formatting of doubles} precision \ + {expr 1e-234} \ + 9.9999999999999996e-235 +test util-16.1.17.-233 {8.4 compatible formatting of doubles} precision \ + {expr 1e-233} \ + 9.9999999999999996e-234 +test util-16.1.17.-232 {8.4 compatible formatting of doubles} precision \ + {expr 1e-232} \ + 1e-232 +test util-16.1.17.-231 {8.4 compatible formatting of doubles} precision \ + {expr 1e-231} \ + 9.9999999999999999e-232 +test util-16.1.17.-230 {8.4 compatible formatting of doubles} precision \ + {expr 1e-230} \ + 1e-230 +test util-16.1.17.-229 {8.4 compatible formatting of doubles} precision \ + {expr 1e-229} \ + 1.0000000000000001e-229 +test util-16.1.17.-228 {8.4 compatible formatting of doubles} precision \ + {expr 1e-228} \ + 1e-228 +test util-16.1.17.-227 {8.4 compatible formatting of doubles} precision \ + {expr 1e-227} \ + 9.9999999999999994e-228 +test util-16.1.17.-226 {8.4 compatible formatting of doubles} precision \ + {expr 1e-226} \ + 9.9999999999999992e-227 +test util-16.1.17.-225 {8.4 compatible formatting of doubles} precision \ + {expr 1e-225} \ + 9.9999999999999996e-226 +test util-16.1.17.-224 {8.4 compatible formatting of doubles} precision \ + {expr 1e-224} \ + 1e-224 +test util-16.1.17.-223 {8.4 compatible formatting of doubles} precision \ + {expr 1e-223} \ + 9.9999999999999997e-224 +test util-16.1.17.-222 {8.4 compatible formatting of doubles} precision \ + {expr 1e-222} \ + 1e-222 +test util-16.1.17.-221 {8.4 compatible formatting of doubles} precision \ + {expr 1e-221} \ + 1e-221 +test util-16.1.17.-220 {8.4 compatible formatting of doubles} precision \ + {expr 1e-220} \ + 9.9999999999999999e-221 +test util-16.1.17.-219 {8.4 compatible formatting of doubles} precision \ + {expr 1e-219} \ + 1e-219 +test util-16.1.17.-218 {8.4 compatible formatting of doubles} precision \ + {expr 1e-218} \ + 1e-218 +test util-16.1.17.-217 {8.4 compatible formatting of doubles} precision \ + {expr 1e-217} \ + 1.0000000000000001e-217 +test util-16.1.17.-216 {8.4 compatible formatting of doubles} precision \ + {expr 1e-216} \ + 1e-216 +test util-16.1.17.-215 {8.4 compatible formatting of doubles} precision \ + {expr 1e-215} \ + 1e-215 +test util-16.1.17.-214 {8.4 compatible formatting of doubles} precision \ + {expr 1e-214} \ + 9.9999999999999991e-215 +test util-16.1.17.-213 {8.4 compatible formatting of doubles} precision \ + {expr 1e-213} \ + 9.9999999999999995e-214 +test util-16.1.17.-212 {8.4 compatible formatting of doubles} precision \ + {expr 1e-212} \ + 9.9999999999999995e-213 +test util-16.1.17.-211 {8.4 compatible formatting of doubles} precision \ + {expr 1e-211} \ + 1.0000000000000001e-211 +test util-16.1.17.-210 {8.4 compatible formatting of doubles} precision \ + {expr 1e-210} \ + 1e-210 +test util-16.1.17.-209 {8.4 compatible formatting of doubles} precision \ + {expr 1e-209} \ + 1e-209 +test util-16.1.17.-208 {8.4 compatible formatting of doubles} precision \ + {expr 1e-208} \ + 1.0000000000000001e-208 +test util-16.1.17.-207 {8.4 compatible formatting of doubles} precision \ + {expr 1e-207} \ + 9.9999999999999993e-208 +test util-16.1.17.-206 {8.4 compatible formatting of doubles} precision \ + {expr 1e-206} \ + 1e-206 +test util-16.1.17.-205 {8.4 compatible formatting of doubles} precision \ + {expr 1e-205} \ + 1e-205 +test util-16.1.17.-204 {8.4 compatible formatting of doubles} precision \ + {expr 1e-204} \ + 1e-204 +test util-16.1.17.-203 {8.4 compatible formatting of doubles} precision \ + {expr 1e-203} \ + 1e-203 +test util-16.1.17.-202 {8.4 compatible formatting of doubles} precision \ + {expr 1e-202} \ + 1e-202 +test util-16.1.17.-201 {8.4 compatible formatting of doubles} precision \ + {expr 1e-201} \ + 9.9999999999999995e-202 +test util-16.1.17.-200 {8.4 compatible formatting of doubles} precision \ + {expr 1e-200} \ + 9.9999999999999998e-201 +test util-16.1.17.-199 {8.4 compatible formatting of doubles} precision \ + {expr 1e-199} \ + 9.9999999999999998e-200 +test util-16.1.17.-198 {8.4 compatible formatting of doubles} precision \ + {expr 1e-198} \ + 9.9999999999999991e-199 +test util-16.1.17.-197 {8.4 compatible formatting of doubles} precision \ + {expr 1e-197} \ + 9.9999999999999999e-198 +test util-16.1.17.-196 {8.4 compatible formatting of doubles} precision \ + {expr 1e-196} \ + 1e-196 +test util-16.1.17.-195 {8.4 compatible formatting of doubles} precision \ + {expr 1e-195} \ + 1.0000000000000001e-195 +test util-16.1.17.-194 {8.4 compatible formatting of doubles} precision \ + {expr 1e-194} \ + 1e-194 +test util-16.1.17.-193 {8.4 compatible formatting of doubles} precision \ + {expr 1e-193} \ + 1e-193 +test util-16.1.17.-192 {8.4 compatible formatting of doubles} precision \ + {expr 1e-192} \ + 1.0000000000000001e-192 +test util-16.1.17.-191 {8.4 compatible formatting of doubles} precision \ + {expr 1e-191} \ + 1e-191 +test util-16.1.17.-190 {8.4 compatible formatting of doubles} precision \ + {expr 1e-190} \ + 1e-190 +test util-16.1.17.-189 {8.4 compatible formatting of doubles} precision \ + {expr 1e-189} \ + 1.0000000000000001e-189 +test util-16.1.17.-188 {8.4 compatible formatting of doubles} precision \ + {expr 1e-188} \ + 9.9999999999999995e-189 +test util-16.1.17.-187 {8.4 compatible formatting of doubles} precision \ + {expr 1e-187} \ + 1e-187 +test util-16.1.17.-186 {8.4 compatible formatting of doubles} precision \ + {expr 1e-186} \ + 9.9999999999999991e-187 +test util-16.1.17.-185 {8.4 compatible formatting of doubles} precision \ + {expr 1e-185} \ + 9.9999999999999999e-186 +test util-16.1.17.-184 {8.4 compatible formatting of doubles} precision \ + {expr 1e-184} \ + 1.0000000000000001e-184 +test util-16.1.17.-183 {8.4 compatible formatting of doubles} precision \ + {expr 1e-183} \ + 1e-183 +test util-16.1.17.-182 {8.4 compatible formatting of doubles} precision \ + {expr 1e-182} \ + 1e-182 +test util-16.1.17.-181 {8.4 compatible formatting of doubles} precision \ + {expr 1e-181} \ + 1e-181 +test util-16.1.17.-180 {8.4 compatible formatting of doubles} precision \ + {expr 1e-180} \ + 1e-180 +test util-16.1.17.-179 {8.4 compatible formatting of doubles} precision \ + {expr 1e-179} \ + 1e-179 +test util-16.1.17.-178 {8.4 compatible formatting of doubles} precision \ + {expr 1e-178} \ + 9.9999999999999995e-179 +test util-16.1.17.-177 {8.4 compatible formatting of doubles} precision \ + {expr 1e-177} \ + 9.9999999999999995e-178 +test util-16.1.17.-176 {8.4 compatible formatting of doubles} precision \ + {expr 1e-176} \ + 1e-176 +test util-16.1.17.-175 {8.4 compatible formatting of doubles} precision \ + {expr 1e-175} \ + 1e-175 +test util-16.1.17.-174 {8.4 compatible formatting of doubles} precision \ + {expr 1e-174} \ + 1e-174 +test util-16.1.17.-173 {8.4 compatible formatting of doubles} precision \ + {expr 1e-173} \ + 1e-173 +test util-16.1.17.-172 {8.4 compatible formatting of doubles} precision \ + {expr 1e-172} \ + 1e-172 +test util-16.1.17.-171 {8.4 compatible formatting of doubles} precision \ + {expr 1e-171} \ + 9.9999999999999998e-172 +test util-16.1.17.-170 {8.4 compatible formatting of doubles} precision \ + {expr 1e-170} \ + 9.9999999999999998e-171 +test util-16.1.17.-169 {8.4 compatible formatting of doubles} precision \ + {expr 1e-169} \ + 1e-169 +test util-16.1.17.-168 {8.4 compatible formatting of doubles} precision \ + {expr 1e-168} \ + 1e-168 +test util-16.1.17.-167 {8.4 compatible formatting of doubles} precision \ + {expr 1e-167} \ + 1e-167 +test util-16.1.17.-166 {8.4 compatible formatting of doubles} precision \ + {expr 1e-166} \ + 1e-166 +test util-16.1.17.-165 {8.4 compatible formatting of doubles} precision \ + {expr 1e-165} \ + 1e-165 +test util-16.1.17.-164 {8.4 compatible formatting of doubles} precision \ + {expr 1e-164} \ + 9.9999999999999996e-165 +test util-16.1.17.-163 {8.4 compatible formatting of doubles} precision \ + {expr 1e-163} \ + 9.9999999999999992e-164 +test util-16.1.17.-162 {8.4 compatible formatting of doubles} precision \ + {expr 1e-162} \ + 9.9999999999999995e-163 +test util-16.1.17.-161 {8.4 compatible formatting of doubles} precision \ + {expr 1e-161} \ + 1e-161 +test util-16.1.17.-160 {8.4 compatible formatting of doubles} precision \ + {expr 1e-160} \ + 9.9999999999999999e-161 +test util-16.1.17.-159 {8.4 compatible formatting of doubles} precision \ + {expr 1e-159} \ + 9.9999999999999999e-160 +test util-16.1.17.-158 {8.4 compatible formatting of doubles} precision \ + {expr 1e-158} \ + 1.0000000000000001e-158 +test util-16.1.17.-157 {8.4 compatible formatting of doubles} precision \ + {expr 1e-157} \ + 9.9999999999999994e-158 +test util-16.1.17.-156 {8.4 compatible formatting of doubles} precision \ + {expr 1e-156} \ + 1e-156 +test util-16.1.17.-155 {8.4 compatible formatting of doubles} precision \ + {expr 1e-155} \ + 1e-155 +test util-16.1.17.-154 {8.4 compatible formatting of doubles} precision \ + {expr 1e-154} \ + 9.9999999999999997e-155 +test util-16.1.17.-153 {8.4 compatible formatting of doubles} precision \ + {expr 1e-153} \ + 1e-153 +test util-16.1.17.-152 {8.4 compatible formatting of doubles} precision \ + {expr 1e-152} \ + 1.0000000000000001e-152 +test util-16.1.17.-151 {8.4 compatible formatting of doubles} precision \ + {expr 1e-151} \ + 9.9999999999999994e-152 +test util-16.1.17.-150 {8.4 compatible formatting of doubles} precision \ + {expr 1e-150} \ + 1e-150 +test util-16.1.17.-149 {8.4 compatible formatting of doubles} precision \ + {expr 1e-149} \ + 9.9999999999999998e-150 +test util-16.1.17.-148 {8.4 compatible formatting of doubles} precision \ + {expr 1e-148} \ + 9.9999999999999994e-149 +test util-16.1.17.-147 {8.4 compatible formatting of doubles} precision \ + {expr 1e-147} \ + 9.9999999999999997e-148 +test util-16.1.17.-146 {8.4 compatible formatting of doubles} precision \ + {expr 1e-146} \ + 1e-146 +test util-16.1.17.-145 {8.4 compatible formatting of doubles} precision \ + {expr 1e-145} \ + 9.9999999999999991e-146 +test util-16.1.17.-144 {8.4 compatible formatting of doubles} precision \ + {expr 1e-144} \ + 9.9999999999999995e-145 +test util-16.1.17.-143 {8.4 compatible formatting of doubles} precision \ + {expr 1e-143} \ + 9.9999999999999995e-144 +test util-16.1.17.-142 {8.4 compatible formatting of doubles} precision \ + {expr 1e-142} \ + 1e-142 +test util-16.1.17.-141 {8.4 compatible formatting of doubles} precision \ + {expr 1e-141} \ + 1e-141 +test util-16.1.17.-140 {8.4 compatible formatting of doubles} precision \ + {expr 1e-140} \ + 9.9999999999999998e-141 +test util-16.1.17.-139 {8.4 compatible formatting of doubles} precision \ + {expr 1e-139} \ + 1e-139 +test util-16.1.17.-138 {8.4 compatible formatting of doubles} precision \ + {expr 1e-138} \ + 1.0000000000000001e-138 +test util-16.1.17.-137 {8.4 compatible formatting of doubles} precision \ + {expr 1e-137} \ + 9.9999999999999998e-138 +test util-16.1.17.-136 {8.4 compatible formatting of doubles} precision \ + {expr 1e-136} \ + 1e-136 +test util-16.1.17.-135 {8.4 compatible formatting of doubles} precision \ + {expr 1e-135} \ + 1e-135 +test util-16.1.17.-134 {8.4 compatible formatting of doubles} precision \ + {expr 1e-134} \ + 1e-134 +test util-16.1.17.-133 {8.4 compatible formatting of doubles} precision \ + {expr 1e-133} \ + 1.0000000000000001e-133 +test util-16.1.17.-132 {8.4 compatible formatting of doubles} precision \ + {expr 1e-132} \ + 9.9999999999999999e-133 +test util-16.1.17.-131 {8.4 compatible formatting of doubles} precision \ + {expr 1e-131} \ + 9.9999999999999999e-132 +test util-16.1.17.-130 {8.4 compatible formatting of doubles} precision \ + {expr 1e-130} \ + 1.0000000000000001e-130 +test util-16.1.17.-129 {8.4 compatible formatting of doubles} precision \ + {expr 1e-129} \ + 9.9999999999999993e-130 +test util-16.1.17.-128 {8.4 compatible formatting of doubles} precision \ + {expr 1e-128} \ + 1.0000000000000001e-128 +test util-16.1.17.-127 {8.4 compatible formatting of doubles} precision \ + {expr 1e-127} \ + 1e-127 +test util-16.1.17.-126 {8.4 compatible formatting of doubles} precision \ + {expr 1e-126} \ + 9.9999999999999995e-127 +test util-16.1.17.-125 {8.4 compatible formatting of doubles} precision \ + {expr 1e-125} \ + 1e-125 +test util-16.1.17.-124 {8.4 compatible formatting of doubles} precision \ + {expr 1e-124} \ + 9.9999999999999993e-125 +test util-16.1.17.-123 {8.4 compatible formatting of doubles} precision \ + {expr 1e-123} \ + 1.0000000000000001e-123 +test util-16.1.17.-122 {8.4 compatible formatting of doubles} precision \ + {expr 1e-122} \ + 1.0000000000000001e-122 +test util-16.1.17.-121 {8.4 compatible formatting of doubles} precision \ + {expr 1e-121} \ + 9.9999999999999998e-122 +test util-16.1.17.-120 {8.4 compatible formatting of doubles} precision \ + {expr 1e-120} \ + 9.9999999999999998e-121 +test util-16.1.17.-119 {8.4 compatible formatting of doubles} precision \ + {expr 1e-119} \ + 1e-119 +test util-16.1.17.-118 {8.4 compatible formatting of doubles} precision \ + {expr 1e-118} \ + 9.9999999999999999e-119 +test util-16.1.17.-117 {8.4 compatible formatting of doubles} precision \ + {expr 1e-117} \ + 1e-117 +test util-16.1.17.-116 {8.4 compatible formatting of doubles} precision \ + {expr 1e-116} \ + 9.9999999999999999e-117 +test util-16.1.17.-115 {8.4 compatible formatting of doubles} precision \ + {expr 1e-115} \ + 1.0000000000000001e-115 +test util-16.1.17.-114 {8.4 compatible formatting of doubles} precision \ + {expr 1e-114} \ + 1.0000000000000001e-114 +test util-16.1.17.-113 {8.4 compatible formatting of doubles} precision \ + {expr 1e-113} \ + 9.9999999999999998e-114 +test util-16.1.17.-112 {8.4 compatible formatting of doubles} precision \ + {expr 1e-112} \ + 9.9999999999999995e-113 +test util-16.1.17.-111 {8.4 compatible formatting of doubles} precision \ + {expr 1e-111} \ + 1.0000000000000001e-111 +test util-16.1.17.-110 {8.4 compatible formatting of doubles} precision \ + {expr 1e-110} \ + 1.0000000000000001e-110 +test util-16.1.17.-109 {8.4 compatible formatting of doubles} precision \ + {expr 1e-109} \ + 9.9999999999999999e-110 +test util-16.1.17.-108 {8.4 compatible formatting of doubles} precision \ + {expr 1e-108} \ + 1e-108 +test util-16.1.17.-107 {8.4 compatible formatting of doubles} precision \ + {expr 1e-107} \ + 1e-107 +test util-16.1.17.-106 {8.4 compatible formatting of doubles} precision \ + {expr 1e-106} \ + 9.9999999999999994e-107 +test util-16.1.17.-105 {8.4 compatible formatting of doubles} precision \ + {expr 1e-105} \ + 9.9999999999999997e-106 +test util-16.1.17.-104 {8.4 compatible formatting of doubles} precision \ + {expr 1e-104} \ + 9.9999999999999993e-105 +test util-16.1.17.-103 {8.4 compatible formatting of doubles} precision \ + {expr 1e-103} \ + 9.9999999999999996e-104 +test util-16.1.17.-102 {8.4 compatible formatting of doubles} precision \ + {expr 1e-102} \ + 9.9999999999999993e-103 +test util-16.1.17.-101 {8.4 compatible formatting of doubles} precision \ + {expr 1e-101} \ + 1.0000000000000001e-101 +test util-16.1.17.-100 {8.4 compatible formatting of doubles} precision \ + {expr 1e-100} \ + 1e-100 +test util-16.1.17.-99 {8.4 compatible formatting of doubles} precision \ + {expr 1e-99} \ + 1e-99 +test util-16.1.17.-98 {8.4 compatible formatting of doubles} precision \ + {expr 1e-98} \ + 9.9999999999999994e-99 +test util-16.1.17.-97 {8.4 compatible formatting of doubles} precision \ + {expr 1e-97} \ + 1e-97 +test util-16.1.17.-96 {8.4 compatible formatting of doubles} precision \ + {expr 1e-96} \ + 9.9999999999999991e-97 +test util-16.1.17.-95 {8.4 compatible formatting of doubles} precision \ + {expr 1e-95} \ + 9.9999999999999999e-96 +test util-16.1.17.-94 {8.4 compatible formatting of doubles} precision \ + {expr 1e-94} \ + 9.9999999999999996e-95 +test util-16.1.17.-93 {8.4 compatible formatting of doubles} precision \ + {expr 1e-93} \ + 9.999999999999999e-94 +test util-16.1.17.-92 {8.4 compatible formatting of doubles} precision \ + {expr 1e-92} \ + 9.9999999999999999e-93 +test util-16.1.17.-91 {8.4 compatible formatting of doubles} precision \ + {expr 1e-91} \ + 1e-91 +test util-16.1.17.-90 {8.4 compatible formatting of doubles} precision \ + {expr 1e-90} \ + 9.9999999999999999e-91 +test util-16.1.17.-89 {8.4 compatible formatting of doubles} precision \ + {expr 1e-89} \ + 1e-89 +test util-16.1.17.-88 {8.4 compatible formatting of doubles} precision \ + {expr 1e-88} \ + 9.9999999999999993e-89 +test util-16.1.17.-87 {8.4 compatible formatting of doubles} precision \ + {expr 1e-87} \ + 1e-87 +test util-16.1.17.-86 {8.4 compatible formatting of doubles} precision \ + {expr 1e-86} \ + 1.0000000000000001e-86 +test util-16.1.17.-85 {8.4 compatible formatting of doubles} precision \ + {expr 1e-85} \ + 9.9999999999999998e-86 +test util-16.1.17.-84 {8.4 compatible formatting of doubles} precision \ + {expr 1e-84} \ + 1e-84 +test util-16.1.17.-83 {8.4 compatible formatting of doubles} precision \ + {expr 1e-83} \ + 1e-83 +test util-16.1.17.-82 {8.4 compatible formatting of doubles} precision \ + {expr 1e-82} \ + 9.9999999999999996e-83 +test util-16.1.17.-81 {8.4 compatible formatting of doubles} precision \ + {expr 1e-81} \ + 9.9999999999999996e-82 +test util-16.1.17.-80 {8.4 compatible formatting of doubles} precision \ + {expr 1e-80} \ + 9.9999999999999996e-81 +test util-16.1.17.-79 {8.4 compatible formatting of doubles} precision \ + {expr 1e-79} \ + 1e-79 +test util-16.1.17.-78 {8.4 compatible formatting of doubles} precision \ + {expr 1e-78} \ + 1e-78 +test util-16.1.17.-77 {8.4 compatible formatting of doubles} precision \ + {expr 1e-77} \ + 9.9999999999999993e-78 +test util-16.1.17.-76 {8.4 compatible formatting of doubles} precision \ + {expr 1e-76} \ + 9.9999999999999993e-77 +test util-16.1.17.-75 {8.4 compatible formatting of doubles} precision \ + {expr 1e-75} \ + 9.9999999999999996e-76 +test util-16.1.17.-74 {8.4 compatible formatting of doubles} precision \ + {expr 1e-74} \ + 9.9999999999999996e-75 +test util-16.1.17.-73 {8.4 compatible formatting of doubles} precision \ + {expr 1e-73} \ + 1e-73 +test util-16.1.17.-72 {8.4 compatible formatting of doubles} precision \ + {expr 1e-72} \ + 9.9999999999999997e-73 +test util-16.1.17.-71 {8.4 compatible formatting of doubles} precision \ + {expr 1e-71} \ + 9.9999999999999992e-72 +test util-16.1.17.-70 {8.4 compatible formatting of doubles} precision \ + {expr 1e-70} \ + 1e-70 +test util-16.1.17.-69 {8.4 compatible formatting of doubles} precision \ + {expr 1e-69} \ + 9.9999999999999996e-70 +test util-16.1.17.-68 {8.4 compatible formatting of doubles} precision \ + {expr 1e-68} \ + 1.0000000000000001e-68 +test util-16.1.17.-67 {8.4 compatible formatting of doubles} precision \ + {expr 1e-67} \ + 9.9999999999999994e-68 +test util-16.1.17.-66 {8.4 compatible formatting of doubles} precision \ + {expr 1e-66} \ + 9.9999999999999998e-67 +test util-16.1.17.-65 {8.4 compatible formatting of doubles} precision \ + {expr 1e-65} \ + 9.9999999999999992e-66 +test util-16.1.17.-64 {8.4 compatible formatting of doubles} precision \ + {expr 1e-64} \ + 9.9999999999999997e-65 +test util-16.1.17.-63 {8.4 compatible formatting of doubles} precision \ + {expr 1e-63} \ + 1.0000000000000001e-63 +test util-16.1.17.-62 {8.4 compatible formatting of doubles} precision \ + {expr 1e-62} \ + 1e-62 +test util-16.1.17.-61 {8.4 compatible formatting of doubles} precision \ + {expr 1e-61} \ + 1e-61 +test util-16.1.17.-60 {8.4 compatible formatting of doubles} precision \ + {expr 1e-60} \ + 9.9999999999999997e-61 +test util-16.1.17.-59 {8.4 compatible formatting of doubles} precision \ + {expr 1e-59} \ + 1e-59 +test util-16.1.17.-58 {8.4 compatible formatting of doubles} precision \ + {expr 1e-58} \ + 1e-58 +test util-16.1.17.-57 {8.4 compatible formatting of doubles} precision \ + {expr 1e-57} \ + 9.9999999999999995e-58 +test util-16.1.17.-56 {8.4 compatible formatting of doubles} precision \ + {expr 1e-56} \ + 1e-56 +test util-16.1.17.-55 {8.4 compatible formatting of doubles} precision \ + {expr 1e-55} \ + 9.9999999999999999e-56 +test util-16.1.17.-54 {8.4 compatible formatting of doubles} precision \ + {expr 1e-54} \ + 1e-54 +test util-16.1.17.-53 {8.4 compatible formatting of doubles} precision \ + {expr 1e-53} \ + 1e-53 +test util-16.1.17.-52 {8.4 compatible formatting of doubles} precision \ + {expr 1e-52} \ + 1e-52 +test util-16.1.17.-51 {8.4 compatible formatting of doubles} precision \ + {expr 1e-51} \ + 1e-51 +test util-16.1.17.-50 {8.4 compatible formatting of doubles} precision \ + {expr 1e-50} \ + 1e-50 +test util-16.1.17.-49 {8.4 compatible formatting of doubles} precision \ + {expr 1e-49} \ + 9.9999999999999994e-50 +test util-16.1.17.-48 {8.4 compatible formatting of doubles} precision \ + {expr 1e-48} \ + 9.9999999999999997e-49 +test util-16.1.17.-47 {8.4 compatible formatting of doubles} precision \ + {expr 1e-47} \ + 9.9999999999999997e-48 +test util-16.1.17.-46 {8.4 compatible formatting of doubles} precision \ + {expr 1e-46} \ + 1e-46 +test util-16.1.17.-45 {8.4 compatible formatting of doubles} precision \ + {expr 1e-45} \ + 9.9999999999999998e-46 +test util-16.1.17.-44 {8.4 compatible formatting of doubles} precision \ + {expr 1e-44} \ + 9.9999999999999995e-45 +test util-16.1.17.-43 {8.4 compatible formatting of doubles} precision \ + {expr 1e-43} \ + 1.0000000000000001e-43 +test util-16.1.17.-42 {8.4 compatible formatting of doubles} precision \ + {expr 1e-42} \ + 1e-42 +test util-16.1.17.-41 {8.4 compatible formatting of doubles} precision \ + {expr 1e-41} \ + 1e-41 +test util-16.1.17.-40 {8.4 compatible formatting of doubles} precision \ + {expr 1e-40} \ + 9.9999999999999993e-41 +test util-16.1.17.-39 {8.4 compatible formatting of doubles} precision \ + {expr 1e-39} \ + 9.9999999999999993e-40 +test util-16.1.17.-38 {8.4 compatible formatting of doubles} precision \ + {expr 1e-38} \ + 9.9999999999999996e-39 +test util-16.1.17.-37 {8.4 compatible formatting of doubles} precision \ + {expr 1e-37} \ + 1.0000000000000001e-37 +test util-16.1.17.-36 {8.4 compatible formatting of doubles} precision \ + {expr 1e-36} \ + 9.9999999999999994e-37 +test util-16.1.17.-35 {8.4 compatible formatting of doubles} precision \ + {expr 1e-35} \ + 1e-35 +test util-16.1.17.-34 {8.4 compatible formatting of doubles} precision \ + {expr 1e-34} \ + 9.9999999999999993e-35 +test util-16.1.17.-33 {8.4 compatible formatting of doubles} precision \ + {expr 1e-33} \ + 1.0000000000000001e-33 +test util-16.1.17.-32 {8.4 compatible formatting of doubles} precision \ + {expr 1e-32} \ + 1.0000000000000001e-32 +test util-16.1.17.-31 {8.4 compatible formatting of doubles} precision \ + {expr 1e-31} \ + 1.0000000000000001e-31 +test util-16.1.17.-30 {8.4 compatible formatting of doubles} precision \ + {expr 1e-30} \ + 1.0000000000000001e-30 +test util-16.1.17.-29 {8.4 compatible formatting of doubles} precision \ + {expr 1e-29} \ + 9.9999999999999994e-30 +test util-16.1.17.-28 {8.4 compatible formatting of doubles} precision \ + {expr 1e-28} \ + 9.9999999999999997e-29 +test util-16.1.17.-27 {8.4 compatible formatting of doubles} precision \ + {expr 1e-27} \ + 1e-27 +test util-16.1.17.-26 {8.4 compatible formatting of doubles} precision \ + {expr 1e-26} \ + 1e-26 +test util-16.1.17.-25 {8.4 compatible formatting of doubles} precision \ + {expr 1e-25} \ + 1e-25 +test util-16.1.17.-24 {8.4 compatible formatting of doubles} precision \ + {expr 1e-24} \ + 9.9999999999999992e-25 +test util-16.1.17.-23 {8.4 compatible formatting of doubles} precision \ + {expr 1e-23} \ + 9.9999999999999996e-24 +test util-16.1.17.-22 {8.4 compatible formatting of doubles} precision \ + {expr 1e-22} \ + 1e-22 +test util-16.1.17.-21 {8.4 compatible formatting of doubles} precision \ + {expr 1e-21} \ + 9.9999999999999991e-22 +test util-16.1.17.-20 {8.4 compatible formatting of doubles} precision \ + {expr 1e-20} \ + 9.9999999999999995e-21 +test util-16.1.17.-19 {8.4 compatible formatting of doubles} precision \ + {expr 1e-19} \ + 9.9999999999999998e-20 +test util-16.1.17.-18 {8.4 compatible formatting of doubles} precision \ + {expr 1e-18} \ + 1.0000000000000001e-18 +test util-16.1.17.-17 {8.4 compatible formatting of doubles} precision \ + {expr 1e-17} \ + 1.0000000000000001e-17 +test util-16.1.17.-16 {8.4 compatible formatting of doubles} precision \ + {expr 1e-16} \ + 9.9999999999999998e-17 +test util-16.1.17.-15 {8.4 compatible formatting of doubles} precision \ + {expr 1e-15} \ + 1.0000000000000001e-15 +test util-16.1.17.-14 {8.4 compatible formatting of doubles} precision \ + {expr 1e-14} \ + 1e-14 +test util-16.1.17.-13 {8.4 compatible formatting of doubles} precision \ + {expr 1e-13} \ + 1e-13 +test util-16.1.17.-12 {8.4 compatible formatting of doubles} precision \ + {expr 1e-12} \ + 9.9999999999999998e-13 +test util-16.1.17.-11 {8.4 compatible formatting of doubles} precision \ + {expr 1e-11} \ + 9.9999999999999994e-12 +test util-16.1.17.-10 {8.4 compatible formatting of doubles} precision \ + {expr 1e-10} \ + 1e-10 +test util-16.1.17.-9 {8.4 compatible formatting of doubles} precision \ + {expr 1e-9} \ + 1.0000000000000001e-09 +test util-16.1.17.-8 {8.4 compatible formatting of doubles} precision \ + {expr 1e-8} \ + 1e-08 +test util-16.1.17.-7 {8.4 compatible formatting of doubles} precision \ + {expr 1e-7} \ + 9.9999999999999995e-08 +test util-16.1.17.-6 {8.4 compatible formatting of doubles} precision \ + {expr 1e-6} \ + 9.9999999999999995e-07 +test util-16.1.17.-5 {8.4 compatible formatting of doubles} precision \ + {expr 1e-5} \ + 1.0000000000000001e-05 +test util-16.1.17.-4 {8.4 compatible formatting of doubles} precision \ + {expr 1e-4} \ + 0.0001 +test util-16.1.17.-3 {8.4 compatible formatting of doubles} precision \ + {expr 1e-3} \ + 0.001 +test util-16.1.17.-2 {8.4 compatible formatting of doubles} precision \ + {expr 1e-2} \ + 0.01 +test util-16.1.17.-1 {8.4 compatible formatting of doubles} precision \ + {expr 1e-1} \ + 0.10000000000000001 +test util-16.1.17.0 {8.4 compatible formatting of doubles} precision \ + {expr 1e0} \ + 1.0 +test util-16.1.17.1 {8.4 compatible formatting of doubles} precision \ + {expr 1e1} \ + 10.0 +test util-16.1.17.2 {8.4 compatible formatting of doubles} precision \ + {expr 1e2} \ + 100.0 +test util-16.1.17.3 {8.4 compatible formatting of doubles} precision \ + {expr 1e3} \ + 1000.0 +test util-16.1.17.4 {8.4 compatible formatting of doubles} precision \ + {expr 1e4} \ + 10000.0 +test util-16.1.17.5 {8.4 compatible formatting of doubles} precision \ + {expr 1e5} \ + 100000.0 +test util-16.1.17.6 {8.4 compatible formatting of doubles} precision \ + {expr 1e6} \ + 1000000.0 +test util-16.1.17.7 {8.4 compatible formatting of doubles} precision \ + {expr 1e7} \ + 10000000.0 +test util-16.1.17.8 {8.4 compatible formatting of doubles} precision \ + {expr 1e8} \ + 100000000.0 +test util-16.1.17.9 {8.4 compatible formatting of doubles} precision \ + {expr 1e9} \ + 1000000000.0 +test util-16.1.17.10 {8.4 compatible formatting of doubles} precision \ + {expr 1e10} \ + 10000000000.0 +test util-16.1.17.11 {8.4 compatible formatting of doubles} precision \ + {expr 1e11} \ + 100000000000.0 +test util-16.1.17.12 {8.4 compatible formatting of doubles} precision \ + {expr 1e12} \ + 1000000000000.0 +test util-16.1.17.13 {8.4 compatible formatting of doubles} precision \ + {expr 1e13} \ + 10000000000000.0 +test util-16.1.17.14 {8.4 compatible formatting of doubles} precision \ + {expr 1e14} \ + 100000000000000.0 +test util-16.1.17.15 {8.4 compatible formatting of doubles} precision \ + {expr 1e15} \ + 1000000000000000.0 +test util-16.1.17.16 {8.4 compatible formatting of doubles} precision \ + {expr 1e16} \ + 10000000000000000.0 +test util-16.1.17.17 {8.4 compatible formatting of doubles} precision \ + {expr 1e17} \ + 1e+17 +test util-16.1.17.18 {8.4 compatible formatting of doubles} precision \ + {expr 1e18} \ + 1e+18 +test util-16.1.17.19 {8.4 compatible formatting of doubles} precision \ + {expr 1e19} \ + 1e+19 +test util-16.1.17.20 {8.4 compatible formatting of doubles} precision \ + {expr 1e20} \ + 1e+20 +test util-16.1.17.21 {8.4 compatible formatting of doubles} precision \ + {expr 1e21} \ + 1e+21 +test util-16.1.17.22 {8.4 compatible formatting of doubles} precision \ + {expr 1e22} \ + 1e+22 +test util-16.1.17.23 {8.4 compatible formatting of doubles} precision \ + {expr 1e23} \ + 9.9999999999999992e+22 +test util-16.1.17.24 {8.4 compatible formatting of doubles} precision \ + {expr 1e24} \ + 9.9999999999999998e+23 +test util-16.1.17.25 {8.4 compatible formatting of doubles} precision \ + {expr 1e25} \ + 1.0000000000000001e+25 +test util-16.1.17.26 {8.4 compatible formatting of doubles} precision \ + {expr 1e26} \ + 1e+26 +test util-16.1.17.27 {8.4 compatible formatting of doubles} precision \ + {expr 1e27} \ + 1e+27 +test util-16.1.17.28 {8.4 compatible formatting of doubles} precision \ + {expr 1e28} \ + 9.9999999999999996e+27 +test util-16.1.17.29 {8.4 compatible formatting of doubles} precision \ + {expr 1e29} \ + 9.9999999999999991e+28 +test util-16.1.17.30 {8.4 compatible formatting of doubles} precision \ + {expr 1e30} \ + 1e+30 +test util-16.1.17.31 {8.4 compatible formatting of doubles} precision \ + {expr 1e31} \ + 9.9999999999999996e+30 +test util-16.1.17.32 {8.4 compatible formatting of doubles} precision \ + {expr 1e32} \ + 1.0000000000000001e+32 +test util-16.1.17.33 {8.4 compatible formatting of doubles} precision \ + {expr 1e33} \ + 9.9999999999999995e+32 +test util-16.1.17.34 {8.4 compatible formatting of doubles} precision \ + {expr 1e34} \ + 9.9999999999999995e+33 +test util-16.1.17.35 {8.4 compatible formatting of doubles} precision \ + {expr 1e35} \ + 9.9999999999999997e+34 +test util-16.1.17.36 {8.4 compatible formatting of doubles} precision \ + {expr 1e36} \ + 1e+36 +test util-16.1.17.37 {8.4 compatible formatting of doubles} precision \ + {expr 1e37} \ + 9.9999999999999995e+36 +test util-16.1.17.38 {8.4 compatible formatting of doubles} precision \ + {expr 1e38} \ + 9.9999999999999998e+37 +test util-16.1.17.39 {8.4 compatible formatting of doubles} precision \ + {expr 1e39} \ + 9.9999999999999994e+38 +test util-16.1.17.40 {8.4 compatible formatting of doubles} precision \ + {expr 1e40} \ + 1e+40 +test util-16.1.17.41 {8.4 compatible formatting of doubles} precision \ + {expr 1e41} \ + 1e+41 +test util-16.1.17.42 {8.4 compatible formatting of doubles} precision \ + {expr 1e42} \ + 1e+42 +test util-16.1.17.43 {8.4 compatible formatting of doubles} precision \ + {expr 1e43} \ + 1e+43 +test util-16.1.17.44 {8.4 compatible formatting of doubles} precision \ + {expr 1e44} \ + 1.0000000000000001e+44 +test util-16.1.17.45 {8.4 compatible formatting of doubles} precision \ + {expr 1e45} \ + 9.9999999999999993e+44 +test util-16.1.17.46 {8.4 compatible formatting of doubles} precision \ + {expr 1e46} \ + 9.9999999999999999e+45 +test util-16.1.17.47 {8.4 compatible formatting of doubles} precision \ + {expr 1e47} \ + 1e+47 +test util-16.1.17.48 {8.4 compatible formatting of doubles} precision \ + {expr 1e48} \ + 1e+48 +test util-16.1.17.49 {8.4 compatible formatting of doubles} precision \ + {expr 1e49} \ + 9.9999999999999995e+48 +test util-16.1.17.50 {8.4 compatible formatting of doubles} precision \ + {expr 1e50} \ + 1.0000000000000001e+50 +test util-16.1.17.51 {8.4 compatible formatting of doubles} precision \ + {expr 1e51} \ + 9.9999999999999999e+50 +test util-16.1.17.52 {8.4 compatible formatting of doubles} precision \ + {expr 1e52} \ + 9.9999999999999999e+51 +test util-16.1.17.53 {8.4 compatible formatting of doubles} precision \ + {expr 1e53} \ + 9.9999999999999999e+52 +test util-16.1.17.54 {8.4 compatible formatting of doubles} precision \ + {expr 1e54} \ + 1.0000000000000001e+54 +test util-16.1.17.55 {8.4 compatible formatting of doubles} precision \ + {expr 1e55} \ + 1e+55 +test util-16.1.17.56 {8.4 compatible formatting of doubles} precision \ + {expr 1e56} \ + 1.0000000000000001e+56 +test util-16.1.17.57 {8.4 compatible formatting of doubles} precision \ + {expr 1e57} \ + 1e+57 +test util-16.1.17.58 {8.4 compatible formatting of doubles} precision \ + {expr 1e58} \ + 9.9999999999999994e+57 +test util-16.1.17.59 {8.4 compatible formatting of doubles} precision \ + {expr 1e59} \ + 9.9999999999999997e+58 +test util-16.1.17.60 {8.4 compatible formatting of doubles} precision \ + {expr 1e60} \ + 9.9999999999999995e+59 +test util-16.1.17.61 {8.4 compatible formatting of doubles} precision \ + {expr 1e61} \ + 9.9999999999999995e+60 +test util-16.1.17.62 {8.4 compatible formatting of doubles} precision \ + {expr 1e62} \ + 1e+62 +test util-16.1.17.63 {8.4 compatible formatting of doubles} precision \ + {expr 1e63} \ + 1.0000000000000001e+63 +test util-16.1.17.64 {8.4 compatible formatting of doubles} precision \ + {expr 1e64} \ + 1e+64 +test util-16.1.17.65 {8.4 compatible formatting of doubles} precision \ + {expr 1e65} \ + 9.9999999999999999e+64 +test util-16.1.17.66 {8.4 compatible formatting of doubles} precision \ + {expr 1e66} \ + 9.9999999999999995e+65 +test util-16.1.17.67 {8.4 compatible formatting of doubles} precision \ + {expr 1e67} \ + 9.9999999999999998e+66 +test util-16.1.17.68 {8.4 compatible formatting of doubles} precision \ + {expr 1e68} \ + 9.9999999999999995e+67 +test util-16.1.17.69 {8.4 compatible formatting of doubles} precision \ + {expr 1e69} \ + 1.0000000000000001e+69 +test util-16.1.17.70 {8.4 compatible formatting of doubles} precision \ + {expr 1e70} \ + 1.0000000000000001e+70 +test util-16.1.17.71 {8.4 compatible formatting of doubles} precision \ + {expr 1e71} \ + 1e+71 +test util-16.1.17.72 {8.4 compatible formatting of doubles} precision \ + {expr 1e72} \ + 9.9999999999999994e+71 +test util-16.1.17.73 {8.4 compatible formatting of doubles} precision \ + {expr 1e73} \ + 9.9999999999999998e+72 +test util-16.1.17.74 {8.4 compatible formatting of doubles} precision \ + {expr 1e74} \ + 9.9999999999999995e+73 +test util-16.1.17.75 {8.4 compatible formatting of doubles} precision \ + {expr 1e75} \ + 9.9999999999999993e+74 +test util-16.1.17.76 {8.4 compatible formatting of doubles} precision \ + {expr 1e76} \ + 1e+76 +test util-16.1.17.77 {8.4 compatible formatting of doubles} precision \ + {expr 1e77} \ + 9.9999999999999998e+76 +test util-16.1.17.78 {8.4 compatible formatting of doubles} precision \ + {expr 1e78} \ + 1e+78 +test util-16.1.17.79 {8.4 compatible formatting of doubles} precision \ + {expr 1e79} \ + 9.9999999999999997e+78 +test util-16.1.17.80 {8.4 compatible formatting of doubles} precision \ + {expr 1e80} \ + 1e+80 +test util-16.1.17.81 {8.4 compatible formatting of doubles} precision \ + {expr 1e81} \ + 9.9999999999999992e+80 +test util-16.1.17.82 {8.4 compatible formatting of doubles} precision \ + {expr 1e82} \ + 9.9999999999999996e+81 +test util-16.1.17.83 {8.4 compatible formatting of doubles} precision \ + {expr 1e83} \ + 1e+83 +test util-16.1.17.84 {8.4 compatible formatting of doubles} precision \ + {expr 1e84} \ + 1.0000000000000001e+84 +test util-16.1.17.85 {8.4 compatible formatting of doubles} precision \ + {expr 1e85} \ + 1e+85 +test util-16.1.17.86 {8.4 compatible formatting of doubles} precision \ + {expr 1e86} \ + 1e+86 +test util-16.1.17.87 {8.4 compatible formatting of doubles} precision \ + {expr 1e87} \ + 9.9999999999999996e+86 +test util-16.1.17.88 {8.4 compatible formatting of doubles} precision \ + {expr 1e88} \ + 9.9999999999999996e+87 +test util-16.1.17.89 {8.4 compatible formatting of doubles} precision \ + {expr 1e89} \ + 9.9999999999999999e+88 +test util-16.1.17.90 {8.4 compatible formatting of doubles} precision \ + {expr 1e90} \ + 9.9999999999999997e+89 +test util-16.1.17.91 {8.4 compatible formatting of doubles} precision \ + {expr 1e91} \ + 1.0000000000000001e+91 +test util-16.1.17.92 {8.4 compatible formatting of doubles} precision \ + {expr 1e92} \ + 1e+92 +test util-16.1.17.93 {8.4 compatible formatting of doubles} precision \ + {expr 1e93} \ + 1e+93 +test util-16.1.17.94 {8.4 compatible formatting of doubles} precision \ + {expr 1e94} \ + 1e+94 +test util-16.1.17.95 {8.4 compatible formatting of doubles} precision \ + {expr 1e95} \ + 1e+95 +test util-16.1.17.96 {8.4 compatible formatting of doubles} precision \ + {expr 1e96} \ + 1e+96 +test util-16.1.17.97 {8.4 compatible formatting of doubles} precision \ + {expr 1e97} \ + 1.0000000000000001e+97 +test util-16.1.17.98 {8.4 compatible formatting of doubles} precision \ + {expr 1e98} \ + 1e+98 +test util-16.1.17.99 {8.4 compatible formatting of doubles} precision \ + {expr 1e99} \ + 9.9999999999999997e+98 +test util-16.1.17.100 {8.4 compatible formatting of doubles} precision \ + {expr 1e100} \ + 1e+100 +test util-16.1.17.101 {8.4 compatible formatting of doubles} precision \ + {expr 1e101} \ + 9.9999999999999998e+100 +test util-16.1.17.102 {8.4 compatible formatting of doubles} precision \ + {expr 1e102} \ + 9.9999999999999998e+101 +test util-16.1.17.103 {8.4 compatible formatting of doubles} precision \ + {expr 1e103} \ + 1e+103 +test util-16.1.17.104 {8.4 compatible formatting of doubles} precision \ + {expr 1e104} \ + 1e+104 +test util-16.1.17.105 {8.4 compatible formatting of doubles} precision \ + {expr 1e105} \ + 9.9999999999999994e+104 +test util-16.1.17.106 {8.4 compatible formatting of doubles} precision \ + {expr 1e106} \ + 1.0000000000000001e+106 +test util-16.1.17.107 {8.4 compatible formatting of doubles} precision \ + {expr 1e107} \ + 9.9999999999999997e+106 +test util-16.1.17.108 {8.4 compatible formatting of doubles} precision \ + {expr 1e108} \ + 1e+108 +test util-16.1.17.109 {8.4 compatible formatting of doubles} precision \ + {expr 1e109} \ + 9.9999999999999998e+108 +test util-16.1.17.110 {8.4 compatible formatting of doubles} precision \ + {expr 1e110} \ + 1e+110 +test util-16.1.17.111 {8.4 compatible formatting of doubles} precision \ + {expr 1e111} \ + 9.9999999999999996e+110 +test util-16.1.17.112 {8.4 compatible formatting of doubles} precision \ + {expr 1e112} \ + 9.9999999999999993e+111 +test util-16.1.17.113 {8.4 compatible formatting of doubles} precision \ + {expr 1e113} \ + 1e+113 +test util-16.1.17.114 {8.4 compatible formatting of doubles} precision \ + {expr 1e114} \ + 1e+114 +test util-16.1.17.115 {8.4 compatible formatting of doubles} precision \ + {expr 1e115} \ + 1e+115 +test util-16.1.17.116 {8.4 compatible formatting of doubles} precision \ + {expr 1e116} \ + 1e+116 +test util-16.1.17.117 {8.4 compatible formatting of doubles} precision \ + {expr 1e117} \ + 1.0000000000000001e+117 +test util-16.1.17.118 {8.4 compatible formatting of doubles} precision \ + {expr 1e118} \ + 9.9999999999999997e+117 +test util-16.1.17.119 {8.4 compatible formatting of doubles} precision \ + {expr 1e119} \ + 9.9999999999999994e+118 +test util-16.1.17.120 {8.4 compatible formatting of doubles} precision \ + {expr 1e120} \ + 9.9999999999999998e+119 +test util-16.1.17.121 {8.4 compatible formatting of doubles} precision \ + {expr 1e121} \ + 1e+121 +test util-16.1.17.122 {8.4 compatible formatting of doubles} precision \ + {expr 1e122} \ + 1e+122 +test util-16.1.17.123 {8.4 compatible formatting of doubles} precision \ + {expr 1e123} \ + 9.9999999999999998e+122 +test util-16.1.17.124 {8.4 compatible formatting of doubles} precision \ + {expr 1e124} \ + 9.9999999999999995e+123 +test util-16.1.17.125 {8.4 compatible formatting of doubles} precision \ + {expr 1e125} \ + 9.9999999999999992e+124 +test util-16.1.17.126 {8.4 compatible formatting of doubles} precision \ + {expr 1e126} \ + 9.9999999999999992e+125 +test util-16.1.17.127 {8.4 compatible formatting of doubles} precision \ + {expr 1e127} \ + 9.9999999999999995e+126 +test util-16.1.17.128 {8.4 compatible formatting of doubles} precision \ + {expr 1e128} \ + 1.0000000000000001e+128 +test util-16.1.17.129 {8.4 compatible formatting of doubles} precision \ + {expr 1e129} \ + 1e+129 +test util-16.1.17.130 {8.4 compatible formatting of doubles} precision \ + {expr 1e130} \ + 1.0000000000000001e+130 +test util-16.1.17.131 {8.4 compatible formatting of doubles} precision \ + {expr 1e131} \ + 9.9999999999999991e+130 +test util-16.1.17.132 {8.4 compatible formatting of doubles} precision \ + {expr 1e132} \ + 9.9999999999999999e+131 +test util-16.1.17.133 {8.4 compatible formatting of doubles} precision \ + {expr 1e133} \ + 1e+133 +test util-16.1.17.134 {8.4 compatible formatting of doubles} precision \ + {expr 1e134} \ + 9.9999999999999992e+133 +test util-16.1.17.135 {8.4 compatible formatting of doubles} precision \ + {expr 1e135} \ + 9.9999999999999996e+134 +test util-16.1.17.136 {8.4 compatible formatting of doubles} precision \ + {expr 1e136} \ + 1.0000000000000001e+136 +test util-16.1.17.137 {8.4 compatible formatting of doubles} precision \ + {expr 1e137} \ + 1e+137 +test util-16.1.17.138 {8.4 compatible formatting of doubles} precision \ + {expr 1e138} \ + 1e+138 +test util-16.1.17.139 {8.4 compatible formatting of doubles} precision \ + {expr 1e139} \ + 1e+139 +test util-16.1.17.140 {8.4 compatible formatting of doubles} precision \ + {expr 1e140} \ + 1.0000000000000001e+140 +test util-16.1.17.141 {8.4 compatible formatting of doubles} precision \ + {expr 1e141} \ + 1e+141 +test util-16.1.17.142 {8.4 compatible formatting of doubles} precision \ + {expr 1e142} \ + 1.0000000000000001e+142 +test util-16.1.17.143 {8.4 compatible formatting of doubles} precision \ + {expr 1e143} \ + 1e+143 +test util-16.1.17.144 {8.4 compatible formatting of doubles} precision \ + {expr 1e144} \ + 1e+144 +test util-16.1.17.145 {8.4 compatible formatting of doubles} precision \ + {expr 1e145} \ + 9.9999999999999999e+144 +test util-16.1.17.146 {8.4 compatible formatting of doubles} precision \ + {expr 1e146} \ + 9.9999999999999993e+145 +test util-16.1.17.147 {8.4 compatible formatting of doubles} precision \ + {expr 1e147} \ + 9.9999999999999998e+146 +test util-16.1.17.148 {8.4 compatible formatting of doubles} precision \ + {expr 1e148} \ + 1e+148 +test util-16.1.17.149 {8.4 compatible formatting of doubles} precision \ + {expr 1e149} \ + 1e+149 +test util-16.1.17.150 {8.4 compatible formatting of doubles} precision \ + {expr 1e150} \ + 9.9999999999999998e+149 +test util-16.1.17.151 {8.4 compatible formatting of doubles} precision \ + {expr 1e151} \ + 1e+151 +test util-16.1.17.152 {8.4 compatible formatting of doubles} precision \ + {expr 1e152} \ + 1e+152 +test util-16.1.17.153 {8.4 compatible formatting of doubles} precision \ + {expr 1e153} \ + 1e+153 +test util-16.1.17.154 {8.4 compatible formatting of doubles} precision \ + {expr 1e154} \ + 1e+154 +test util-16.1.17.155 {8.4 compatible formatting of doubles} precision \ + {expr 1e155} \ + 1e+155 +test util-16.1.17.156 {8.4 compatible formatting of doubles} precision \ + {expr 1e156} \ + 9.9999999999999998e+155 +test util-16.1.17.157 {8.4 compatible formatting of doubles} precision \ + {expr 1e157} \ + 9.9999999999999998e+156 +test util-16.1.17.158 {8.4 compatible formatting of doubles} precision \ + {expr 1e158} \ + 9.9999999999999995e+157 +test util-16.1.17.159 {8.4 compatible formatting of doubles} precision \ + {expr 1e159} \ + 9.9999999999999993e+158 +test util-16.1.17.160 {8.4 compatible formatting of doubles} precision \ + {expr 1e160} \ + 1e+160 +test util-16.1.17.161 {8.4 compatible formatting of doubles} precision \ + {expr 1e161} \ + 1e+161 +test util-16.1.17.162 {8.4 compatible formatting of doubles} precision \ + {expr 1e162} \ + 9.9999999999999994e+161 +test util-16.1.17.163 {8.4 compatible formatting of doubles} precision \ + {expr 1e163} \ + 9.9999999999999994e+162 +test util-16.1.17.164 {8.4 compatible formatting of doubles} precision \ + {expr 1e164} \ + 1e+164 +test util-16.1.17.165 {8.4 compatible formatting of doubles} precision \ + {expr 1e165} \ + 9.999999999999999e+164 +test util-16.1.17.166 {8.4 compatible formatting of doubles} precision \ + {expr 1e166} \ + 9.9999999999999994e+165 +test util-16.1.17.167 {8.4 compatible formatting of doubles} precision \ + {expr 1e167} \ + 1e+167 +test util-16.1.17.168 {8.4 compatible formatting of doubles} precision \ + {expr 1e168} \ + 9.9999999999999993e+167 +test util-16.1.17.169 {8.4 compatible formatting of doubles} precision \ + {expr 1e169} \ + 9.9999999999999993e+168 +test util-16.1.17.170 {8.4 compatible formatting of doubles} precision \ + {expr 1e170} \ + 1e+170 +test util-16.1.17.171 {8.4 compatible formatting of doubles} precision \ + {expr 1e171} \ + 9.9999999999999995e+170 +test util-16.1.17.172 {8.4 compatible formatting of doubles} precision \ + {expr 1e172} \ + 1.0000000000000001e+172 +test util-16.1.17.173 {8.4 compatible formatting of doubles} precision \ + {expr 1e173} \ + 1e+173 +test util-16.1.17.174 {8.4 compatible formatting of doubles} precision \ + {expr 1e174} \ + 1.0000000000000001e+174 +test util-16.1.17.175 {8.4 compatible formatting of doubles} precision \ + {expr 1e175} \ + 9.9999999999999994e+174 +test util-16.1.17.176 {8.4 compatible formatting of doubles} precision \ + {expr 1e176} \ + 1e+176 +test util-16.1.17.177 {8.4 compatible formatting of doubles} precision \ + {expr 1e177} \ + 1e+177 +test util-16.1.17.178 {8.4 compatible formatting of doubles} precision \ + {expr 1e178} \ + 1.0000000000000001e+178 +test util-16.1.17.179 {8.4 compatible formatting of doubles} precision \ + {expr 1e179} \ + 9.9999999999999998e+178 +test util-16.1.17.180 {8.4 compatible formatting of doubles} precision \ + {expr 1e180} \ + 1e+180 +test util-16.1.17.181 {8.4 compatible formatting of doubles} precision \ + {expr 1e181} \ + 9.9999999999999992e+180 +test util-16.1.17.182 {8.4 compatible formatting of doubles} precision \ + {expr 1e182} \ + 1.0000000000000001e+182 +test util-16.1.17.183 {8.4 compatible formatting of doubles} precision \ + {expr 1e183} \ + 9.9999999999999995e+182 +test util-16.1.17.184 {8.4 compatible formatting of doubles} precision \ + {expr 1e184} \ + 1e+184 +test util-16.1.17.185 {8.4 compatible formatting of doubles} precision \ + {expr 1e185} \ + 9.9999999999999998e+184 +test util-16.1.17.186 {8.4 compatible formatting of doubles} precision \ + {expr 1e186} \ + 9.9999999999999998e+185 +test util-16.1.17.187 {8.4 compatible formatting of doubles} precision \ + {expr 1e187} \ + 9.9999999999999991e+186 +test util-16.1.17.188 {8.4 compatible formatting of doubles} precision \ + {expr 1e188} \ + 1e+188 +test util-16.1.17.189 {8.4 compatible formatting of doubles} precision \ + {expr 1e189} \ + 1e+189 +test util-16.1.17.190 {8.4 compatible formatting of doubles} precision \ + {expr 1e190} \ + 1.0000000000000001e+190 +test util-16.1.17.191 {8.4 compatible formatting of doubles} precision \ + {expr 1e191} \ + 1.0000000000000001e+191 +test util-16.1.17.192 {8.4 compatible formatting of doubles} precision \ + {expr 1e192} \ + 1e+192 +test util-16.1.17.193 {8.4 compatible formatting of doubles} precision \ + {expr 1e193} \ + 1.0000000000000001e+193 +test util-16.1.17.194 {8.4 compatible formatting of doubles} precision \ + {expr 1e194} \ + 9.9999999999999994e+193 +test util-16.1.17.195 {8.4 compatible formatting of doubles} precision \ + {expr 1e195} \ + 9.9999999999999998e+194 +test util-16.1.17.196 {8.4 compatible formatting of doubles} precision \ + {expr 1e196} \ + 9.9999999999999995e+195 +test util-16.1.17.197 {8.4 compatible formatting of doubles} precision \ + {expr 1e197} \ + 9.9999999999999995e+196 +test util-16.1.17.198 {8.4 compatible formatting of doubles} precision \ + {expr 1e198} \ + 1e+198 +test util-16.1.17.199 {8.4 compatible formatting of doubles} precision \ + {expr 1e199} \ + 1.0000000000000001e+199 +test util-16.1.17.200 {8.4 compatible formatting of doubles} precision \ + {expr 1e200} \ + 9.9999999999999997e+199 +test util-16.1.17.201 {8.4 compatible formatting of doubles} precision \ + {expr 1e201} \ + 1e+201 +test util-16.1.17.202 {8.4 compatible formatting of doubles} precision \ + {expr 1e202} \ + 9.999999999999999e+201 +test util-16.1.17.203 {8.4 compatible formatting of doubles} precision \ + {expr 1e203} \ + 9.9999999999999999e+202 +test util-16.1.17.204 {8.4 compatible formatting of doubles} precision \ + {expr 1e204} \ + 9.9999999999999999e+203 +test util-16.1.17.205 {8.4 compatible formatting of doubles} precision \ + {expr 1e205} \ + 1e+205 +test util-16.1.17.206 {8.4 compatible formatting of doubles} precision \ + {expr 1e206} \ + 1e+206 +test util-16.1.17.207 {8.4 compatible formatting of doubles} precision \ + {expr 1e207} \ + 1e+207 +test util-16.1.17.208 {8.4 compatible formatting of doubles} precision \ + {expr 1e208} \ + 9.9999999999999998e+207 +test util-16.1.17.209 {8.4 compatible formatting of doubles} precision \ + {expr 1e209} \ + 1.0000000000000001e+209 +test util-16.1.17.210 {8.4 compatible formatting of doubles} precision \ + {expr 1e210} \ + 9.9999999999999993e+209 +test util-16.1.17.211 {8.4 compatible formatting of doubles} precision \ + {expr 1e211} \ + 9.9999999999999996e+210 +test util-16.1.17.212 {8.4 compatible formatting of doubles} precision \ + {expr 1e212} \ + 9.9999999999999991e+211 +test util-16.1.17.213 {8.4 compatible formatting of doubles} precision \ + {expr 1e213} \ + 9.9999999999999998e+212 +test util-16.1.17.214 {8.4 compatible formatting of doubles} precision \ + {expr 1e214} \ + 9.9999999999999995e+213 +test util-16.1.17.215 {8.4 compatible formatting of doubles} precision \ + {expr 1e215} \ + 9.9999999999999991e+214 +test util-16.1.17.216 {8.4 compatible formatting of doubles} precision \ + {expr 1e216} \ + 1e+216 +test util-16.1.17.217 {8.4 compatible formatting of doubles} precision \ + {expr 1e217} \ + 9.9999999999999996e+216 +test util-16.1.17.218 {8.4 compatible formatting of doubles} precision \ + {expr 1e218} \ + 1.0000000000000001e+218 +test util-16.1.17.219 {8.4 compatible formatting of doubles} precision \ + {expr 1e219} \ + 9.9999999999999997e+218 +test util-16.1.17.220 {8.4 compatible formatting of doubles} precision \ + {expr 1e220} \ + 1e+220 +test util-16.1.17.221 {8.4 compatible formatting of doubles} precision \ + {expr 1e221} \ + 1e+221 +test util-16.1.17.222 {8.4 compatible formatting of doubles} precision \ + {expr 1e222} \ + 1e+222 +test util-16.1.17.223 {8.4 compatible formatting of doubles} precision \ + {expr 1e223} \ + 1e+223 +test util-16.1.17.224 {8.4 compatible formatting of doubles} precision \ + {expr 1e224} \ + 9.9999999999999997e+223 +test util-16.1.17.225 {8.4 compatible formatting of doubles} precision \ + {expr 1e225} \ + 9.9999999999999993e+224 +test util-16.1.17.226 {8.4 compatible formatting of doubles} precision \ + {expr 1e226} \ + 9.9999999999999996e+225 +test util-16.1.17.227 {8.4 compatible formatting of doubles} precision \ + {expr 1e227} \ + 1.0000000000000001e+227 +test util-16.1.17.228 {8.4 compatible formatting of doubles} precision \ + {expr 1e228} \ + 9.9999999999999992e+227 +test util-16.1.17.229 {8.4 compatible formatting of doubles} precision \ + {expr 1e229} \ + 9.9999999999999999e+228 +test util-16.1.17.230 {8.4 compatible formatting of doubles} precision \ + {expr 1e230} \ + 1.0000000000000001e+230 +test util-16.1.17.231 {8.4 compatible formatting of doubles} precision \ + {expr 1e231} \ + 1.0000000000000001e+231 +test util-16.1.17.232 {8.4 compatible formatting of doubles} precision \ + {expr 1e232} \ + 1.0000000000000001e+232 +test util-16.1.17.233 {8.4 compatible formatting of doubles} precision \ + {expr 1e233} \ + 9.9999999999999997e+232 +test util-16.1.17.234 {8.4 compatible formatting of doubles} precision \ + {expr 1e234} \ + 1e+234 +test util-16.1.17.235 {8.4 compatible formatting of doubles} precision \ + {expr 1e235} \ + 1.0000000000000001e+235 +test util-16.1.17.236 {8.4 compatible formatting of doubles} precision \ + {expr 1e236} \ + 1.0000000000000001e+236 +test util-16.1.17.237 {8.4 compatible formatting of doubles} precision \ + {expr 1e237} \ + 9.9999999999999994e+236 +test util-16.1.17.238 {8.4 compatible formatting of doubles} precision \ + {expr 1e238} \ + 1e+238 +test util-16.1.17.239 {8.4 compatible formatting of doubles} precision \ + {expr 1e239} \ + 9.9999999999999999e+238 +test util-16.1.17.240 {8.4 compatible formatting of doubles} precision \ + {expr 1e240} \ + 1e+240 +test util-16.1.17.241 {8.4 compatible formatting of doubles} precision \ + {expr 1e241} \ + 1.0000000000000001e+241 +test util-16.1.17.242 {8.4 compatible formatting of doubles} precision \ + {expr 1e242} \ + 1.0000000000000001e+242 +test util-16.1.17.243 {8.4 compatible formatting of doubles} precision \ + {expr 1e243} \ + 1.0000000000000001e+243 +test util-16.1.17.244 {8.4 compatible formatting of doubles} precision \ + {expr 1e244} \ + 1.0000000000000001e+244 +test util-16.1.17.245 {8.4 compatible formatting of doubles} precision \ + {expr 1e245} \ + 1e+245 +test util-16.1.17.246 {8.4 compatible formatting of doubles} precision \ + {expr 1e246} \ + 1.0000000000000001e+246 +test util-16.1.17.247 {8.4 compatible formatting of doubles} precision \ + {expr 1e247} \ + 9.9999999999999995e+246 +test util-16.1.17.248 {8.4 compatible formatting of doubles} precision \ + {expr 1e248} \ + 1e+248 +test util-16.1.17.249 {8.4 compatible formatting of doubles} precision \ + {expr 1e249} \ + 9.9999999999999992e+248 +test util-16.1.17.250 {8.4 compatible formatting of doubles} precision \ + {expr 1e250} \ + 9.9999999999999992e+249 +test util-16.1.17.251 {8.4 compatible formatting of doubles} precision \ + {expr 1e251} \ + 1e+251 +test util-16.1.17.252 {8.4 compatible formatting of doubles} precision \ + {expr 1e252} \ + 1.0000000000000001e+252 +test util-16.1.17.253 {8.4 compatible formatting of doubles} precision \ + {expr 1e253} \ + 9.9999999999999994e+252 +test util-16.1.17.254 {8.4 compatible formatting of doubles} precision \ + {expr 1e254} \ + 9.9999999999999994e+253 +test util-16.1.17.255 {8.4 compatible formatting of doubles} precision \ + {expr 1e255} \ + 9.9999999999999999e+254 +test util-16.1.17.256 {8.4 compatible formatting of doubles} precision \ + {expr 1e256} \ + 1e+256 +test util-16.1.17.257 {8.4 compatible formatting of doubles} precision \ + {expr 1e257} \ + 1e+257 +test util-16.1.17.258 {8.4 compatible formatting of doubles} precision \ + {expr 1e258} \ + 1.0000000000000001e+258 +test util-16.1.17.259 {8.4 compatible formatting of doubles} precision \ + {expr 1e259} \ + 9.9999999999999993e+258 +test util-16.1.17.260 {8.4 compatible formatting of doubles} precision \ + {expr 1e260} \ + 1.0000000000000001e+260 +test util-16.1.17.261 {8.4 compatible formatting of doubles} precision \ + {expr 1e261} \ + 9.9999999999999993e+260 +test util-16.1.17.262 {8.4 compatible formatting of doubles} precision \ + {expr 1e262} \ + 1e+262 +test util-16.1.17.263 {8.4 compatible formatting of doubles} precision \ + {expr 1e263} \ + 1e+263 +test util-16.1.17.264 {8.4 compatible formatting of doubles} precision \ + {expr 1e264} \ + 1e+264 +test util-16.1.17.265 {8.4 compatible formatting of doubles} precision \ + {expr 1e265} \ + 1.0000000000000001e+265 +test util-16.1.17.266 {8.4 compatible formatting of doubles} precision \ + {expr 1e266} \ + 1e+266 +test util-16.1.17.267 {8.4 compatible formatting of doubles} precision \ + {expr 1e267} \ + 9.9999999999999997e+266 +test util-16.1.17.268 {8.4 compatible formatting of doubles} precision \ + {expr 1e268} \ + 9.9999999999999997e+267 +test util-16.1.17.269 {8.4 compatible formatting of doubles} precision \ + {expr 1e269} \ + 1e+269 +test util-16.1.17.270 {8.4 compatible formatting of doubles} precision \ + {expr 1e270} \ + 1e+270 +test util-16.1.17.271 {8.4 compatible formatting of doubles} precision \ + {expr 1e271} \ + 9.9999999999999995e+270 +test util-16.1.17.272 {8.4 compatible formatting of doubles} precision \ + {expr 1e272} \ + 1.0000000000000001e+272 +test util-16.1.17.273 {8.4 compatible formatting of doubles} precision \ + {expr 1e273} \ + 9.9999999999999995e+272 +test util-16.1.17.274 {8.4 compatible formatting of doubles} precision \ + {expr 1e274} \ + 9.9999999999999992e+273 +test util-16.1.17.275 {8.4 compatible formatting of doubles} precision \ + {expr 1e275} \ + 9.9999999999999996e+274 +test util-16.1.17.276 {8.4 compatible formatting of doubles} precision \ + {expr 1e276} \ + 1.0000000000000001e+276 +test util-16.1.17.277 {8.4 compatible formatting of doubles} precision \ + {expr 1e277} \ + 1e+277 +test util-16.1.17.278 {8.4 compatible formatting of doubles} precision \ + {expr 1e278} \ + 9.9999999999999996e+277 +test util-16.1.17.279 {8.4 compatible formatting of doubles} precision \ + {expr 1e279} \ + 1.0000000000000001e+279 +test util-16.1.17.280 {8.4 compatible formatting of doubles} precision \ + {expr 1e280} \ + 1e+280 +test util-16.1.17.281 {8.4 compatible formatting of doubles} precision \ + {expr 1e281} \ + 1e+281 +test util-16.1.17.282 {8.4 compatible formatting of doubles} precision \ + {expr 1e282} \ + 1e+282 +test util-16.1.17.283 {8.4 compatible formatting of doubles} precision \ + {expr 1e283} \ + 9.9999999999999996e+282 +test util-16.1.17.284 {8.4 compatible formatting of doubles} precision \ + {expr 1e284} \ + 1.0000000000000001e+284 +test util-16.1.17.285 {8.4 compatible formatting of doubles} precision \ + {expr 1e285} \ + 9.9999999999999998e+284 +test util-16.1.17.286 {8.4 compatible formatting of doubles} precision \ + {expr 1e286} \ + 1e+286 +test util-16.1.17.287 {8.4 compatible formatting of doubles} precision \ + {expr 1e287} \ + 1.0000000000000001e+287 +test util-16.1.17.288 {8.4 compatible formatting of doubles} precision \ + {expr 1e288} \ + 1e+288 +test util-16.1.17.289 {8.4 compatible formatting of doubles} precision \ + {expr 1e289} \ + 1.0000000000000001e+289 +test util-16.1.17.290 {8.4 compatible formatting of doubles} precision \ + {expr 1e290} \ + 1.0000000000000001e+290 +test util-16.1.17.291 {8.4 compatible formatting of doubles} precision \ + {expr 1e291} \ + 9.9999999999999996e+290 +test util-16.1.17.292 {8.4 compatible formatting of doubles} precision \ + {expr 1e292} \ + 1e+292 +test util-16.1.17.293 {8.4 compatible formatting of doubles} precision \ + {expr 1e293} \ + 9.9999999999999992e+292 +test util-16.1.17.294 {8.4 compatible formatting of doubles} precision \ + {expr 1e294} \ + 1.0000000000000001e+294 +test util-16.1.17.295 {8.4 compatible formatting of doubles} precision \ + {expr 1e295} \ + 9.9999999999999998e+294 +test util-16.1.17.296 {8.4 compatible formatting of doubles} precision \ + {expr 1e296} \ + 9.9999999999999998e+295 +test util-16.1.17.297 {8.4 compatible formatting of doubles} precision \ + {expr 1e297} \ + 1e+297 +test util-16.1.17.298 {8.4 compatible formatting of doubles} precision \ + {expr 1e298} \ + 9.9999999999999996e+297 +test util-16.1.17.299 {8.4 compatible formatting of doubles} precision \ + {expr 1e299} \ + 1.0000000000000001e+299 +test util-16.1.17.300 {8.4 compatible formatting of doubles} precision \ + {expr 1e300} \ + 1.0000000000000001e+300 +test util-16.1.17.301 {8.4 compatible formatting of doubles} precision \ + {expr 1e301} \ + 1.0000000000000001e+301 +test util-16.1.17.302 {8.4 compatible formatting of doubles} precision \ + {expr 1e302} \ + 1.0000000000000001e+302 +test util-16.1.17.303 {8.4 compatible formatting of doubles} precision \ + {expr 1e303} \ + 1e+303 +test util-16.1.17.304 {8.4 compatible formatting of doubles} precision \ + {expr 1e304} \ + 9.9999999999999994e+303 +test util-16.1.17.305 {8.4 compatible formatting of doubles} precision \ + {expr 1e305} \ + 9.9999999999999994e+304 +test util-16.1.17.306 {8.4 compatible formatting of doubles} precision \ + {expr 1e306} \ + 1e+306 +test util-16.1.17.307 {8.4 compatible formatting of doubles} precision \ + {expr 1e307} \ + 9.9999999999999999e+306 test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} { set r {} foreach {input} { 0x1ffffffffffffc000 @@ -2179,13 +4169,17 @@ } {65536 65536} test util-18.12 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %Id" 65537 } {65537 65537} + +if {[catch {set ::tcl_precision $saved_precision}]} { + unset ::tcl_precision +} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: Index: tests/var.test ================================================================== --- tests/var.test +++ tests/var.test @@ -267,15 +267,14 @@ set a 456 namespace eval test_ns_var { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a - testupvar 2 a {} vv namespace + testupvar 1 a {} vv namespace } p } - # Modified: that should create a global var according to the docs! list $test_ns_var::vv [set test_ns_var::vv 123] $a } -result {456 123 123} test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup { catch {unset aaaaa} catch {unset xxxxx} @@ -463,11 +462,11 @@ set a "" set five 555 set six 666 namespace eval test_ns_var { variable five 5 six - lappend ::a $five + lappend a $five } lappend a $test_ns_var::five \ [set test_ns_var::six 6] [set test_ns_var::six] $six } -cleanup { catch {unset five} @@ -490,13 +489,13 @@ } -result {can't define "sev:::en": parent namespace doesn't exist} test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} { set a "" namespace eval test_ns_var { variable eight 8 - lappend ::a $eight + lappend a $eight variable eight - lappend ::a $eight + lappend a $eight } set a } {8 8} test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup { catch {namespace delete test_ns_var2} Index: tests/while-old.test ================================================================== --- tests/while-old.test +++ tests/while-old.test @@ -90,11 +90,11 @@ list $err $msg } {1 {wrong # args: should be "while test command"}} test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg -} {1 {can't use non-numeric string "a" as operand of "+"}} +} {1 {can't use non-numeric string as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 set err [catch {while {$x} {set x foo}} msg] list $err $msg Index: tests/while.test ================================================================== --- tests/while.test +++ tests/while.test @@ -30,11 +30,11 @@ } -cleanup { unset i } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} +} -returnCodes error -result {can't use non-numeric string as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { incr value @@ -341,11 +341,11 @@ unset i z } -result {*"$z {$i<} {set x 1}"} test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} +} -returnCodes error -result {can't use non-numeric string as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while $z {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} { Index: tests/winDde.test ================================================================== --- tests/winDde.test +++ tests/winDde.test @@ -18,11 +18,11 @@ testConstraint debug [::tcl::pkgconfig get debug] testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - set ::ddever [package require dde 1.4.1] + set ::ddever [package require dde 1.4.3] set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} { testConstraint dde 1 } } @@ -102,11 +102,11 @@ } # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { set ::ddever -} {1.4.1} +} {1.4.3} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] } -result {foobar foobar self} Index: tests/winFCmd.test ================================================================== --- tests/winFCmd.test +++ tests/winFCmd.test @@ -26,10 +26,11 @@ testConstraint testfile [llength [info commands testfile]] testConstraint testchmod [llength [info commands testchmod]] testConstraint cdrom 0 testConstraint exdev 0 testConstraint longFileNames 0 +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f @@ -90,12 +91,17 @@ } # NB: filename is chosen to be short but unlikely to clash with other apps if {[file exists c:/] && [file exists d:/]} { catch {file delete d:/TclTmpF.1} - if {[catch {createfile d:/TclTmpF.1 {}}] == 0} { - file delete d:/TclTmpF.1 + catch {file delete d:/TclTmpD.1} + catch {file delete c:/TclTmpC.1} + if {![catch {createfile d:/TclTmpF.1 {}}] && [file isfile d:/TclTmpF.1] + && ![catch {file mkdir d:/TclTmpD.1}] && [file isdirectory d:/TclTmpD.1] + && ![catch {file mkdir c:/TclTmpC.1}] && [file isdirectory c:/TclTmpC.1] + } { + file delete d:/TclTmpF.1 d:/TclTmpD.1 c:/TclTmpC.1 testConstraint exdev 1 } } file delete -force -- td1 @@ -171,16 +177,16 @@ file mkdir td1 createfile tf1 testfile mv td1 tf1 } -returnCodes error -result ENOTDIR test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} -setup { - file delete -force d:/tf1 + file delete -force d:/TclTmpD.1 } -constraints {win exdev testfile} -body { - file mkdir c:/tf1 - testfile mv c:/tf1 d:/tf1 + file mkdir c:/TclTmpC.1 + testfile mv c:/TclTmpC.1 d:/TclTmpD.1 } -cleanup { - file delete -force c:/tf1 + file delete -force c:/TclTmpC.1 } -returnCodes error -result EXDEV test winFCmd-1.11 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win testfile} -body { set fd [open tf1 w] @@ -314,19 +320,19 @@ testfile mv td1 td2 list [file exists td1] [file exists td2] [file exists td2/td2] } -result {0 1 1} test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ -constraints {win exdev testfile testchmod} -body { - file mkdir d:/td1 - testchmod 0 d:/td1 - file mkdir c:/tf1 - catch {testfile mv c:/tf1 d:/td1} msg - list $msg [file writable d:/td1] + file mkdir d:/TclTmpD.1 + testchmod 0 d:/TclTmpD.1 + file mkdir c:/TclTmpC.1 + catch {testfile mv c:/TclTmpC.1 d:/TclTmpD.1} msg + list $msg [file writable d:/TclTmpD.1] } -cleanup { - catch {testchmod 0o666 d:/td1} - file delete d:/td1 - file delete -force c:/tf1 + catch {testchmod 0o666 d:/TclTmpD.1} + file delete d:/TclTmpD.1 + file delete -force c:/TclTmpC.1 } -result {EXDEV 0} test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 @@ -386,11 +392,11 @@ } } test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup -} -constraints {win winNonZeroInodes} -body { +} -constraints {win winNonZeroInodes knownMsvcBug} -body { file mkdir td1 foreach {a b} [MakeFiles td1] break file rename -force $a $b file exists $a } -cleanup { @@ -631,11 +637,11 @@ cleanup } -result {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { @@ -685,11 +691,11 @@ createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { @@ -703,11 +709,11 @@ # WinXP returns EEXIST, WinNT seems to return EACCES. No policy # decision has been made as to which is correct. } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1 testchmod 0 td1 testfile rmdir td1 file exists td1 } -cleanup { @@ -932,11 +938,11 @@ createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup -} -constraints {winVista testfile testchmod} -body { +} -constraints {winVista testfile testchmod knownMsvcBug} -body { file mkdir td1/td2 testchmod 0 td1 testfile rmdir -force td1 file exists td1 } -cleanup { @@ -1046,17 +1052,17 @@ } -result {./td1} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body { list [file attributes / -longname] [file attributes \\ -longname] } -constraints {win} -result {/ /} test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { - catch {file delete -force -- c:/td1} + catch {file delete -force -- c:/TclTmpC.1} } -constraints {win winXP} -body { - createfile c:/td1 {} - string tolower [file attributes c:/td1 -longname] + createfile c:/TclTmpC.1 {} + string tolower [file attributes c:/TclTmpC.1 -longname] } -cleanup { - file delete -force -- c:/td1 -} -result {c:/td1} + file delete -force -- c:/TclTmpC.1 +} -result [string tolower {c:/TclTmpC.1}] test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup { catch {file delete -force -- $::env(TEMP)/td1} } -constraints {win} -body { createfile $::env(TEMP)/td1 {} string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \ Index: tests/winTime.test ================================================================== --- tests/winTime.test +++ tests/winTime.test @@ -17,10 +17,11 @@ ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testwinclock [llength [info commands testwinclock]] +testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. test winTime-1.1 {TclpGetDate} {win} { @@ -38,21 +39,21 @@ # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? -test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} { +test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock knownMsvcBug} { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} set ok 1 foreach start_sec [testwinclock] break while { 1 } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break set diff [expr { $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] - if { abs($diff) > 0.06 } { + if { abs($diff) > 0.1 } { set failed "Tcl clock differs from system clock by $diff sec" break } else { testwinsleep 1 } Index: tests/zipfs.test ================================================================== --- tests/zipfs.test +++ tests/zipfs.test @@ -43,11 +43,11 @@ # # Hack the environment to pretend we did pull tcl_library from a zip # archive ### set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]] - testConstraint zipfslib [file exists $tclzip] + testConstraint zipfslib [file isfile $tclzip] if {[testConstraint zipfslib]} { zipfs mount /lib/tcl $tclzip set ::tcl_library ${ziproot}lib/tcl/tcl_library } } Index: tools/README ================================================================== --- tools/README +++ tools/README @@ -10,11 +10,11 @@ Generating HTML files. The tcl-tk-man-html.tcl script from Robert Critchlow generates a nice set of HTML with good cross references. Use it like - tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0 + tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2 This script is very picky about the organization of man pages, effectively acting as a style enforcer. Generating Windows Help Files: 1) Build tcl in the ../unix directory Index: tools/checkLibraryDoc.tcl ================================================================== --- tools/checkLibraryDoc.tcl +++ tools/checkLibraryDoc.tcl @@ -1,11 +1,11 @@ # checkLibraryDoc.tcl -- # # This script attempts to determine what APIs exist in the source base that # have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list -# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch]) +# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch]) # we create six lists: # 1) APIs in Source not in Docs. # 2) APIs in Docs not in Source. # 3) Internal APIs and structs. # 4) Misc APIs and structs that we are not documenting. @@ -48,10 +48,12 @@ Tcl_ThreadId \ Tcl_Time \ Tcl_TimerToken \ Tcl_Token \ Tcl_Trace \ + Tcl_Value \ + Tcl_ValueType \ Tcl_Var \ Tk_3DBorder \ Tk_ArgvInfo \ Tk_BindingTable \ Tk_Canvas \ @@ -102,11 +104,11 @@ set len [llength $argv] if {($len != 2) && ($len != 3)} { puts "usage: $argv0 pkgName pkgDir \[outFile\]" puts " pkgName == Tcl,Tk" - puts " pkgDir == /home/surles/cvs/tcl9.0" + puts " pkgDir == /home/surles/cvs/tcl8.2" exit 1 } set pkg [lindex $argv 0] set dir [lindex $argv 1] Index: tools/configure ================================================================== --- tools/configure +++ tools/configure @@ -1679,11 +1679,11 @@ #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=9.0 +DEF_VER=8.7 # Check whether --with-tcl was given. if test "${with_tcl+set}" = set; then : withval=$with_tcl; TCL_BIN_DIR=$withval Index: tools/configure.ac ================================================================== --- tools/configure.ac +++ tools/configure.ac @@ -9,11 +9,11 @@ #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=9.0 +DEF_VER=8.7 AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist) fi Index: tools/encoding/txt2enc.c ================================================================== --- tools/encoding/txt2enc.c +++ tools/encoding/txt2enc.c @@ -174,11 +174,11 @@ if (enc < 32 || uni < 32) { continue; } hi = enc >> 8; - lo = enc & 0xff; + lo = enc & 0xFF; if (toUnicode[hi] == NULL) { toUnicode[hi] = (Rune *) malloc(256 * sizeof(Rune)); memset(toUnicode[hi], 0, 256 * sizeof(Rune)); } toUnicode[hi][lo] = uni; @@ -206,11 +206,11 @@ } for (i = 0; i < 0x20; i++) { toUnicode[0][i] = i; } if (fixmissing) { - for (i = 0x7F; i < 0xa0; i++) { + for (i = 0x7F; i < 0xA0; i++) { if (toUnicode[i] == NULL && toUnicode[0][i] == 0) { toUnicode[0][i] = i; } } } @@ -232,11 +232,11 @@ for (hi = 0; hi < 256; hi++) { if (toUnicode[hi] != NULL) { printf("%02X\n", hi); for (lo = 0; lo < 256; lo++) { printf("%04X", toUnicode[hi][lo]); - if ((lo & 0x0f) == 0x0f) { + if ((lo & 0x0F) == 0x0F) { putchar('\n'); } } } } DELETED tools/fix_tommath_h.tcl Index: tools/fix_tommath_h.tcl ================================================================== --- tools/fix_tommath_h.tcl +++ /dev/null @@ -1,103 +0,0 @@ -# fixtommath.tcl -- -# -# Changes to 'tommath.h' to make it conform with Tcl's linking -# conventions. -# -# Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -#---------------------------------------------------------------------- - -set f [open [lindex $argv 0] r] -set data [read $f] -close $f - -set eat_endif 0 -set eat_semi 0 -set def_count 0 -foreach line [split $data \n] { - if {!$eat_semi && !$eat_endif} { - switch -regexp -- $line { - {#define BN_H_} { - puts $line - puts {} - puts "\#include \"tclTomMathDecls.h\"" - puts "\#ifndef MODULE_SCOPE" - puts "\#define MODULE_SCOPE extern" - puts "\#endif" - } - {typedef\s+unsigned long\s+mp_digit;} { - # change the second 'typedef unsigned long mp - incr def_count - puts "\#ifndef MP_DIGIT_DECLARED" - if {$def_count == 2} { - puts [string map {long int} $line] - } else { - puts $line - } - puts "\#define MP_DIGIT_DECLARED" - puts "\#endif" - } - {typedef.*mp_digit;} { - puts "\#ifndef MP_DIGIT_DECLARED" - puts $line - puts "\#define MP_DIGIT_DECLARED" - puts "\#endif" - } - {typedef.*mp_word;} { - puts "\#ifndef MP_WORD_DECLARED" - puts $line - puts "\#define MP_WORD_DECLARED" - puts "\#endif" - } - {typedef struct} { - puts "\#ifndef MP_INT_DECLARED" - puts "\#define MP_INT_DECLARED" - puts "typedef struct mp_int mp_int;" - puts "\#endif" - puts "struct mp_int \{" - } - \}\ mp_int\; { - puts "\};" - } - {^(char|int|void)} { - puts "/*" - puts $line - set eat_semi 1 - set after_semi "*/" - } - {^extern (int|const)} { - puts "\#if defined(BUILD_tcl) || !defined(_WIN32)" - puts [regsub {^extern} $line "MODULE_SCOPE"] - set eat_semi 1 - set after_semi "\#endif" - } - {define heap macros} { - puts $line - puts "\#if 0 /* these are macros in tclTomMathDecls.h */" - set eat_endif 1 - } - {#include} { - # remove all includes - } - default { - puts $line - } - } - } else { - puts $line - } - if {$eat_semi} { - if {[regexp {; *$} $line]} { - puts $after_semi - set eat_semi 0 - } - } - if {$eat_endif} { - if {[regexp {^\#endif} $line]} { - puts "\#endif" - set eat_endif 0 - } - } -} Index: tools/genStubs.tcl ================================================================== --- tools/genStubs.tcl +++ tools/genStubs.tcl @@ -477,15 +477,19 @@ append text "/* $index */\n" if {[info exists stubs($name,deprecated,$index)]} { append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n" set line "$rtype" + } elseif {[string range $rtype end-5 end] eq "MP_WUR"} { + set line "$scspec [string trim [string range $rtype 0 end-6]]" } else { set line "$scspec $rtype" } set count [expr {2 - ([string length $line] / 8)}] - append line [string range "\t\t\t" 0 $count] + if {$count >= 0} { + append line [string range "\t\t\t" 0 $count] + } set pad [expr {24 - [string length $line]}] if {$pad <= 0} { append line " " set pad 0 } @@ -545,10 +549,13 @@ append line $next set sep ", " } append line ")" } + } + if {[string range $rtype end-5 end] eq "MP_WUR"} { + append line " MP_WUR" } return "$text$line;\n" } # genStubs::makeMacro -- @@ -609,10 +616,12 @@ } if {[string range $rtype end-8 end] eq "__stdcall"} { append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " } elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} { append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") " + } elseif {[string range $rtype end-5 end] eq "MP_WUR"} { + append text [string trim [string range $rtype 0 end-6]] " (*" $lfname ") " } else { append text $rtype " (*" $lfname ") " } set arg1 [lindex $args 0] switch -exact $arg1 { @@ -646,10 +655,13 @@ } append text ")" } } + if {[string range $rtype end-5 end] eq "MP_WUR"} { + append text " MP_WUR" + } append text "; /* $index */\n" return $text } # genStubs::makeInit -- Index: tools/loadICU.tcl ================================================================== --- tools/loadICU.tcl +++ tools/loadICU.tcl @@ -589,11 +589,11 @@ proc backslashify { string } { set retval {} foreach char [split $string {}] { scan $char %c ccode - if { $ccode >= 0x0020 && $ccode < 0x007f && $char ne "\"" + if { $ccode >= 0x0020 && $ccode < 0x007F && $char ne "\"" && $char ne "\{" && $char ne "\}" && $char ne "\[" && $char ne "\]" && $char ne "\\" && $char ne "\$" } { append retval $char } else { append retval \\u [format %04x $ccode] Index: tools/makeTestCases.tcl ================================================================== --- tools/makeTestCases.tcl +++ tools/makeTestCases.tcl @@ -590,11 +590,11 @@ foreach row $TZData(:America/Detroit) { foreach { t offset isdst tzname } $row break if { $t > -4000000000000 } { set conds [list detroit] - if { $t > wide(0x7fffffff) } { + if { $t > wide(0x7FFFFFFF) } { set conds [list detroit y2038] } incr t -1 set x [clock format $t -format {%Y-%m-%d %H:%M:%S} \ -timezone :America/Detroit] Index: tools/mkdepend.tcl ================================================================== --- tools/mkdepend.tcl +++ tools/mkdepend.tcl @@ -96,11 +96,11 @@ set target $fname puts stderr "processing [file tail $fname]" } else { # don't include ourselves as a dependency of ourself. if {![string compare $fname $target]} {continue} - # store in an array so multiple occurances are not counted. + # store in an array so multiple occurrences are not counted. set depends($target|$fname) "" } } } Index: tools/tcl.hpj.in ================================================================== --- tools/tcl.hpj.in +++ tools/tcl.hpj.in @@ -3,13 +3,13 @@ [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl90.cnt +CNT=tcl87.cnt COPYRIGHT=Copyright � 2000 Ajuba Solutions -HLP=tcl90.hlp +HLP=tcl87.hlp [FILES] tcl.rtf [WINDOWS] ADDED tools/tclOOScript.tcl Index: tools/tclOOScript.tcl ================================================================== --- /dev/null +++ tools/tclOOScript.tcl @@ -0,0 +1,456 @@ +# tclOOScript.h -- +# +# This file contains support scripts for TclOO. They are defined here so +# that the code can be definitely run even in safe interpreters; TclOO's +# core setup is safe. +# +# Copyright (c) 2012-2018 Donal K. Fellows +# Copyright (c) 2013 Andreas Kupries +# Copyright (c) 2017 Gerald Lester +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +::namespace eval ::oo { + ::namespace path {} + + # + # Commands that are made available to objects by default. + # + namespace eval Helpers { + ::namespace path {} + + # ------------------------------------------------------------------ + # + # callback, mymethod -- + # + # Create a script prefix that calls a method on the current + # object. Same operation, two names. + # + # ------------------------------------------------------------------ + + proc callback {method args} { + list [uplevel 1 {::namespace which my}] $method {*}$args + } + + # Make the [callback] command appear as [mymethod] too. + namespace export callback + namespace eval tmp {namespace import ::oo::Helpers::callback} + namespace export -clear + rename tmp::callback mymethod + namespace delete tmp + + # ------------------------------------------------------------------ + # + # classvariable -- + # + # Link to a variable in the class of the current object. + # + # ------------------------------------------------------------------ + + proc classvariable {name args} { + # Get a reference to the class's namespace + set ns [info object namespace [uplevel 1 {self class}]] + # Double up the list of variable names + foreach v [list $name {*}$args] { + if {[string match *(*) $v]} { + set reason "can't create a scalar variable that looks like an array element" + return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \ + [format {bad variable name "%s": %s} $v $reason] + } + if {[string match *::* $v]} { + set reason "can't create a local variable with a namespace separator in it" + return -code error -errorcode {TCL UPVAR INVERTED} \ + [format {bad variable name "%s": %s} $v $reason] + } + lappend vs $v $v + } + # Lastly, link the caller's local variables to the class's variables + tailcall namespace upvar $ns {*}$vs + } + + # ------------------------------------------------------------------ + # + # link -- + # + # Make a command that invokes a method on the current object. + # The name of the command and the name of the method match by + # default. + # + # ------------------------------------------------------------------ + + proc link {args} { + set ns [uplevel 1 {::namespace current}] + foreach link $args { + if {[llength $link] == 2} { + lassign $link src dst + } elseif {[llength $link] == 1} { + lassign $link src + set dst $src + } else { + return -code error -errorcode {TCLOO CMDLINK FORMAT} \ + "bad link description; must only have one or two elements" + } + if {![string match ::* $src]} { + set src [string cat $ns :: $src] + } + interp alias {} $src {} ${ns}::my $dst + trace add command ${ns}::my delete [list \ + ::oo::UnlinkLinkedCommand $src] + } + return + } + } + + # ---------------------------------------------------------------------- + # + # UnlinkLinkedCommand -- + # + # Callback used to remove linked command when the underlying mechanism + # that supports it is deleted. + # + # ---------------------------------------------------------------------- + + proc UnlinkLinkedCommand {cmd args} { + if {[namespace which $cmd] ne {}} { + rename $cmd {} + } + } + + # ---------------------------------------------------------------------- + # + # DelegateName -- + # + # Utility that gets the name of the class delegate for a class. It's + # trivial, but makes working with them much easier as delegate names are + # intentionally hard to create by accident. + # + # ---------------------------------------------------------------------- + + proc DelegateName {class} { + string cat [info object namespace $class] {:: oo ::delegate} + } + + # ---------------------------------------------------------------------- + # + # MixinClassDelegates -- + # + # Support code called *after* [oo::define] inside the constructor of a + # class that patches in the appropriate class delegates. + # + # ---------------------------------------------------------------------- + + proc MixinClassDelegates {class} { + if {![info object isa class $class]} { + return + } + set delegate [DelegateName $class] + if {![info object isa class $delegate]} { + return + } + foreach c [info class superclass $class] { + set d [DelegateName $c] + if {![info object isa class $d]} { + continue + } + define $delegate ::oo::define::superclass -append $d + } + objdefine $class ::oo::objdefine::mixin -append $delegate + } + + # ---------------------------------------------------------------------- + # + # UpdateClassDelegatesAfterClone -- + # + # Support code that is like [MixinClassDelegates] except for when a + # class is cloned. + # + # ---------------------------------------------------------------------- + + proc UpdateClassDelegatesAfterClone {originObject targetObject} { + # Rebuild the class inheritance delegation class + set originDelegate [DelegateName $originObject] + set targetDelegate [DelegateName $targetObject] + if { + [info object isa class $originDelegate] + && ![info object isa class $targetDelegate] + } then { + copy $originDelegate $targetDelegate + objdefine $targetObject ::oo::objdefine::mixin -set \ + {*}[lmap c [info object mixin $targetObject] { + if {$c eq $originDelegate} {set targetDelegate} {set c} + }] + } + } + + # ---------------------------------------------------------------------- + # + # oo::define::classmethod -- + # + # Defines a class method. See define(n) for details. + # + # Note that the ::oo::define namespace is semi-public and a bit weird + # anyway, so we don't regard the namespace path as being under control: + # fully qualified names are used for everything. + # + # ---------------------------------------------------------------------- + + proc define::classmethod {name {args {}} {body {}}} { + # Create the method on the class if the caller gave arguments and body + ::set argc [::llength [::info level 0]] + ::if {$argc == 3} { + ::return -code error -errorcode {TCL WRONGARGS} [::format \ + {wrong # args: should be "%s name ?args body?"} \ + [::lindex [::info level 0] 0]] + } + ::set cls [::uplevel 1 self] + ::if {$argc == 4} { + ::oo::define [::oo::DelegateName $cls] method $name $args $body + } + # Make the connection by forwarding + ::tailcall forward $name myclass $name + } + + # ---------------------------------------------------------------------- + # + # oo::define::initialise, oo::define::initialize -- + # + # Do specific initialisation for a class. See define(n) for details. + # + # Note that the ::oo::define namespace is semi-public and a bit weird + # anyway, so we don't regard the namespace path as being under control: + # fully qualified names are used for everything. + # + # ---------------------------------------------------------------------- + + proc define::initialise {body} { + ::set clsns [::info object namespace [::uplevel 1 self]] + ::tailcall apply [::list {} $body $clsns] + } + + # Make the [initialise] definition appear as [initialize] too + namespace eval define { + ::namespace export initialise + ::namespace eval tmp {::namespace import ::oo::define::initialise} + ::namespace export -clear + ::rename tmp::initialise initialize + ::namespace delete tmp + } + + # ---------------------------------------------------------------------- + # + # Slot -- + # + # The class of slot operations, which are basically lists at the low + # level of TclOO; this provides a more consistent interface to them. + # + # ---------------------------------------------------------------------- + + define Slot { + # ------------------------------------------------------------------ + # + # Slot Get -- + # + # Basic slot getter. Retrieves the contents of the slot. + # Particular slots must provide concrete non-erroring + # implementation. + # + # ------------------------------------------------------------------ + + method Get {} { + return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" + } + + # ------------------------------------------------------------------ + # + # Slot Set -- + # + # Basic slot setter. Sets the contents of the slot. Particular + # slots must provide concrete non-erroring implementation. + # + # ------------------------------------------------------------------ + + method Set list { + return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" + } + + # ------------------------------------------------------------------ + # + # Slot Resolve -- + # + # Helper that lets a slot convert a list of arguments of a + # particular type to their canonical forms. Defaults to doing + # nothing (suitable for simple strings). + # + # ------------------------------------------------------------------ + + method Resolve list { + return $list + } + + # ------------------------------------------------------------------ + # + # Slot -set, -append, -clear, --default-operation -- + # + # Standard public slot operations. If a slot can't figure out + # what method to call directly, it uses --default-operation. + # + # ------------------------------------------------------------------ + + method -set args { + set my [namespace which my] + set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] + tailcall my Set $args + } + method -append args { + set my [namespace which my] + set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] + set current [uplevel 1 [list $my Get]] + tailcall my Set [list {*}$current {*}$args] + } + method -clear {} {tailcall my Set {}} + method -prepend args { + set my [namespace which my] + set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] + set current [uplevel 1 [list $my Get]] + tailcall my Set [list {*}$args {*}$current] + } + method -remove args { + set my [namespace which my] + set args [lmap a $args {uplevel 1 [list $my Resolve $a]}] + set current [uplevel 1 [list $my Get]] + tailcall my Set [lmap val $current { + if {$val in $args} continue else {set val} + }] + } + + # Default handling + forward --default-operation my -append + method unknown {args} { + set def --default-operation + if {[llength $args] == 0} { + tailcall my $def + } elseif {![string match -* [lindex $args 0]]} { + tailcall my $def {*}$args + } + next {*}$args + } + + # Set up what is exported and what isn't + export -set -append -clear -prepend -remove + unexport unknown destroy + } + + # Set the default operation differently for these slots + objdefine define::superclass forward --default-operation my -set + objdefine define::mixin forward --default-operation my -set + objdefine objdefine::mixin forward --default-operation my -set + + # ---------------------------------------------------------------------- + # + # oo::object -- + # + # Handler for cloning objects that clones basic bits (only!) of the + # object's namespace. Non-procedures, traces, sub-namespaces, etc. need + # more complex (and class-specific) handling. + # + # ---------------------------------------------------------------------- + + define object method {originObject} { + # Copy over the procedures from the original namespace + foreach p [info procs [info object namespace $originObject]::*] { + set args [info args $p] + set idx -1 + foreach a $args { + if {[info default $p $a d]} { + lset args [incr idx] [list $a $d] + } else { + lset args [incr idx] [list $a] + } + } + set b [info body $p] + set p [namespace tail $p] + proc $p $args $b + } + # Copy over the variables from the original namespace + foreach v [info vars [info object namespace $originObject]::*] { + upvar 0 $v vOrigin + namespace upvar [namespace current] [namespace tail $v] vNew + if {[info exists vOrigin]} { + if {[array exists vOrigin]} { + array set vNew [array get vOrigin] + } else { + set vNew $vOrigin + } + } + } + # General commands, sub-namespaces and advancd variable config (traces, + # etc) are *not* copied over. Classes that want that should do it + # themselves. + } + + # ---------------------------------------------------------------------- + # + # oo::class -- + # + # Handler for cloning classes, which fixes up the delegates. + # + # ---------------------------------------------------------------------- + + define class method {originObject} { + next $originObject + # Rebuild the class inheritance delegation class + ::oo::UpdateClassDelegatesAfterClone $originObject [self] + } + + # ---------------------------------------------------------------------- + # + # oo::singleton -- + # + # A metaclass that is used to make classes that only permit one instance + # of them to exist. See singleton(n). + # + # ---------------------------------------------------------------------- + + class create singleton { + superclass class + variable object + unexport create createWithNamespace + method new args { + if {![info exists object] || ![info object isa object $object]} { + set object [next {*}$args] + ::oo::objdefine $object { + method destroy {} { + ::return -code error -errorcode {TCLOO SINGLETON} \ + "may not destroy a singleton object" + } + method {originObject} { + ::return -code error -errorcode {TCLOO SINGLETON} \ + "may not clone a singleton object" + } + } + } + return $object + } + } + + # ---------------------------------------------------------------------- + # + # oo::abstract -- + # + # A metaclass that is used to make classes that can't be directly + # instantiated. See abstract(n). + # + # ---------------------------------------------------------------------- + + class create abstract { + superclass class + unexport create createWithNamespace new + } +} + +# Local Variables: +# mode: tcl +# c-basic-offset: 4 +# fill-column: 78 +# End: Index: tools/tcltk-man2html-utils.tcl ================================================================== --- tools/tcltk-man2html-utils.tcl +++ tools/tcltk-man2html-utils.tcl @@ -874,11 +874,11 @@ [string range $text 0 [expr {$offset(bold)-1}]] set body [string range $text [expr {$offset(bold)+3}] \ [expr {$offset(end-bold)-1}]] set text [string range $text[set text ""] \ [expr {$offset(end-bold)+4}] end] - regsub {http://[\w/.]+} $body {&} body + regsub {http://[\w/.-]+} $body {&} body append result [cross-reference $body] continue } anchor { append result \ @@ -910,11 +910,11 @@ continue } url { set off [lindex $offsets 0] append result [string range $text 0 [expr {$off-1}]] - regexp -indices -start $off {http://[\w/.]+} $text range + regexp -indices -start $off {http://[\w/.-]+} $text range set url [string range $text {*}$range] append result "$url" set text [string range $text[set text ""] \ [expr {[lindex $range 1]+1}] end] continue Index: tools/tcltk-man2html.tcl ================================================================== --- tools/tcltk-man2html.tcl +++ tools/tcltk-man2html.tcl @@ -2,11 +2,11 @@ if {[catch {package require Tcl 8.6-} msg]} { puts stderr "ERROR: $msg" puts stderr "If running this script from 'make html', set the\ NATIVE_TCLSH environment\nvariable to point to an installed\ - tclsh9.0 (or the equivalent tclsh90.exe\non Windows)." + tclsh8.7 (or the equivalent tclsh87.exe\non Windows)." exit 1 } # Convert Ousterhout format man pages into highly crosslinked hypertext. # @@ -20,11 +20,11 @@ # try to use this, you'll be very much on your own. # # Copyright (c) 1995-1997 Roger E. Critchlow Jr # Copyright (c) 2004-2010 Donal K. Fellows -set ::Version "50/9.0" +set ::Version "50/8.7" set ::CSSFILE "docs.css" ## ## Source the utility functions that provide most of the ## implementation of the transformation from nroff to html. Index: tools/uniClass.tcl ================================================================== --- tools/uniClass.tcl +++ tools/uniClass.tcl @@ -14,37 +14,37 @@ proc emitRange {first last} { global ranges numranges chars numchars extchars extranges if {$first < ($last-1)} { - if {!$extranges && ($first) > 0xffff} { + if {!$extranges && ($first) > 0xFFFF} { set extranges 1 set numranges 0 set ranges [string trimright $ranges " \n\r\t,"] append ranges "\n#if CHRBITS > 16\n ," } - append ranges [format "{0x%x, 0x%x}, " \ + append ranges [format "{0x%X, 0x%X}, " \ $first $last] if {[incr numranges] % 4 == 0} { set ranges [string trimright $ranges] append ranges "\n " } } else { - if {!$extchars && ($first) > 0xffff} { + if {!$extchars && ($first) > 0xFFFF} { set extchars 1 set numchars 0 set chars [string trimright $chars " \n\r\t,"] append chars "\n#if CHRBITS > 16\n ," } - append chars [format "0x%x, " $first] + append chars [format "0x%X, " $first] incr numchars if {$numchars % 9 == 0} { set chars [string trimright $chars] append chars "\n " } if {$first != $last} { - append chars [format "0x%x, " $last] + append chars [format "0x%X, " $last] incr numchars if {$numchars % 9 == 0} { append chars "\n " } } @@ -61,15 +61,15 @@ set chars " " set numchars 0 set extchars 0 set extranges 0 - for {set i 0} {$i <= 0x10ffff} {incr i} { - if {$i == 0xd800} { - # Skip surrogates - set i 0xe000 - } + for {set i 0} {$i <= 0x10FFFF} {incr i} { + if {$i == 0xD800} { + # Skip surrogates + set i 0xE000 + } if {[string is $type [format %c $i]]} { if {$i == ($last + 1)} { set last $i } else { if {$first >= 0} { Index: tools/uniParse.tcl ================================================================== --- tools/uniParse.tcl +++ tools/uniParse.tcl @@ -112,12 +112,12 @@ } set items [split $line \;] scan [lindex $items 0] %x index - if {$index > 0x2ffff} then { - # Ignore non-BMP characters, as long as Tcl doesn't support them + if {$index > 0x3FFFF} then { + # Ignore characters > plane 3 continue } set index [format %d $index] set gIndex [getGroup [getValue $items $index]] @@ -341,13 +341,13 @@ } puts $f $line puts -nonewline $f "}; #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 -# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= [format 0x%x $next]) +# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next]) #else -# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0) +# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0) #endif /* * The following constants are used to determine the category of a * Unicode character. @@ -390,27 +390,27 @@ * The following macros extract the fields of the character info. The * GetDelta() macro is complicated because we can't rely on the C compiler * to do sign extension on right shifts. */ -#define GetCaseType(info) (((info) & 0xe0) >> 5) -#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1f) +#define GetCaseType(info) (((info) & 0xE0) >> 5) +#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1F) #define GetDelta(info) ((info) >> 8) /* * This macro extracts the information about a character from the * Unicode character tables. */ #if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 -# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1fffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) +# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) #else -# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) +# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) #endif " close $f } uni::main return Index: unix/Makefile.in ================================================================== --- unix/Makefile.in +++ unix/Makefile.in @@ -26,10 +26,11 @@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ +runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. @@ -50,10 +51,13 @@ DLL_INSTALL_DIR = @DLL_INSTALL_DIR@ # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) +# Path name to use when installing Tcl modules. +MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 + # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Path to the private tcl header dir: PRIVATE_INCLUDE_DIR = @PRIVATE_INCLUDE_DIR@ @@ -108,15 +112,10 @@ # Flags to pass to the linker LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ -# To disable ANSI-C procedure prototypes reverse the comment characters on the -# following lines: -PROTO_FLAGS = -#PROTO_FLAGS = -DNO_PROTOTYPE - # If you use the setenv, putenv, or unsetenv procedures to modify environment # variables in your application and you'd like those modifications to appear # in the "env" Tcl variable, switch the comments on the two lines below so # that Tcl provides these procedures instead of your standard C library. @@ -123,11 +122,11 @@ ENV_FLAGS = #ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv # To enable memory debugging, call configure with --enable-symbols=mem # Warning: if you enable memory debugging, you must do it *everywhere*, -# including all the code that calls Tcl, and you must use Tcl_Alloc and Tcl_Free +# including all the code that calls Tcl, and you must use ckalloc and ckfree # everywhere instead of malloc and free. TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ #TCL_STUB_LIB_FILE = libtclstub.a @@ -177,10 +176,11 @@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ -DBUILD_tcl SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ +SHLIB_LD_FLAGS = @SHLIB_LD_FLAGS@ TCL_SHLIB_LD_EXTRAS = @TCL_SHLIB_LD_EXTRAS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ DLTEST_TARGETS = dltest.marker @@ -225,11 +225,10 @@ DTRACE = @DTRACE@ SRC_DIR = @srcdir@ TOP_DIR = @TCL_SRC_DIR@ BUILD_DIR = @builddir@ GENERIC_DIR = $(TOP_DIR)/generic -TOMMATH_DIR = $(TOP_DIR)/libtommath COMPAT_DIR = $(TOP_DIR)/compat TOOL_DIR = $(TOP_DIR)/tools UNIX_DIR = $(TOP_DIR)/unix MAC_OSX_DIR = $(TOP_DIR)/macosx PKGS_DIR = $(TOP_DIR)/pkgs @@ -238,10 +237,12 @@ # Must be absolute to so the corresponding tcltest's tcl_library is absolute. TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library ZLIB_DIR = ${COMPAT_DIR}/zlib ZLIB_INCLUDE = @ZLIB_INCLUDE@ +TOMMATH_DIR = $(TOP_DIR)/libtommath +TOMMATH_INCLUDE = @TOMMATH_INCLUDE@ CC = @CC@ OBJEXT = @OBJEXT@ #CC = purify -best-effort @CC@ -DPURIFY @@ -272,23 +273,23 @@ #-------------------------------------------------------------------------- # The information below should be usable as is. The configure script won't # modify it and you shouldn't need to modify it either. #-------------------------------------------------------------------------- -STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ - -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ - ${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \ +STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ + ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ + ${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \ @EXTRA_CC_SWITCHES@ -CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} +CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@ LIBS = @TCL_LIBS@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ - ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ + ${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o @@ -317,32 +318,33 @@ tclTomMathInterface.o tclZipfs.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o -TOMMATH_OBJS = bn_reverse.o bn_fast_s_mp_mul_digs.o \ - bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \ +TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \ + bn_s_mp_sqr_fast.o bn_mp_add.o bn_mp_and.o \ bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ bn_mp_cnt_lsb.o bn_mp_copy.o \ bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \ - bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o \ - bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_s_mp_get_bit.o bn_mp_get_int.o \ - bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \ + bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o bn_mp_expt_u32.o \ + bn_mp_get_mag_u64.o \ + bn_mp_grow.o bn_mp_init.o \ bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \ - bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \ - bn_mp_karatsuba_sqr.o \ + bn_mp_init_size.o bn_s_mp_karatsuba_mul.o \ + bn_mp_init_i64.o bn_mp_init_u64.o \ + bn_s_mp_karatsuba_sqr.o bn_s_mp_balance_mul.o \ bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \ - bn_mp_radix_size.o bn_mp_radix_smap.o \ - bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \ - bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \ + bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_set_i64.o \ + bn_mp_read_radix.o bn_mp_rshd.o \ + bn_mp_set_u64.o bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_signed_rsh.o \ - bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ - bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \ - bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ + bn_mp_to_ubin.o \ + bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \ + bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ @@ -365,11 +367,11 @@ Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \ ${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@ -OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ +OBJS = ${TCL_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ @TOMMATH_OBJS@ TCL_DECLS = \ $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls \ $(GENERIC_DIR)/tclOO.decls \ @@ -488,80 +490,167 @@ $(GENERIC_DIR)/tclStubLib.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c TOMMATH_SRCS = \ - $(TOMMATH_DIR)/bn_reverse.c \ - $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c \ - $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c \ + $(TOMMATH_DIR)/bn_cutoffs.c \ + $(TOMMATH_DIR)/bn_deprecated.c \ + $(TOMMATH_DIR)/bn_mp_2expt.c \ + $(TOMMATH_DIR)/bn_mp_abs.c \ $(TOMMATH_DIR)/bn_mp_add.c \ $(TOMMATH_DIR)/bn_mp_add_d.c \ + $(TOMMATH_DIR)/bn_mp_addmod.c \ $(TOMMATH_DIR)/bn_mp_and.c \ $(TOMMATH_DIR)/bn_mp_clamp.c \ $(TOMMATH_DIR)/bn_mp_clear.c \ $(TOMMATH_DIR)/bn_mp_clear_multi.c \ $(TOMMATH_DIR)/bn_mp_cmp.c \ $(TOMMATH_DIR)/bn_mp_cmp_d.c \ $(TOMMATH_DIR)/bn_mp_cmp_mag.c \ - $(TOMMATH_DIR)/bn_mp_copy.c \ $(TOMMATH_DIR)/bn_mp_cnt_lsb.c \ + $(TOMMATH_DIR)/bn_mp_complement.c \ + $(TOMMATH_DIR)/bn_mp_copy.c \ $(TOMMATH_DIR)/bn_mp_count_bits.c \ + $(TOMMATH_DIR)/bn_mp_decr.c \ $(TOMMATH_DIR)/bn_mp_div.c \ - $(TOMMATH_DIR)/bn_mp_div_d.c \ $(TOMMATH_DIR)/bn_mp_div_2.c \ $(TOMMATH_DIR)/bn_mp_div_2d.c \ $(TOMMATH_DIR)/bn_mp_div_3.c \ + $(TOMMATH_DIR)/bn_mp_div_d.c \ + $(TOMMATH_DIR)/bn_mp_dr_is_modulus.c \ + $(TOMMATH_DIR)/bn_mp_dr_reduce.c \ + $(TOMMATH_DIR)/bn_mp_dr_setup.c \ + $(TOMMATH_DIR)/bn_mp_error_to_string.c \ $(TOMMATH_DIR)/bn_mp_exch.c \ - $(TOMMATH_DIR)/bn_mp_expt_d.c \ - $(TOMMATH_DIR)/bn_mp_expt_d_ex.c \ - $(TOMMATH_DIR)/bn_mp_get_int.c \ - $(TOMMATH_DIR)/bn_mp_get_long.c \ - $(TOMMATH_DIR)/bn_mp_get_long_long.c \ + $(TOMMATH_DIR)/bn_mp_expt_u32.c \ + $(TOMMATH_DIR)/bn_mp_exptmod.c \ + $(TOMMATH_DIR)/bn_mp_exteuclid.c \ + $(TOMMATH_DIR)/bn_mp_fread.c \ + $(TOMMATH_DIR)/bn_mp_from_sbin.c \ + $(TOMMATH_DIR)/bn_mp_from_ubin.c \ + $(TOMMATH_DIR)/bn_mp_fwrite.c \ + $(TOMMATH_DIR)/bn_mp_gcd.c \ + $(TOMMATH_DIR)/bn_mp_get_double.c \ + $(TOMMATH_DIR)/bn_mp_get_i32.c \ + $(TOMMATH_DIR)/bn_mp_get_i64.c \ + $(TOMMATH_DIR)/bn_mp_get_l.c \ + $(TOMMATH_DIR)/bn_mp_get_ll.c \ + $(TOMMATH_DIR)/bn_mp_get_mag_u32.c \ + $(TOMMATH_DIR)/bn_mp_get_mag_u64.c \ + $(TOMMATH_DIR)/bn_mp_get_mag_ul.c \ + $(TOMMATH_DIR)/bn_mp_get_mag_ull.c \ $(TOMMATH_DIR)/bn_mp_grow.c \ + $(TOMMATH_DIR)/bn_mp_incr.c \ $(TOMMATH_DIR)/bn_mp_init.c \ $(TOMMATH_DIR)/bn_mp_init_copy.c \ + $(TOMMATH_DIR)/bn_mp_init_i32.c \ + $(TOMMATH_DIR)/bn_mp_init_i64.c \ + $(TOMMATH_DIR)/bn_mp_init_l.c \ + $(TOMMATH_DIR)/bn_mp_init_ll.c \ $(TOMMATH_DIR)/bn_mp_init_multi.c \ $(TOMMATH_DIR)/bn_mp_init_set.c \ - $(TOMMATH_DIR)/bn_mp_init_set_int.c \ $(TOMMATH_DIR)/bn_mp_init_size.c \ - $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c \ - $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c \ + $(TOMMATH_DIR)/bn_mp_init_u32.c \ + $(TOMMATH_DIR)/bn_mp_init_u64.c \ + $(TOMMATH_DIR)/bn_mp_init_ul.c \ + $(TOMMATH_DIR)/bn_mp_init_ull.c \ + $(TOMMATH_DIR)/bn_mp_invmod.c \ + $(TOMMATH_DIR)/bn_mp_is_square.c \ + $(TOMMATH_DIR)/bn_mp_iseven.c \ + $(TOMMATH_DIR)/bn_mp_isodd.c \ + $(TOMMATH_DIR)/bn_mp_kronecker.c \ + $(TOMMATH_DIR)/bn_mp_lcm.c \ + $(TOMMATH_DIR)/bn_mp_log_u32.c \ $(TOMMATH_DIR)/bn_mp_lshd.c \ $(TOMMATH_DIR)/bn_mp_mod.c \ $(TOMMATH_DIR)/bn_mp_mod_2d.c \ + $(TOMMATH_DIR)/bn_mp_mod_d.c \ + $(TOMMATH_DIR)/bn_mp_montgomery_calc_normalization.c \ + $(TOMMATH_DIR)/bn_mp_montgomery_reduce.c \ + $(TOMMATH_DIR)/bn_mp_montgomery_setup.c \ $(TOMMATH_DIR)/bn_mp_mul.c \ $(TOMMATH_DIR)/bn_mp_mul_2.c \ $(TOMMATH_DIR)/bn_mp_mul_2d.c \ $(TOMMATH_DIR)/bn_mp_mul_d.c \ + $(TOMMATH_DIR)/bn_mp_mulmod.c \ $(TOMMATH_DIR)/bn_mp_neg.c \ $(TOMMATH_DIR)/bn_mp_or.c \ + $(TOMMATH_DIR)/bn_mp_pack.c \ + $(TOMMATH_DIR)/bn_mp_pack_count.c \ + $(TOMMATH_DIR)/bn_mp_prime_fermat.c \ + $(TOMMATH_DIR)/bn_mp_prime_frobenius_underwood.c \ + $(TOMMATH_DIR)/bn_mp_prime_is_prime.c \ + $(TOMMATH_DIR)/bn_mp_prime_miller_rabin.c \ + $(TOMMATH_DIR)/bn_mp_prime_next_prime.c \ + $(TOMMATH_DIR)/bn_mp_prime_rabin_miller_trials.c \ + $(TOMMATH_DIR)/bn_mp_prime_rand.c \ + $(TOMMATH_DIR)/bn_mp_prime_strong_lucas_selfridge.c \ $(TOMMATH_DIR)/bn_mp_radix_size.c \ $(TOMMATH_DIR)/bn_mp_radix_smap.c \ + $(TOMMATH_DIR)/bn_mp_rand.c \ $(TOMMATH_DIR)/bn_mp_read_radix.c \ + $(TOMMATH_DIR)/bn_mp_reduce.c \ + $(TOMMATH_DIR)/bn_mp_reduce_2k.c \ + $(TOMMATH_DIR)/bn_mp_reduce_2k_l.c \ + $(TOMMATH_DIR)/bn_mp_reduce_2k_setup.c \ + $(TOMMATH_DIR)/bn_mp_reduce_2k_setup_l.c \ + $(TOMMATH_DIR)/bn_mp_reduce_is_2k.c \ + $(TOMMATH_DIR)/bn_mp_reduce_is_2k_l.c \ + $(TOMMATH_DIR)/bn_mp_reduce_setup.c \ + $(TOMMATH_DIR)/bn_mp_root_u32.c \ $(TOMMATH_DIR)/bn_mp_rshd.c \ + $(TOMMATH_DIR)/bn_mp_sbin_size.c \ $(TOMMATH_DIR)/bn_mp_set.c \ - $(TOMMATH_DIR)/bn_mp_set_int.c \ - $(TOMMATH_DIR)/bn_mp_set_long.c \ - $(TOMMATH_DIR)/bn_mp_set_long_long.c \ + $(TOMMATH_DIR)/bn_mp_set_double.c \ + $(TOMMATH_DIR)/bn_mp_set_i32.c \ + $(TOMMATH_DIR)/bn_mp_set_i64.c \ + $(TOMMATH_DIR)/bn_mp_set_l.c \ + $(TOMMATH_DIR)/bn_mp_set_ll.c \ + $(TOMMATH_DIR)/bn_mp_set_u32.c \ + $(TOMMATH_DIR)/bn_mp_set_u64.c \ + $(TOMMATH_DIR)/bn_mp_set_ul.c \ + $(TOMMATH_DIR)/bn_mp_set_ull.c \ $(TOMMATH_DIR)/bn_mp_shrink.c \ + $(TOMMATH_DIR)/bn_mp_signed_rsh.c \ $(TOMMATH_DIR)/bn_mp_sqr.c \ + $(TOMMATH_DIR)/bn_mp_sqrmod.c \ $(TOMMATH_DIR)/bn_mp_sqrt.c \ + $(TOMMATH_DIR)/bn_mp_sqrtmod_prime.c \ $(TOMMATH_DIR)/bn_mp_sub.c \ $(TOMMATH_DIR)/bn_mp_sub_d.c \ - $(TOMMATH_DIR)/bn_mp_signed_rsh.c \ - $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \ - $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c \ - $(TOMMATH_DIR)/bn_mp_toom_mul.c \ - $(TOMMATH_DIR)/bn_mp_toom_sqr.c \ - $(TOMMATH_DIR)/bn_mp_toradix_n.c \ - $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c \ + $(TOMMATH_DIR)/bn_mp_submod.c \ + $(TOMMATH_DIR)/bn_mp_to_radix.c \ + $(TOMMATH_DIR)/bn_mp_to_sbin.c \ + $(TOMMATH_DIR)/bn_mp_to_ubin.c \ + $(TOMMATH_DIR)/bn_mp_ubin_size.c \ + $(TOMMATH_DIR)/bn_mp_unpack.c \ $(TOMMATH_DIR)/bn_mp_xor.c \ $(TOMMATH_DIR)/bn_mp_zero.c \ + $(TOMMATH_DIR)/bn_prime_tab.c \ $(TOMMATH_DIR)/bn_s_mp_add.c \ + $(TOMMATH_DIR)/bn_s_mp_balance_mul.c \ + $(TOMMATH_DIR)/bn_s_mp_exptmod.c \ + $(TOMMATH_DIR)/bn_s_mp_exptmod_fast.c \ + $(TOMMATH_DIR)/bn_s_mp_get_bit.c \ + $(TOMMATH_DIR)/bn_s_mp_invmod_fast.c \ + $(TOMMATH_DIR)/bn_s_mp_invmod_slow.c \ + $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c \ + $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c \ + $(TOMMATH_DIR)/bn_s_mp_montgomery_reduce_fast.c \ $(TOMMATH_DIR)/bn_s_mp_mul_digs.c \ + $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c \ + $(TOMMATH_DIR)/bn_s_mp_mul_high_digs.c \ + $(TOMMATH_DIR)/bn_s_mp_mul_high_digs_fast.c \ + $(TOMMATH_DIR)/bn_s_mp_prime_is_divisible.c \ + $(TOMMATH_DIR)/bn_s_mp_rand_jenkins.c \ + $(TOMMATH_DIR)/bn_s_mp_rand_platform.c \ + $(TOMMATH_DIR)/bn_s_mp_reverse.c \ $(TOMMATH_DIR)/bn_s_mp_sqr.c \ - $(TOMMATH_DIR)/bn_s_mp_sub.c + $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c \ + $(TOMMATH_DIR)/bn_s_mp_sub.c \ + $(TOMMATH_DIR)/bn_s_mp_toom_mul.c \ + $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c UNIX_HDRS = \ $(UNIX_DIR)/tclUnixPort.h # $(UNIX_DIR)/tclConfig.h @@ -621,12 +710,12 @@ # Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files # won't compile on the current machine, and they will cause problems for # things like "make depend". -SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ - $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ +SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ + $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ @TOMMATH_SRCS@ ### # Tip 430 - ZipFS Modifications ### @@ -681,16 +770,16 @@ ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} @rm -rf ${TCL_VFS_ROOT} @mkdir -p ${TCL_VFS_PATH} @echo "creating ${TCL_VFS_PATH} (prepare compression)" @if \ - ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/ && \ - ln ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ + ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/; \ then : ; else \ cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ - cp -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ fi + mv ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl + rm -rf ${TCL_VFS_PATH}/dde ${TCL_VFS_PATH}/reg @find ${TCL_VFS_ROOT} -type d -empty -delete @echo "creating ${TCL_ZIP_FILE} from ${TCL_VFS_PATH}" @(zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}' || \ echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?") 2>/dev/null`; \ echo 'cd ${TCL_VFS_ROOT} &&' $$zip '${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}'; \ @@ -896,138 +985,152 @@ echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi @EXTRA_INSTALL_BINARIES@ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/" - @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig - @$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc + @$(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/pkgconfig" + @$(INSTALL_DATA) tcl.pc "$(LIB_INSTALL_DIR)/pkgconfig/tcl.pc" install-libraries-zipfs-shared: libraries - @for i in "$(SCRIPT_INSTALL_DIR)" ; do \ + @for i in "$(SCRIPT_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/" - @for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \ + @for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done install-libraries-zipfs-static: install-libraries-zipfs-shared $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" -MODULE_INSTALL_DIR=$(SCRIPT_INSTALL_DIR)/.. - install-libraries: libraries - @for i in "$(SCRIPT_INSTALL_DIR)" ; do \ + @for i in "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ + do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done - @for i in opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform ; do \ - if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ + @for i in opt0.4 cookiejar0.2 encoding; do \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ - $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ + else true; \ + fi; \ + done; + @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ + do \ + if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ + echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ + $(INSTALL_DATA_DIR) "$(MODULE_INSTALL_DIR)/$$i"; \ fi; \ done @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/" @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \ $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done - @echo "Installing package http 2.9.0 as a Tcl Module" + @echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/" + @for i in $(TOP_DIR)/library/cookiejar/*.tcl; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ + done + @for i in $(TOP_DIR)/library/cookiejar/*.gz; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ + done + @echo "Installing package http 2.9.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl9/9.0/http-2.9.0.tm - @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" - @for i in $(TOP_DIR)/library/opt/*.tcl ; do \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ + "$(MODULE_INSTALL_DIR)/8.6/http-2.9.1.tm" + @echo "Installing package opt 0.4.7" + @for i in $(TOP_DIR)/library/opt/*.tcl; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done @echo "Installing package msgcat 1.7.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl9/9.0/msgcat-1.7.0.tm - @echo "Installing package tcltest 2.5.0 as a Tcl Module" + "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.0.tm" + @echo "Installing package tcltest 2.5.3 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl9/9.0/tcltest-2.5.0.tm + "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.3.tm" @echo "Installing package platform 1.0.14 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl9/9.0/platform-1.0.14.tm + "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.14.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl9/9.0/platform/shell-1.1.4.tm + "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm" @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" - @for i in $(TOP_DIR)/library/encoding/*.enc ; do \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \ + @for i in $(TOP_DIR)/library/encoding/*.enc; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \ done @if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \ echo "Customizing tcl module path"; \ echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \ - "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \ + "$(SCRIPT_INSTALL_DIR)/tm.tcl"; \ fi install-tzdata: - @for i in tzdata ; do \ - if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ + @for i in tzdata; do \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ - $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ fi; \ done @echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/" - @for i in $(TOP_DIR)/library/tzdata/* ; do \ + @for i in $(TOP_DIR)/library/tzdata/*; do \ if [ -d $$i ] ; then \ ii=`basename $$i`; \ - if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii ] ; then \ - $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii" ] ; then \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii"; \ fi; \ - for j in $$i/* ; do \ + for j in $$i/*; do \ if [ -d $$j ] ; then \ jj=`basename $$j`; \ - if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii/$$jj ] ; then \ - $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii/$$jj; \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii/$$jj" ] ; then \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii/$$jj"; \ fi; \ - for k in $$j/* ; do \ - $(INSTALL_DATA) $$k "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii/$$jj; \ + for k in $$j/*; do \ + $(INSTALL_DATA) $$k "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii/$$jj"; \ done; \ else \ - $(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \ + $(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)/tzdata/$$ii"; \ fi; \ done; \ else \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/tzdata; \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/tzdata"; \ fi; \ done install-msgs: - @for i in msgs ; do \ - if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ + @for i in msgs; do \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ - $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ fi; \ done @echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/" - @for i in $(TOP_DIR)/library/msgs/*.msg ; do \ - $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \ + @for i in $(TOP_DIR)/library/msgs/*.msg; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/msgs"; \ done install-doc: doc - @for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; do \ + @for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/" - @for i in $(TOP_DIR)/doc/*.1 ; do \ + @for i in $(TOP_DIR)/doc/*.1; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \ done @echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/" - @for i in $(TOP_DIR)/doc/*.3 ; do \ + @for i in $(TOP_DIR)/doc/*.3; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \ done @echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/"; - @for i in $(TOP_DIR)/doc/*.n ; do \ + @for i in $(TOP_DIR)/doc/*.n; do \ $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \ done # Public headers that define Tcl's API TCL_PUBLIC_HEADERS = $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ @@ -1041,34 +1144,34 @@ $(UNIX_DIR)/tclUnixPort.h # Any other headers you find in the Tcl sources are purely part of Tcl's # implementation, and aren't to be installed. install-headers: - @for i in "$(INCLUDE_INSTALL_DIR)" ; do \ + @for i in "$(INCLUDE_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; - @for i in $(TCL_PUBLIC_HEADERS) ; do \ + @for i in $(TCL_PUBLIC_HEADERS); do \ $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \ done # Optional target to install private headers install-private-headers: - @for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)" ; do \ + @for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done @echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/"; - @for i in $(TCL_PRIVATE_HEADERS) ; do \ + @for i in $(TCL_PRIVATE_HEADERS); do \ $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ done - @if test -f tclConfig.h ; then \ + @if test -f tclConfig.h; then\ $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \ fi #-------------------------------------------------------------------------- # Rules for how to compile C files @@ -1117,11 +1220,11 @@ $(GENERIC_DIR)/regcustom.h TCLREHDRS = $(GENERIC_DIR)/tclRegexp.h COMPILEHDR = $(GENERIC_DIR)/tclCompile.h FSHDR = $(GENERIC_DIR)/tclFileSystem.h IOHDR = $(GENERIC_DIR)/tclIO.h -MATHHDRS = $(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h +MATHHDRS = $(GENERIC_DIR)/tclTomMath.h $(GENERIC_DIR)/tclTomMathDecls.h PARSEHDR = $(GENERIC_DIR)/tclParse.h NREHDR = $(GENERIC_DIR)/tclInt.h TRIMHDR = $(GENERIC_DIR)/tclStringTrim.h TCL_LOCATIONS = -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \ @@ -1454,18 +1557,18 @@ $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c tclTomMathInterface.o: $(GENERIC_DIR)/tclTomMathInterface.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTomMathInterface.c -bn_reverse.o: $(TOMMATH_DIR)/bn_reverse.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_reverse.c - -bn_fast_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c - -bn_fast_s_mp_sqr.o: $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c +bn_s_mp_reverse.o: $(TOMMATH_DIR)/bn_s_mp_reverse.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_reverse.c + +bn_s_mp_mul_digs_fast.o: $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c + +bn_s_mp_sqr_fast.o: $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c bn_mp_add.o: $(TOMMATH_DIR)/bn_mp_add.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add.c bn_mp_add_d.o: $(TOMMATH_DIR)/bn_mp_add_d.c $(MATHHDRS) @@ -1517,54 +1620,48 @@ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_3.c bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_exch.c -bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c - -bn_mp_expt_d_ex.o: $(TOMMATH_DIR)/bn_mp_expt_d_ex.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d_ex.c - -bn_s_mp_get_bit.o: $(TOMMATH_DIR)/bn_s_mp_get_bit.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_get_bit.c - -bn_mp_get_int.o: $(TOMMATH_DIR)/bn_mp_get_int.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_int.c - -bn_mp_get_long.o: $(TOMMATH_DIR)/bn_mp_get_long.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long.c - -bn_mp_get_long_long.o: $(TOMMATH_DIR)/bn_mp_get_long_long.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long_long.c +bn_mp_expt_u32.o: $(TOMMATH_DIR)/bn_mp_expt_u32.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_u32.c + +bn_mp_get_mag_u64.o: $(TOMMATH_DIR)/bn_mp_get_mag_u64.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_mag_u64.c bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_grow.c bn_mp_init.o: $(TOMMATH_DIR)/bn_mp_init.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init.c bn_mp_init_copy.o: $(TOMMATH_DIR)/bn_mp_init_copy.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_copy.c + +bn_mp_init_i64.o:$(TOMMATH_DIR)/bn_mp_init_i64.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_i64.c bn_mp_init_multi.o: $(TOMMATH_DIR)/bn_mp_init_multi.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_multi.c bn_mp_init_set.o: $(TOMMATH_DIR)/bn_mp_init_set.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set.c -bn_mp_init_set_int.o: $(TOMMATH_DIR)/bn_mp_init_set_int.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set_int.c - bn_mp_init_size.o:$(TOMMATH_DIR)/bn_mp_init_size.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_size.c -bn_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c +bn_mp_init_u64.o:$(TOMMATH_DIR)/bn_mp_init_u64.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_u64.c -bn_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c +bn_s_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c + +bn_s_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c + +bn_s_mp_balance_mul.o: $(TOMMATH_DIR)/bn_s_mp_balance_mul.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_balance_mul.c bn_mp_lshd.o: $(TOMMATH_DIR)/bn_mp_lshd.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_lshd.c bn_mp_mod.o: $(TOMMATH_DIR)/bn_mp_mod.c $(MATHHDRS) @@ -1601,21 +1698,15 @@ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_read_radix.c bn_mp_rshd.o: $(TOMMATH_DIR)/bn_mp_rshd.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_rshd.c -bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set.c - -bn_mp_set_int.o: $(TOMMATH_DIR)/bn_mp_set_int.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_int.c - -bn_mp_set_long.o: $(TOMMATH_DIR)/bn_mp_set_long.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_long.c - -bn_mp_set_long_long.o: $(TOMMATH_DIR)/bn_mp_set_long_long.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_long_long.c +bn_mp_set_i64.o: $(TOMMATH_DIR)/bn_mp_set_i64.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_i64.c + +bn_mp_set_u64.o: $(TOMMATH_DIR)/bn_mp_set_u64.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_u64.c bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_shrink.c bn_mp_sqr.o: $(TOMMATH_DIR)/bn_mp_sqr.c $(MATHHDRS) @@ -1631,27 +1722,24 @@ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c bn_mp_signed_rsh.o: $(TOMMATH_DIR)/bn_mp_signed_rsh.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_signed_rsh.c -bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c - -bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c - -bn_mp_toom_mul.o: $(TOMMATH_DIR)/bn_mp_toom_mul.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toom_mul.c - -bn_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_mp_toom_sqr.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toom_sqr.c - -bn_mp_toradix_n.o: $(TOMMATH_DIR)/bn_mp_toradix_n.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toradix_n.c - -bn_mp_unsigned_bin_size.o: $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c +bn_mp_to_ubin.o: $(TOMMATH_DIR)/bn_mp_to_ubin.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_ubin.c + +bn_s_mp_toom_mul.o: $(TOMMATH_DIR)/bn_s_mp_toom_mul.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_toom_mul.c + +bn_s_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c + +bn_mp_to_radix.o: $(TOMMATH_DIR)/bn_mp_to_radix.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_radix.c + +bn_mp_ubin_size.o: $(TOMMATH_DIR)/bn_mp_ubin_size.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_ubin_size.c bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_xor.c bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS) @@ -1891,11 +1979,11 @@ # cannot use absolute paths due to issues in nested configure when path to # build dir contains spaces). PKG_DIR = ./pkgs configure-packages: - @for i in $(PKGS_DIR)/* ; do \ + @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ if [ -x $$i/configure ] ; then \ pkg=`basename $$i`; \ echo "Configuring package '$$pkg'"; \ mkdir -p $(PKG_DIR)/$$pkg; \ @@ -1909,11 +1997,11 @@ fi; \ fi; \ done packages: configure-packages ${STUB_LIB_FILE} - @for i in $(PKGS_DIR)/* ; do \ + @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Building package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \ @@ -1920,11 +2008,11 @@ fi; \ fi; \ done install-packages: packages - @for i in $(PKGS_DIR)/* ; do \ + @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Installing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \ @@ -1932,11 +2020,11 @@ fi; \ fi; \ done test-packages: ${TCLTEST_EXE} packages - @for i in $(PKGS_DIR)/* ; do \ + @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Testing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) \ @@ -1947,21 +2035,21 @@ fi; \ fi; \ done clean-packages: - @for i in $(PKGS_DIR)/* ; do \ + @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \ fi; \ fi; \ done distclean-packages: - @for i in $(PKGS_DIR)/* ; do \ + @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \ fi; \ @@ -1971,11 +2059,11 @@ rm -rf $(PKG_DIR) dist-packages: configure-packages @rm -rf $(DISTROOT)/pkgs; \ mkdir -p $(DISTROOT)/pkgs; \ - for i in $(PKGS_DIR)/* ; do \ + for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \ "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \ @@ -2008,18 +2096,10 @@ # -e '/#define YYNEW/s/malloc/TclDateAlloc/g' \ # -e '/#define YYENLARGE/,/realloc/s/realloc/TclDateRealloc/g' \ # $(GENERIC_DIR)/tclDate.c # rm y.tab.c -# The following target generates the file generic/tclTomMath.h. It needs to be -# run (and the results checked) after updating to a new release of libtommath. - -gentommath_h: - $(NATIVE_TCLSH) "$(TOOL_DIR)/fix_tommath_h.tcl" \ - "$(TOMMATH_DIR)/tommath.h" \ - > "$(GENERIC_DIR)/tclTomMath.h" - # # Target to regenerate header files and stub files from the *.decls tables. # $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ @@ -2031,11 +2111,11 @@ $(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls @echo "Warning: tclOOStubInit.c may be out of date." @echo "Developers may want to run \"make genstubs\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" -$(GENERIC_DIR)/tclOOScript.h: $(GENERIC_DIR)/tclOOScript.tcl +$(GENERIC_DIR)/tclOOScript.h: $(TOOL_DIR)/tclOOScript.tcl @echo "Warning: tclOOScript.h may be out of date." @echo "Developers may want to run \"make genscript\" to regenerate." @echo "This warning can be safely ignored, do not report as a bug!" genstubs: @@ -2045,11 +2125,11 @@ $(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \ $(GENERIC_DIR)/tclOO.decls genscript: $(NATIVE_TCLSH) $(TOOL_DIR)/makeHeader.tcl \ - $(GENERIC_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h + $(TOOL_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h # # Target to check that all exported functions have an entry in the stubs # tables. # @@ -2057,11 +2137,11 @@ checkstubs: $(TCL_LIB_FILE) -@for i in `nm -p $(TCL_LIB_FILE) \ | awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \ | sort -n` ; do \ match=0; \ - for j in $(TCL_DECLS) ; do \ + for j in $(TCL_DECLS); do \ if [ `grep -c "$$i *(" $$j` -gt 0 ] ; then \ match=1; \ fi; \ done; \ if [ $$match -eq 0 ] ; then \ @@ -2074,19 +2154,19 @@ # have an entry in section three of the distributed manpages. # checkdoc: $(TCL_LIB_FILE) -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \ - | grep -Fv . | grep -v 'Cmd$$' | sort -n` ; do \ + | grep -Fv . | grep -v 'Cmd$$' | sort -n`; do \ match=0; \ i=`echo $$i | sed 's/^_//'`; \ - for j in $(TOP_DIR)/doc/*.3 ; do \ - if [ `grep '\-' $$j | grep -c $$i` -gt 0 ] ; then \ + for j in $(TOP_DIR)/doc/*.3; do \ + if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \ match=1; \ fi; \ done; \ - if [ $$match -eq 0 ] ; then \ + if [ $$match -eq 0 ]; then \ echo $$i; \ fi; \ done # @@ -2135,13 +2215,11 @@ DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) -DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 -DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 -BUILTIN_PACKAGE_LIST = http opt msgcat reg dde tcltest platform +BUILTIN_PACKAGE_LIST = cookiejar http opt msgcat reg dde tcltest platform $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \ $(UNIX_DIR)/aclocal.m4 cd $(UNIX_DIR); autoconf $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure @@ -2150,111 +2228,108 @@ cd $(MAC_OSX_DIR); autoheader; touch $@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in \ $(MAC_OSX_DIR)/configure genstubs dist-packages ${NATIVE_TCLSH} rm -rf $(DISTDIR) - $(INSTALL_DATA_DIR) $(DISTDIR)/unix - $(DIST_INSTALL_DATA) $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix - $(DIST_INSTALL_DATA) $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix - $(DIST_INSTALL_DATA) $(UNIX_DIR)/configure.ac \ + mkdir -p $(DISTDIR)/unix + cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix + cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix + chmod 664 $(DISTDIR)/unix/Makefile.in + cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.ac \ $(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \ $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \ $(UNIX_DIR)/install-sh \ - $(UNIX_DIR)/README $(UNIX_DIR)/tcl.spec \ + $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \ $(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \ $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix - $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix - $(INSTALL_DATA_DIR) $(DISTDIR)/generic - $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic - $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic - $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic - $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic - $(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ + chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.ac + chmod 775 $(DISTDIR)/unix/ldAix + @mkdir $(DISTDIR)/generic + cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic + cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic + cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic + cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic + cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) - $(INSTALL_DATA_DIR) $(DISTDIR)/library - $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ + @mkdir $(DISTDIR)/library + cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ + $(TOP_DIR)/library/manifest.txt \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library - @for i in $(BUILTIN_PACKAGE_LIST) ; do \ - $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\ - $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ + @for i in $(BUILTIN_PACKAGE_LIST); do \ + mkdir $(DISTDIR)/library/$$i;\ + cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done - $(INSTALL_DATA_DIR) $(DISTDIR)/library/encoding - $(DIST_INSTALL_DATA) $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding - $(INSTALL_DATA_DIR) $(DISTDIR)/library/msgs - $(DIST_INSTALL_DATA) $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs + cp -p $(TOP_DIR)/library/cookiejar/*.txt.gz $(DISTDIR)/library/cookiejar + @mkdir $(DISTDIR)/library/encoding + cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding + @mkdir $(DISTDIR)/library/msgs + cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata @( cd $(TOP_DIR); find library/tzdata -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) - $(INSTALL_DATA_DIR) $(DISTDIR)/doc - $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ + @mkdir $(DISTDIR)/doc + cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc - $(INSTALL_DATA_DIR) $(DISTDIR)/compat - $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ + @mkdir $(DISTDIR)/compat + cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat - $(INSTALL_DATA_DIR) $(DISTDIR)/compat/zlib + @mkdir $(DISTDIR)/compat/zlib @echo cp -r $(COMPAT_DIR)/zlib $(DISTDIR)/compat/zlib @( cd $(COMPAT_DIR)/zlib; find . -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) - $(INSTALL_DATA_DIR) $(DISTDIR)/tests - $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests - $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ + @mkdir $(DISTDIR)/tests + cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests + cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests - $(INSTALL_DATA_DIR) $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ + @mkdir $(DISTDIR)/win + cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win + cp $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \ $(TOP_DIR)/win/tclsh.exe.manifest.in \ $(DISTDIR)/win - $(DIST_INSTALL_SCRIPT) $(TOP_DIR)/win/configure $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ + cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.bat $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.vc $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/win/README $(DISTDIR)/win - $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/win - $(INSTALL_DATA_DIR) $(DISTDIR)/macosx - $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ + cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win + cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win + cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win + cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win + cp -p $(TOP_DIR)/win/README $(DISTDIR)/win + cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win + @mkdir $(DISTDIR)/macosx + cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ - $(DISTDIR)/macosx - $(DIST_INSTALL_SCRIPT) $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx - $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/macosx - $(INSTALL_DATA_DIR) $(DISTDIR)/macosx/Tcl.xcode - $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \ + $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx + cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx + @mkdir $(DISTDIR)/macosx/Tcl.xcode + cp -p $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcode - $(INSTALL_DATA_DIR) $(DISTDIR)/macosx/Tcl.xcodeproj - $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ + @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj + cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj - $(INSTALL_DATA_DIR) $(DISTDIR)/unix/dltest - $(DIST_INSTALL_DATA) $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ + @mkdir $(DISTDIR)/unix/dltest + cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest - $(INSTALL_DATA_DIR) $(DISTDIR)/tools - $(DIST_INSTALL_DATA) $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ + @mkdir $(DISTDIR)/tools + cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.ac \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \ $(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools - chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \ - $(DISTDIR)/tools/configure $(DISTDIR)/tools/findBadExternals.tcl \ - $(DISTDIR)/tools/fix_tommath_h.tcl $(DISTDIR)/tools/loadICU.tcl \ - $(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \ - $(DISTDIR)/tools/tcltk-man2html.tcl - $(INSTALL_DATA_DIR) $(DISTDIR)/libtommath - $(DIST_INSTALL_DATA) $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath - $(INSTALL_DATA_DIR) $(DISTDIR)/pkgs - $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs - $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs - for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null` ; do \ + @mkdir $(DISTDIR)/libtommath + cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath + @mkdir $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs + for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) @@ -2264,11 +2339,11 @@ zip -qr8 $(ZIPNAME) $(DISTNAME) ) #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & # tk8.* up two directories from the TOOL_DIR. # # Note that for platforms where this is important, it is more common to use a # build of this HTML documentation that has already been placed online. As # such, this rule is not guaranteed to work well on all systems; it only needs Index: unix/README ================================================================== --- unix/README +++ unix/README @@ -161,7 +161,7 @@ file in the "tests" directory for more information on the test suite. Note: don't run the tests as superuser: this will cause several of them to fail. If a test is failing consistently, please send us a bug report with as much detail as you can manage to our tracker: - http://core.tcl.tk/tcl/reportlist + https://core.tcl-lang.org/tcl/reportlist Index: unix/configure ================================================================== --- unix/configure +++ unix/configure @@ -1,8 +1,8 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for tcl 9.0. +# Generated by GNU Autoconf 2.69 for tcl 8.7. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # @@ -575,12 +575,12 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='9.0' -PACKAGE_STRING='tcl 9.0' +PACKAGE_VERSION='8.7' +PACKAGE_STRING='tcl 8.7' PACKAGE_BUGREPORT='' PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ @@ -703,10 +703,13 @@ DL_LIBS TCL_LIBS LIBOBJS AR RANLIB +TOMMATH_INCLUDE +TOMMATH_SRCS +TOMMATH_OBJS ZLIB_INCLUDE ZLIB_SRCS ZLIB_OBJS TCLSH_PROG SHARED_BUILD @@ -766,10 +769,11 @@ enable_man_symlinks enable_man_compression enable_man_suffix with_encoding enable_shared +with_system_libtommath enable_64bit enable_64bit_vis enable_rpath enable_corefoundation enable_load @@ -1328,11 +1332,11 @@ # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 9.0 to adapt to many kinds of systems. +\`configure' configures tcl 8.7 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. @@ -1389,11 +1393,11 @@ _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 9.0:";; + short | recursive ) echo "Configuration of tcl 8.7:";; esac cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options @@ -1425,10 +1429,13 @@ Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-encoding encoding for configuration values (default: iso8859-1) + --with-system-libtommath + use external libtommath (default: true if available, + false otherwise) --with-tzdata install timezone data (default: autodetect) Some influential environment variables: CC C compiler command CFLAGS C compiler flags @@ -1503,11 +1510,11 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tcl configure 9.0 +tcl configure 8.7 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. @@ -2025,11 +2032,11 @@ } # ac_fn_c_check_member cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 9.0, which was +It was created by tcl $as_me 8.7, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ _ACEOF @@ -2377,14 +2384,14 @@ -TCL_VERSION=9.0 -TCL_MAJOR_VERSION=9 -TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a0" +TCL_VERSION=8.7 +TCL_MAJOR_VERSION=8 +TCL_MINOR_VERSION=7 +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} @@ -3331,12 +3338,12 @@ #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: -# - stdlib.h doesn't define strtol, strtoul, or -# strtod insome versions of SunOS +# - stdlib.h doesn't define strtol or strtoul in some versions +# of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- @@ -3818,23 +3825,10 @@ _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP "strtoul" >/dev/null 2>&1; then : -else - tcl_ok=0 -fi -rm -f conftest* - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strtod" >/dev/null 2>&1; then : - else tcl_ok=0 fi rm -f conftest* @@ -4654,10 +4648,102 @@ fi $as_echo "#define HAVE_ZLIB 1" >>confdefs.h + +#------------------------------------------------------------------------ +# Add stuff for libtommath + +libtommath_ok=yes + +# Check whether --with-system-libtommath was given. +if test "${with_system_libtommath+set}" = set; then : + withval=$with_system_libtommath; libtommath_ok=${withval} +fi + +if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then + ac_fn_c_check_header_mongrel "$LINENO" "tommath.h" "ac_cv_header_tommath_h" "$ac_includes_default" +if test "x$ac_cv_header_tommath_h" = xyes; then : + + ac_fn_c_check_type "$LINENO" "mp_int" "ac_cv_type_mp_int" "#include +" +if test "x$ac_cv_type_mp_int" = xyes; then : + +else + libtommath_ok=no +fi + +else + + libtommath_ok=no +fi + + + if test $libtommath_ok = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mp_log_u32 in -ltommath" >&5 +$as_echo_n "checking for mp_log_u32 in -ltommath... " >&6; } +if ${ac_cv_lib_tommath_mp_log_u32+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ltommath $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char mp_log_u32 (); +int +main () +{ +return mp_log_u32 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_tommath_mp_log_u32=yes +else + ac_cv_lib_tommath_mp_log_u32=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tommath_mp_log_u32" >&5 +$as_echo "$ac_cv_lib_tommath_mp_log_u32" >&6; } +if test "x$ac_cv_lib_tommath_mp_log_u32" = xyes; then : + MATH_LIBS="$MATH_LIBS -ltommath" +else + + libtommath_ok=no +fi + +fi +fi +if test $libtommath_ok = yes; then : + + +$as_echo "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h + + +else + + TOMMATH_OBJS=\${TOMMATH_OBJS} + + TOMMATH_SRCS=\${TOMMATH_SRCS} + + TOMMATH_INCLUDE=-I\${TOMMATH_DIR} + + +fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -4868,10 +4954,13 @@ tcl_cv_sys_version=unknown else if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi + if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then + tcl_cv_sys_version=NetBSD-Debian + fi fi fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 @@ -4945,11 +5034,19 @@ TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g if test "$GCC" = yes; then : CFLAGS_OPTIMIZE=-O2 - CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith" + CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith" + case "${CC}" in + *++|*++-*) + ;; + *) + CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement" + ;; + esac + else CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" @@ -5212,21 +5309,21 @@ LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*) - SHLIB_CFLAGS="" + SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 - TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' + TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5 $as_echo_n "checking for Cygwin version of gcc... " >&6; } if ${ac_cv_cygwin+:} false; then : $as_echo_n "(cached) " >&6 @@ -5425,11 +5522,11 @@ # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 @@ -5515,11 +5612,11 @@ ;; esac if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi ;; IRIX-6.*) SHLIB_CFLAGS="" @@ -5533,11 +5630,11 @@ ;; esac if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then : CFLAGS="$CFLAGS -mabi=n32" @@ -5570,11 +5667,11 @@ ;; esac if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi # Check to enable 64-bit flags for compiler/linker @@ -5595,11 +5692,11 @@ fi fi ;; Linux*|GNU*|NetBSD-Debian) - SHLIB_CFLAGS="-fPIC" + SHLIB_CFLAGS="-fPIC -fno-common" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to @@ -5610,11 +5707,11 @@ DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "`uname -m`" = "alpha"; then : CFLAGS="$CFLAGS -mieee" fi @@ -5658,11 +5755,11 @@ fi fi # The combo of gcc + glibc has a bug related to inlining of - # functions like strtod(). The -fno-builtin flag should address + # functions like strtol()/strtoul(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. if test x"${USE_COMPAT}" != x; then : @@ -5677,12 +5774,12 @@ DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' + LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi ;; OpenBSD-*) arch=`arch -s` case "$arch" in @@ -5697,11 +5794,11 @@ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" CFLAGS_OPTIMIZE="-O2" @@ -5721,31 +5818,29 @@ DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ;; DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. - SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - LDFLAGS="" if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' + LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' fi # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" @@ -5941,10 +6036,11 @@ if test "$tcl_cv_cc_visibility_hidden" != yes; then : $as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h + tcl_cv_cc_visibility_hidden=yes fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" @@ -6092,11 +6188,11 @@ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" if test $doRpath = yes; then : - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' fi if test "$GCC" = yes; then : CFLAGS="$CFLAGS -mieee" else @@ -6119,11 +6215,10 @@ fi ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. - SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX @@ -6135,17 +6230,17 @@ # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. if test "$GCC" = yes; then : - SHLIB_CFLAGS="-fPIC -melf" - LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" + SHLIB_CFLAGS="-fPIC -melf" + LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" else - SHLIB_CFLAGS="-Kpic -belf" - LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" + SHLIB_CFLAGS="-Kpic -belf" + LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" @@ -6463,13 +6558,16 @@ case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*) ;; - IRIX*) ;; - NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + HP_UX*) ;; Darwin-*) ;; + IRIX*) ;; + Linux*|GNU*) ;; + NetBSD-*|OpenBSD-*) ;; + OSF1-V*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac fi @@ -6492,11 +6590,11 @@ DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then : LIB_SUFFIX=${SHARED_LIB_SUFFIX} - MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' + MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' if test "${SHLIB_SUFFIX}" = ".dll"; then : INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" @@ -6580,10 +6678,19 @@ if test "$tcl_cv_cast_to_union" = "yes"; then $as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi + + ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" +if test "x$ac_cv_header_stdbool_h" = xyes; then : + +$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h + +fi + + # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. @@ -6633,11 +6740,10 @@ else tcl_ok=no fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. - DBGX="" if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' $as_echo "#define NDEBUG 1" >>confdefs.h @@ -7937,11 +8043,34 @@ $as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h else - ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r" + + # Avoids picking hidden internal symbol from libc + ac_fn_c_check_decl "$LINENO" "gethostbyname_r" "ac_cv_have_decl_gethostbyname_r" "#include +" +if test "x$ac_cv_have_decl_gethostbyname_r" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl +_ACEOF +if test $ac_have_decl = 1; then : + + tcl_cv_api_gethostbyname_r=yes +else + tcl_cv_api_gethostbyname_r=no +fi + + + + if test "$tcl_cv_api_gethostbyname_r" = yes; then + ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r" if test "x$ac_cv_func_gethostbyname_r" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5 $as_echo_n "checking for gethostbyname_r with 6 args... " >&6; } if ${tcl_cv_api_gethostbyname_r_6+:} false; then : @@ -8074,11 +8203,36 @@ fi fi - ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r" + fi + + + # Avoids picking hidden internal symbol from libc + ac_fn_c_check_decl "$LINENO" "gethostbyaddr_r" "ac_cv_have_decl_gethostbyaddr_r" "#include +" +if test "x$ac_cv_have_decl_gethostbyaddr_r" = xyes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl +_ACEOF +if test $ac_have_decl = 1; then : + + tcl_cv_api_gethostbyaddr_r=yes +else + tcl_cv_api_gethostbyaddr_r=no +fi + + + + if test "$tcl_cv_api_gethostbyaddr_r" = yes; then + ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r" if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5 $as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; } if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then : @@ -8175,10 +8329,12 @@ $as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h fi fi + + fi fi #--------------------------------------------------------------------------- # Check for serial port interface. @@ -9787,10 +9943,13 @@ tcl_cv_sys_version=unknown else if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi + if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then + tcl_cv_sys_version=NetBSD-Debian + fi fi fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 @@ -9834,11 +9993,11 @@ $as_echo "$tcl_ok" >&6; } #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can -# be overriden on the configure command line either way. +# be overridden on the configure command line either way. #------------------------------------------------------------------------ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5 $as_echo_n "checking for timezone data... " >&6; } @@ -10211,11 +10370,11 @@ # since on some platforms TCL_LIB_FILE contains shell escapes. # (See also: TCL_TRIM_DOTS). eval "TCL_LIB_FILE=${TCL_LIB_FILE}" -TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' +test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because @@ -10262,11 +10421,11 @@ fi fi TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`" TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}' - echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xa000000' + echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" @@ -10300,11 +10459,11 @@ TCL_LIBRARY="${libdir}/Resources/Scripts" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl" EXTRA_INSTALL="install-private-headers html-tcl" - EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html' + EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)/TclTOC.html"' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we @@ -10336,17 +10495,17 @@ # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ - TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /System/Library/Frameworks" + TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ - TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl" + TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir} ${prefix}/lib ${TCL_PACKAGE_PATH}" + test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib} ${TCL_PACKAGE_PATH}" else - TCL_PACKAGE_PATH="${prefix}/lib ${TCL_PACKAGE_PATH}" + test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${prefix}/lib} ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl # stub support. @@ -10355,11 +10514,11 @@ # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" -eval "TCL_STUB_LIB_DIR=${libdir}" +eval "TCL_STUB_LIB_DIR=\"${libdir}\"" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" else TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" @@ -10968,11 +11127,11 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tcl $as_me 9.0, which was +This file was extended by tcl $as_me 8.7, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS @@ -11025,11 +11184,11 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -tcl config.status 9.0 +tcl config.status 8.7 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation Index: unix/configure.ac ================================================================== --- unix/configure.ac +++ unix/configure.ac @@ -1,11 +1,11 @@ #! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -AC_INIT([tcl],[9.0]) +AC_INIT([tcl],[8.7]) AC_PREREQ(2.69) dnl This is only used when included from macosx/configure.ac m4_ifdef([SC_USE_CONFIG_HEADERS], [ AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in]) @@ -20,14 +20,14 @@ /* override */ #undef PACKAGE_STRING /* override */ #undef PACKAGE_TARNAME #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=9.0 -TCL_MAJOR_VERSION=9 -TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a0" +TCL_VERSION=8.7 +TCL_MAJOR_VERSION=8 +TCL_MINOR_VERSION=7 +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} @@ -87,12 +87,12 @@ AC_C_INLINE #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: -# - stdlib.h doesn't define strtol, strtoul, or -# strtod insome versions of SunOS +# - stdlib.h doesn't define strtol or strtoul in some versions +# of SunOS # - some versions of string.h don't declare procedures such # as strstr # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- @@ -164,10 +164,34 @@ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}]) AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) + +#------------------------------------------------------------------------ +# Add stuff for libtommath + +libtommath_ok=yes +AC_ARG_WITH(system-libtommath, +AC_HELP_STRING([--with-system-libtommath], + [use external libtommath (default: true if available, false otherwise)]), + libtommath_ok=${withval}) +if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then + AC_CHECK_HEADER([tommath.h],[ + AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include ])],[ + libtommath_ok=no]) + AS_IF([test $libtommath_ok = yes], [ + AC_CHECK_LIB([tommath],[mp_log_u32],[MATH_LIBS="$MATH_LIBS -ltommath"],[ + libtommath_ok=no])]) +fi +AS_IF([test $libtommath_ok = yes], [ + AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath]) +], [ + AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) + AC_SUBST(TOMMATH_SRCS,[\${TOMMATH_SRCS}]) + AC_SUBST(TOMMATH_INCLUDE,[-I\${TOMMATH_DIR}]) +]) #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -675,11 +699,11 @@ AC_MSG_RESULT([$tcl_ok]) #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can -# be overriden on the configure command line either way. +# be overridden on the configure command line either way. #------------------------------------------------------------------------ AC_MSG_CHECKING([for timezone data]) AC_ARG_WITH(tzdata, AC_HELP_STRING([--with-tzdata], @@ -839,11 +863,11 @@ # since on some platforms TCL_LIB_FILE contains shell escapes. # (See also: TCL_TRIM_DOTS). eval "TCL_LIB_FILE=${TCL_LIB_FILE}" -TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' +test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)' PRIVATE_INCLUDE_DIR='$(includedir)' HTML_DIR='$(DISTDIR)/html' # Note: in the following variable, it's important to use the absolute # path name of the Tcl directory rather than "..": this is because @@ -852,11 +876,11 @@ if test "`uname -s`" = "Darwin" ; then SC_ENABLE_FRAMEWORK TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`" TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}' - echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xa000000' + echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' AC_CONFIG_FILES([Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in]) TCL_YEAR="`date +%Y`" @@ -892,11 +916,11 @@ TCL_LIBRARY="${libdir}/Resources/Scripts" includedir="${libdir}/Headers" PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders" HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl" EXTRA_INSTALL="install-private-headers html-tcl" - EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html' + EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)/TclTOC.html"' EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."' # Don't use AC_DEFINE for the following as the framework version define # needs to go into the Makefile even when using autoheader, so that we @@ -928,17 +952,17 @@ # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ - TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /System/Library/Frameworks" + TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ - TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl" + TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir} ${prefix}/lib ${TCL_PACKAGE_PATH}" + test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib} ${TCL_PACKAGE_PATH}" else - TCL_PACKAGE_PATH="${prefix}/lib ${TCL_PACKAGE_PATH}" + test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${prefix}/lib} ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- # The statements below define various symbols relating to Tcl # stub support. @@ -947,11 +971,11 @@ # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" -eval "TCL_STUB_LIB_DIR=${libdir}" +eval "TCL_STUB_LIB_DIR=\"${libdir}\"" if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" else TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" Index: unix/installManPage ================================================================== --- unix/installManPage +++ unix/installManPage @@ -41,11 +41,11 @@ Dir=$2 if test -f $ManPage ; then : ; else echo "source manual page file must exist" exit 1 fi -if test -d $Dir ; then : ; else +if test -d "$Dir" ; then : ; else echo "target directory must exist" exit 1 fi test -z "$SymOrLoc" && SymOrLoc="$Dir/" @@ -105,28 +105,36 @@ *.n) Section=n ;; *) echo "unknown section for $ManPage" exit 2 ;; esac +Name=`basename $ManPage .$Section` SrcDir=`dirname $ManPage` ######################################################################## ### Process Page to Create Target Pages ### + +Specials="DString Thread Notifier RegExp library packagens pkgMkIndex safesock" +for n in $Specials; do + if [ "$Name" = "$n" ] ; then + Names="$n $Names" + fi +done First="" for Target in $Names; do Target=$Target.$Section$Suffix - rm -f $Dir/$Target $Dir/$Target.* + rm -f "$Dir/$Target" "$Dir/$Target.*" if test -z "$First" ; then First=$Target sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \ - $ManPage > $Dir/$First - chmod 644 $Dir/$First - $Gzip $Dir/$First + $ManPage > "$Dir/$First" + chmod 644 "$Dir/$First" + $Gzip "$Dir/$First" else - ln $SymOrLoc$First$Gz $Dir/$Target$Gz + ln "$SymOrLoc$First$Gz" "$Dir/$Target$Gz" fi done ######################################################################## exit 0 Index: unix/tcl.m4 ================================================================== --- unix/tcl.m4 +++ unix/tcl.m4 @@ -75,11 +75,10 @@ # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ - `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tcl.framework/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" break fi @@ -92,14 +91,15 @@ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib/tcl8.7 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ - `ls -d /usr/local/lib/tcl9.0 2>/dev/null` \ - `ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.7 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" break fi @@ -208,11 +208,10 @@ # on Darwin, check in Framework installation locations if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ `ls -d /Library/Frameworks 2>/dev/null` \ `ls -d /Network/Library/Frameworks 2>/dev/null` \ - `ls -d /System/Library/Frameworks 2>/dev/null` \ ; do if test -f "$i/Tk.framework/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i/Tk.framework; pwd)`" break fi @@ -225,14 +224,15 @@ `ls -d ${exec_prefix}/lib 2>/dev/null` \ `ls -d ${prefix}/lib 2>/dev/null` \ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib/tk8.7 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ - `ls -d /usr/local/lib/tk9.0 2>/dev/null` \ - `ls -d /usr/local/lib/tcl/tk9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.7 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \ ; do if test -f "$i/tkConfig.sh" ; then ac_cv_c_tkconfig="`(cd $i; pwd)`" break fi @@ -291,14 +291,10 @@ . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi - # eval is required to do the TCL_DBGX substitution - eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" - eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" - # If the TCL_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TCL_LIB_SPEC will be set to the value # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an @@ -328,16 +324,10 @@ fi ;; esac fi - # eval is required to do the TCL_DBGX substitution - eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" - eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" - eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" - eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" - AC_SUBST(TCL_VERSION) AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) @@ -374,14 +364,10 @@ . "${TK_BIN_DIR}/tkConfig.sh" else AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi - # eval is required to do the TK_DBGX substitution - eval "TK_LIB_FILE=\"${TK_LIB_FILE}\"" - eval "TK_STUB_LIB_FILE=\"${TK_STUB_LIB_FILE}\"" - # If the TK_BIN_DIR is the build directory (not the install directory), # then set the common variable name to the value of the build variables. # For example, the variable TK_LIB_SPEC will be set to the value # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an @@ -411,16 +397,10 @@ fi ;; esac fi - # eval is required to do the TK_DBGX substitution - eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}\"" - eval "TK_LIB_SPEC=\"${TK_LIB_SPEC}\"" - eval "TK_STUB_LIB_FLAG=\"${TK_STUB_LIB_FLAG}\"" - eval "TK_STUB_LIB_SPEC=\"${TK_STUB_LIB_SPEC}\"" - AC_SUBST(TK_VERSION) AC_SUBST(TK_BIN_DIR) AC_SUBST(TK_SRC_DIR) AC_SUBST(TK_LIB_FILE) @@ -622,22 +602,19 @@ # Defines the following vars: # CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true # Sets to $(CFLAGS_OPTIMIZE) if false # LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true # Sets to $(LDFLAGS_OPTIMIZE) if false -# DBGX Formerly used as debug library extension; -# always blank now. #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AC_HELP_STRING([--enable-symbols], [build with debugging symbols (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. - DBGX="" if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)' AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?]) AC_MSG_RESULT([no]) @@ -812,10 +789,13 @@ tcl_cv_sys_version=unknown else if test "`uname -s`" = "AIX" ; then tcl_cv_sys_version=AIX-`uname -v`.`uname -r` fi + if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then + tcl_cv_sys_version=NetBSD-Debian + fi fi fi ]) system=$tcl_cv_sys_version ]) @@ -984,11 +964,19 @@ ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g AS_IF([test "$GCC" = yes], [ CFLAGS_OPTIMIZE=-O2 - CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith" + CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith" + case "${CC}" in + *++|*++-*) + ;; + *) + CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement" + ;; + esac + ], [ CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" ]) AC_CHECK_TOOL(AR, ar) @@ -1094,21 +1082,21 @@ LDFLAGS="$LDFLAGS -export-dynamic" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; CYGWIN_*) - SHLIB_CFLAGS="" + SHLIB_CFLAGS="-fno-common" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" DL_OBJS="tclLoadDl.o" PLAT_OBJS='${CYGWIN_OBJS}' PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" TCL_NEEDS_EXP_FILE=1 - TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a' + TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a' SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" AC_CACHE_CHECK(for Cygwin version of gcc, ac_cv_cygwin, AC_TRY_COMPILE([ #ifdef __CYGWIN__ @@ -1190,11 +1178,11 @@ hppa64*) # 64-bit gcc in use. Fix flags for GNU ld. do64bit_ok=yes SHLIB_LD='${CC} -shared' AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} ;; *) AC_MSG_WARN([64bit mode not supported with GCC on $system]) ;; @@ -1225,11 +1213,11 @@ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) ;; IRIX-6.*) SHLIB_CFLAGS="" SHLIB_LD="ld -n32 -shared -rdata_shared" @@ -1236,11 +1224,11 @@ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) AS_IF([test "$GCC" = yes], [ CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" ], [ @@ -1262,11 +1250,11 @@ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ @@ -1279,11 +1267,11 @@ LDFLAGS_ARCH="-64" ]) ]) ;; Linux*|GNU*|NetBSD-Debian) - SHLIB_CFLAGS="-fPIC" + SHLIB_CFLAGS="-fPIC -fno-common" SHLIB_SUFFIX=".so" CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to @@ -1293,11 +1281,11 @@ SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-ldl" LDFLAGS="$LDFLAGS -Wl,--export-dynamic" AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) AS_IF([test $do64bit = yes], [ AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ hold_cflags=$CFLAGS @@ -1309,11 +1297,11 @@ do64bit_ok=yes ]) ]) # The combo of gcc + glibc has a bug related to inlining of - # functions like strtod(). The -fno-builtin flag should address + # functions like strtol()/strtoul(). The -fno-builtin flag should address # this problem but it does not work. The -fno-inline flag is kind # of overkill but it works. Disable inlining only when one of the # files in compat/*.c is being linked in. AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) @@ -1325,12 +1313,12 @@ SHLIB_LD='${CC} -shared' DL_OBJS="tclLoadDl.o" DL_LIBS="-mshared -ldl" LD_FLAGS="-Wl,--export-dynamic" AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' + LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) ;; OpenBSD-*) arch=`arch -s` case "$arch" in alpha|sparc64) @@ -1343,11 +1331,11 @@ SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' LDFLAGS="-Wl,-export-dynamic" CFLAGS_OPTIMIZE="-O2" # On OpenBSD: Compile with -pthread @@ -1365,29 +1353,27 @@ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="$LDFLAGS -export-dynamic" AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} # The -pthread needs to go in the CFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ;; DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. - SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" - LDFLAGS="" AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' + LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS" case $system in @@ -1471,10 +1457,11 @@ LDFLAGS="$LDFLAGS -Wl,-search_paths_first" ]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [__private_extern__], [Compiler support for module scope symbols]) + tcl_cv_cc_visibility_hidden=yes ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?]) @@ -1550,11 +1537,11 @@ ]) SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [ CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"]) # see pthread_intro(3) for pthread support on osf1, k.furukawa CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" @@ -1568,11 +1555,10 @@ ]) ;; QNX-6*) # QNX RTP # This may work for all QNX, but it was only reported for v6. - SHLIB_CFLAGS="-fPIC" SHLIB_LD="ld -Bshareable -x" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" # dlopen is in -lc on QNX @@ -1583,15 +1569,15 @@ SCO_SV-3.2*) # Note, dlopen is available only on SCO 3.2.5 and greater. However, # this test works, since "uname -s" was non-standard in 3.2.4 and # below. AS_IF([test "$GCC" = yes], [ - SHLIB_CFLAGS="-fPIC -melf" - LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" + SHLIB_CFLAGS="-fPIC -melf" + LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" ], [ - SHLIB_CFLAGS="-Kpic -belf" - LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" + SHLIB_CFLAGS="-Kpic -belf" + LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" ]) SHLIB_LD="ld -G" SHLIB_LD_LIBS="" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -1796,13 +1782,16 @@ AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [ case $system in AIX-*) ;; BSD/OS*) ;; CYGWIN_*) ;; - IRIX*) ;; - NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + HP_UX*) ;; Darwin-*) ;; + IRIX*) ;; + Linux*|GNU*) ;; + NetBSD-*|OpenBSD-*) ;; + OSF1-V*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; esac]) AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ @@ -1816,11 +1805,11 @@ UNSHARED_LIB_SUFFIX='${VERSION}.a']) DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)" AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [ LIB_SUFFIX=${SHARED_LIB_SUFFIX} - MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' + MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}' AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" ], [ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' @@ -1868,10 +1857,12 @@ if test "$tcl_cv_cast_to_union" = "yes"; then AC_DEFINE(HAVE_CAST_TO_UNION, 1, [Defined when compiler supports casting to union type.]) fi + AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have ?])],) + # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. AC_SUBST(DL_LIBS) @@ -1911,12 +1902,12 @@ #-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special # notes: -# - stdlib.h doesn't define strtol, strtoul, or -# strtod insome versions of SunOS +# - stdlib.h doesn't define strtol or strtoul in some +# versions of SunOS # - some versions of string.h don't declare procedures such # as strstr # # Arguments: # none @@ -1928,11 +1919,10 @@ # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H # NO_DLFCN_H # HAVE_SYS_PARAM_H -# # HAVE_STRING_H ? # #-------------------------------------------------------------------- AC_DEFUN([SC_MISSING_POSIX_HEADERS], [ @@ -1963,11 +1953,10 @@ fi AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) - AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0) if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H, 1, [Do we have ?]) fi AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0) @@ -2517,11 +2506,24 @@ # HAVE_GETHOSTBYADDR_R_7 # HAVE_GETHOSTBYADDR_R_8 # #-------------------------------------------------------------------- -AC_DEFUN([SC_TCL_GETHOSTBYADDR_R], [AC_CHECK_FUNC(gethostbyaddr_r, [ +AC_DEFUN([SC_TCL_GETHOSTBYADDR_R], [ + # Avoids picking hidden internal symbol from libc + SC_TCL_GETHOSTBYADDR_R_DECL + + if test "$tcl_cv_api_gethostbyaddr_r" = yes; then + SC_TCL_GETHOSTBYADDR_R_TYPE + fi +]) + +AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_DECL], [AC_CHECK_DECLS(gethostbyaddr_r, [ + tcl_cv_api_gethostbyaddr_r=yes],[tcl_cv_api_gethostbyaddr_r=no],[#include ]) +]) + +AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_TYPE], [AC_CHECK_FUNC(gethostbyaddr_r, [ AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [ AC_TRY_COMPILE([ #include ], [ char *addr; @@ -2578,18 +2580,31 @@ # None # # Results: # # Might define the following vars: -# HAVE_GETHOSTBYADDR_R -# HAVE_GETHOSTBYADDR_R_3 -# HAVE_GETHOSTBYADDR_R_5 -# HAVE_GETHOSTBYADDR_R_6 +# HAVE_GETHOSTBYNAME_R +# HAVE_GETHOSTBYNAME_R_3 +# HAVE_GETHOSTBYNAME_R_5 +# HAVE_GETHOSTBYNAME_R_6 # #-------------------------------------------------------------------- -AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [AC_CHECK_FUNC(gethostbyname_r, [ +AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [ + # Avoids picking hidden internal symbol from libc + SC_TCL_GETHOSTBYNAME_R_DECL + + if test "$tcl_cv_api_gethostbyname_r" = yes; then + SC_TCL_GETHOSTBYNAME_R_TYPE + fi +]) + +AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_DECL], [AC_CHECK_DECLS(gethostbyname_r, [ + tcl_cv_api_gethostbyname_r=yes],[tcl_cv_api_gethostbyname_r=no],[#include ]) +]) + +AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_TYPE], [AC_CHECK_FUNC(gethostbyname_r, [ AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [ AC_TRY_COMPILE([ #include ], [ char *name; Index: unix/tcl.pc.in ================================================================== --- unix/tcl.pc.in +++ unix/tcl.pc.in @@ -9,9 +9,9 @@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. URL: http://www.tcl.tk/ Version: @TCL_VERSION@@TCL_PATCH_LEVEL@ -Requires.private: zlib >= 1.2.3 +Requires.private: zlib >= 1.2.3, libtommath >= 1.2.0 Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@ Libs.private: @TCL_LIBS@ Cflags: -I${includedir} Index: unix/tcl.spec ================================================================== --- unix/tcl.spec +++ unix/tcl.spec @@ -2,11 +2,11 @@ %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment -Version: 9.0a0 +Version: 8.7a3 Release: 2 License: BSD Group: Development/Languages Source: http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz URL: http://www.tcl.tk/ Index: unix/tclConfig.h.in ================================================================== --- unix/tclConfig.h.in +++ unix/tclConfig.h.in @@ -13,10 +13,13 @@ /* Define to 1 if the system has the type `blkcnt_t'. */ #undef HAVE_BLKCNT_T /* Defined when compiler supports casting to union type. */ #undef HAVE_CAST_TO_UNION + +/* Define to 1 if you have the `cfmakeraw' function. */ +#undef HAVE_CFMAKERAW /* Define to 1 if you have the `chflags' function. */ #undef HAVE_CHFLAGS /* Define to 1 if you have the `copyfile' function. */ @@ -29,12 +32,27 @@ #undef HAVE_COREFOUNDATION /* Is the cpuid instruction usable? */ #undef HAVE_CPUID +/* Define to 1 if you have the declaration of `gethostbyaddr_r', and to 0 if + you don't. */ +#undef HAVE_DECL_GETHOSTBYADDR_R + +/* Define to 1 if you have the declaration of `gethostbyname_r', and to 0 if + you don't. */ +#undef HAVE_DECL_GETHOSTBYNAME_R + +/* Define to 1 if you have the declaration of `PTHREAD_MUTEX_RECURSIVE', and + to 0 if you don't. */ +#undef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE + /* Is 'DIR64' in ? */ #undef HAVE_DIR64 + +/* Is eventfd(2) supported? */ +#undef HAVE_EVENTFD /* Define to 1 if you have the `freeaddrinfo' function. */ #undef HAVE_FREEADDRINFO /* Do we have fts functions? */ @@ -175,10 +193,13 @@ /* Does putenv() copy strings or incorporate them by reference? */ #undef HAVE_PUTENV_THAT_COPIES /* Are characters signed? */ #undef HAVE_SIGNED_CHAR + +/* Do we have ? */ +#undef HAVE_STDBOOL_H /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H /* Define to 1 if you have the header file. */ @@ -214,10 +235,19 @@ /* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE /* Define to 1 if `st_blocks' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLOCKS + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_EPOLL_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_EVENTFD_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_EVENT_H /* Define to 1 if you have the header file. */ #undef HAVE_SYS_FILIO_H /* Define to 1 if you have the header file. */ @@ -275,18 +305,21 @@ #undef MAC_OSX_TCL /* No Compiler support for module scope symbols */ #undef MODULE_SCOPE -/* Default libtommath precision. */ -#undef MP_PREC - /* Is no debugging enabled? */ #undef NDEBUG /* Use compat implementation of getaddrinfo() and friends */ #undef NEED_FAKE_RFC2553 + +/* Is epoll(7) supported? */ +#undef NOTIFIER_EPOLL + +/* Is kqueue(2) supported? */ +#undef NOTIFIER_KQUEUE /* Is Darwin CoreFoundation unavailable for 64-bit? */ #undef NO_COREFOUNDATION_64 /* Do we have ? */ @@ -392,11 +425,11 @@ #undef TCL_UNLOAD_DLLS /* Does this platform have wide high-resolution clicks? */ #undef TCL_WIDE_CLICKS -/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */ +/* Do 'long' and 'long long' have the same size (64-bit)? */ #undef TCL_WIDE_INT_IS_LONG /* What type should be used to define wide integers? */ #undef TCL_WIDE_INT_TYPE @@ -413,19 +446,19 @@ #undef USE_DTRACE /* Should we use FIONBIO? */ #undef USE_FIONBIO -/* Do we want to use the threaded memory allocator? */ -#undef USE_THREAD_ALLOC - /* Should we use vfork() instead of fork()? */ #undef USE_VFORK /* Define to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ #undef WORDS_BIGENDIAN + +/* Are we building with zipfs enabled? */ +#undef ZIPFS_BUILD /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE /* Add the _ISOC99_SOURCE flag when building */ Index: unix/tclEpollNotfy.c ================================================================== --- unix/tclEpollNotfy.c +++ unix/tclEpollNotfy.c @@ -14,11 +14,13 @@ #include "tclInt.h" #ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is * in tclMacOSXNotify.c */ #if defined(NOTIFIER_EPOLL) && TCL_THREADS -#define _GNU_SOURCE /* For pipe2(2) */ +#ifndef _GNU_SOURCE +# define _GNU_SOURCE /* For pipe2(2) */ +#endif #include #include #include #ifdef HAVE_EVENTFD #include @@ -179,11 +181,11 @@ *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( - ClientData clientData) /* Not used. */ + ClientData clientData) { if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); return; } else { @@ -236,11 +238,11 @@ } if (filePtr->mask & TCL_WRITABLE) { newEvent.events |= EPOLLOUT; } if (isNew) { - newPedPtr = Tcl_Alloc(sizeof(*newPedPtr)); + newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; } newEvent.data.ptr = filePtr->pedPtr; @@ -316,18 +318,18 @@ if (tsdPtr->triggerPipe[1]) { close(tsdPtr->triggerPipe[1]); tsdPtr->triggerPipe[1] = -1; } #endif /* HAVE_EVENTFD */ - Tcl_Free(tsdPtr->triggerFilePtr->pedPtr); - Tcl_Free(tsdPtr->triggerFilePtr); + ckfree(tsdPtr->triggerFilePtr->pedPtr); + ckfree(tsdPtr->triggerFilePtr); if (tsdPtr->eventsFd > 0) { close(tsdPtr->eventsFd); tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - Tcl_Free(tsdPtr->readyEvents); + ckfree(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) { Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno)); @@ -368,11 +370,11 @@ errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL); if (errno) { Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex"); } - filePtr = Tcl_Alloc(sizeof(*filePtr)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); #ifdef HAVE_EVENTFD tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK); if (tsdPtr->triggerEventFd <= 0) { Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd"); } @@ -389,11 +391,11 @@ } filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = Tcl_Alloc( + tsdPtr->readyEvents = (struct epoll_event *)ckalloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); } @@ -548,11 +550,11 @@ if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { - filePtr = Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; isNew = 1; @@ -618,11 +620,11 @@ * Update the check masks for this file. */ PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0); if (filePtr->pedPtr) { - Tcl_Free(filePtr->pedPtr); + ckfree(filePtr->pedPtr); } /* * Clean up information in the callback record. */ @@ -630,11 +632,11 @@ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } - Tcl_Free(filePtr); + ckfree(filePtr); } } /* *---------------------------------------------------------------------- @@ -731,12 +733,12 @@ * Don't bother to queue an event if the mask was previously * non-zero since an event must still be on the queue. */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = - Tcl_Alloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); numQueued++; @@ -770,11 +772,11 @@ */ numFound = PlatformEventsWait(tsdPtr->readyEvents, tsdPtr->maxReadyEvents, timeoutPtr); for (numEvent = 0; numEvent < numFound; numEvent++) { - pedPtr = tsdPtr->readyEvents[numEvent].data.ptr; + pedPtr = (struct PlatformEventData*)tsdPtr->readyEvents[numEvent].data.ptr; filePtr = pedPtr->filePtr; mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]); #ifdef HAVE_EVENTFD if (filePtr->fd == tsdPtr->triggerEventFd) { uint64_t eventFdVal; @@ -808,12 +810,12 @@ * Don't bother to queue an event if the mask was previously * non-zero since an event must still be on the queue. */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = - Tcl_Alloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } Index: unix/tclKqueueNotfy.c ================================================================== --- unix/tclKqueueNotfy.c +++ unix/tclKqueueNotfy.c @@ -167,11 +167,11 @@ *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( - ClientData clientData) /* Not used. */ + ClientData clientData) { if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); return; } else { @@ -220,11 +220,11 @@ struct kevent changeList[2]; struct PlatformEventData *newPedPtr; struct stat fdStat; if (isNew) { - newPedPtr = Tcl_Alloc(sizeof(*newPedPtr)); + newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; } @@ -342,11 +342,11 @@ if (tsdPtr->eventsFd > 0) { close(tsdPtr->eventsFd); tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - Tcl_Free(tsdPtr->readyEvents); + ckfree(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) { Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno)); @@ -407,17 +407,17 @@ if ((tsdPtr->eventsFd = kqueue()) == -1) { Tcl_Panic("kqueue: %s", strerror(errno)); } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) { Tcl_Panic("fcntl: %s", strerror(errno)); } - filePtr = Tcl_Alloc(sizeof(*filePtr)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = tsdPtr->triggerPipe[0]; filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = Tcl_Alloc( + tsdPtr->readyEvents = (struct kevent *)ckalloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); } @@ -578,11 +578,11 @@ if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { - filePtr = Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; isNew = 1; @@ -647,11 +647,11 @@ * Update the check masks for this file. */ PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0); if (filePtr->pedPtr) { - Tcl_Free(filePtr->pedPtr); + ckfree(filePtr->pedPtr); } /* * Clean up information in the callback record. */ @@ -659,11 +659,11 @@ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } - Tcl_Free(filePtr); + ckfree(filePtr); } } /* *---------------------------------------------------------------------- @@ -766,12 +766,12 @@ * Don't bother to queue an event if the mask was previously * non-zero since an event must still be on the queue. */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = - Tcl_Alloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); numQueued++; @@ -826,12 +826,12 @@ * Don't bother to queue an event if the mask was previously * non-zero since an event must still be on the queue. */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = - Tcl_Alloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) + ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } Index: unix/tclLoadAix.c ================================================================== --- unix/tclLoadAix.c +++ unix/tclLoadAix.c @@ -96,11 +96,11 @@ void * dlopen( const char *path, int mode) { - register ModulePtr mp; + ModulePtr mp; static void *mainModule; /* * Upon the first call register a terminate handler that will close all * libraries. Also get a reference to the main module for use with @@ -189,11 +189,11 @@ * If the user wants global binding, loadbind against all other loaded * modules. */ if (mode & RTLD_GLOBAL) { - register ModulePtr mp1; + ModulePtr mp1; for (mp1 = mp->next; mp1; mp1 = mp1->next) { if (loadbind(0, mp1->entry, mp->entry) == -1) { goto loadbindFailure; } @@ -241,11 +241,11 @@ static void caterr( char *s) { - register char *p = s; + char *p = s; while (*p >= '0' && *p <= '9') { p++; } switch (atoi(s)) { /* INTL: "C", UTF safe. */ @@ -280,13 +280,13 @@ void * dlsym( void *handle, const char *symbol) { - register ModulePtr mp = (ModulePtr)handle; - register ExportPtr ep; - register int i; + ModulePtr mp = (ModulePtr)handle; + ExportPtr ep; + int i; /* * Could speed up the search, but I assume that one assigns the result to * function pointers anyways. */ @@ -315,13 +315,13 @@ int dlclose( void *handle) { - register ModulePtr mp = (ModulePtr)handle; + ModulePtr mp = (ModulePtr)handle; int result; - register ModulePtr mp1; + ModulePtr mp1; if (--mp->refCnt > 0) { return 0; } @@ -341,12 +341,12 @@ errvalid++; strcpy(errbuf, strerror(errno)); } if (mp->exports) { - register ExportPtr ep; - register int i; + ExportPtr ep; + int i; for (ep = mp->exports, i = mp->nExports; i; i--, ep++) { if (ep->name) { free(ep->name); } } Index: unix/tclLoadDl.c ================================================================== --- unix/tclLoadDl.c +++ unix/tclLoadDl.c @@ -81,11 +81,11 @@ * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ - native = Tcl_FSGetNativePath(pathPtr); + native = (const char *)Tcl_FSGetNativePath(pathPtr); /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ if (flags & TCL_LOAD_GLOBAL) { dlopenflags |= RTLD_GLOBAL; @@ -104,11 +104,11 @@ * string the user gave us which hopefully refers to a file on the * binary path. */ Tcl_DString ds; - const char *fileName = TclGetString(pathPtr); + const char *fileName = Tcl_GetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ @@ -125,15 +125,15 @@ const char *errorStr = dlerror(); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", - TclGetString(pathPtr), errorStr)); + Tcl_GetString(pathPtr), errorStr)); } return TCL_ERROR; } - newHandle = Tcl_Alloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *unloadProcPtr = &UnloadFile; *loadHandle = newHandle; @@ -186,10 +186,35 @@ TclDStringAppendLiteral(&newName, "_"); native = Tcl_DStringAppend(&newName, native, -1); proc = dlsym(handle, native); /* INTL: Native. */ Tcl_DStringFree(&newName); } +#ifdef __cplusplus + if (proc == NULL) { + char buf[32]; + sprintf(buf, "%d", Tcl_DStringLength(&ds)); + Tcl_DStringInit(&newName); + TclDStringAppendLiteral(&newName, "__Z"); + Tcl_DStringAppend(&newName, buf, -1); + Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), -1); + TclDStringAppendLiteral(&newName, "P10Tcl_Interp"); + native = Tcl_DStringValue(&newName); + proc = dlsym(handle, native + 1); /* INTL: Native. */ + if (proc == NULL) { + proc = dlsym(handle, native); /* INTL: Native. */ + } + if (proc == NULL) { + TclDStringAppendLiteral(&newName, "i"); + native = Tcl_DStringValue(&newName); + proc = dlsym(handle, native + 1); /* INTL: Native. */ + } + if (proc == NULL) { + proc = dlsym(handle, native); /* INTL: Native. */ + } + Tcl_DStringFree(&newName); + } +#endif Tcl_DStringFree(&ds); if (proc == NULL) { const char *errorStr = dlerror(); if (interp) { @@ -208,19 +233,18 @@ /* *---------------------------------------------------------------------- * * UnloadFile -- * - * Unloads a dynamically loaded binary code file from memory. Code - * pointers in the formerly loaded file are no longer valid after calling - * this function. + * Unloads a dynamic shared object, after which all pointers to functions + * in the formerly-loaded object are no longer valid. * * Results: * None. * * Side effects: - * Code removed from memory. + * Memory for the loaded object is deallocated. * *---------------------------------------------------------------------- */ static void @@ -230,11 +254,11 @@ * that represents the loaded file. */ { void *handle = loadHandle->clientData; dlclose(handle); - Tcl_Free(loadHandle); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * @@ -255,14 +279,12 @@ *---------------------------------------------------------------------- */ int TclGuessPackageName( - const char *fileName, /* Name of file containing package (already - * translated to local form if needed). */ - Tcl_DString *bufPtr) /* Initialized empty dstring. Append package - * name to this if possible. */ + TCL_UNUSED(const char *) /*fileName*/, + TCL_UNUSED(Tcl_DString *)) { return 0; } /* Index: unix/tclLoadDyld.c ================================================================== --- unix/tclLoadDyld.c +++ unix/tclLoadDyld.c @@ -181,12 +181,12 @@ * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ - nativePath = Tcl_FSGetNativePath(pathPtr); - nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr), + nativePath = (const char *)Tcl_FSGetNativePath(pathPtr); + nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1, &ds); #if TCL_DYLD_USE_DLFCN /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] @@ -256,11 +256,11 @@ if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { - modulePtr = Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; } else { NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); @@ -276,17 +276,17 @@ if (dlHandle #if TCL_DYLD_USE_NSMODULE || dyldLibHeader || modulePtr #endif /* TCL_DYLD_USE_NSMODULE */ ) { - dyldLoadHandle = Tcl_Alloc(sizeof(Tcl_DyldLoadHandle)); + dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = dlHandle; #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) dyldLoadHandle->dyldLibHeader = dyldLibHeader; dyldLoadHandle->modulePtr = modulePtr; #endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */ - newHandle = Tcl_Alloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *unloadProcPtr = &UnloadFile; *loadHandle = newHandle; @@ -332,20 +332,20 @@ FindSymbol( Tcl_Interp *interp, /* For error reporting. */ Tcl_LoadHandle loadHandle, /* Handle from TclpDlopen. */ const char *symbol) /* Symbol name to look up. */ { - Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData; + Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData; Tcl_PackageInitProc *proc = NULL; const char *errMsg = NULL; Tcl_DString ds; const char *native; native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); if (dyldLoadHandle->dlHandle) { #if TCL_DYLD_USE_DLFCN - proc = dlsym(dyldLoadHandle->dlHandle, native); + proc = (Tcl_PackageInitProc *)dlsym(dyldLoadHandle->dlHandle, native); if (!proc) { errMsg = dlerror(); } #endif /* TCL_DYLD_USE_DLFCN */ } else { @@ -379,11 +379,11 @@ break; } modulePtr = modulePtr->nextPtr; } if (modulePtr == NULL) { - modulePtr = Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = dyldLoadHandle->modulePtr; dyldLoadHandle->modulePtr = modulePtr; } #endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */ @@ -397,11 +397,11 @@ } else if (dyldLoadHandle->modulePtr) { nsSymbol = NSLookupSymbolInModule( dyldLoadHandle->modulePtr->module, native); } if (nsSymbol) { - proc = NSAddressOfSymbol(nsSymbol); + proc = (Tcl_PackageInitProc *)NSAddressOfSymbol(nsSymbol); } Tcl_DStringFree(&newName); #endif /* TCL_DYLD_USE_NSMODULE */ } Tcl_DStringFree(&ds); @@ -409,11 +409,11 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\": %s", symbol, errMsg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } - return proc; + return (void *)proc; } /* *---------------------------------------------------------------------- * @@ -438,11 +438,11 @@ UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData; + Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData; if (dyldLoadHandle->dlHandle) { #if TCL_DYLD_USE_DLFCN (void) dlclose(dyldLoadHandle->dlHandle); #endif /* TCL_DYLD_USE_DLFCN */ @@ -454,16 +454,16 @@ void *ptr = modulePtr; (void) NSUnLinkModule(modulePtr->module, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); modulePtr = modulePtr->nextPtr; - Tcl_Free(ptr); + ckfree(ptr); } #endif /* TCL_DYLD_USE_NSMODULE */ } - Tcl_Free(dyldLoadHandle); - Tcl_Free(loadHandle); + ckfree(dyldLoadHandle); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * @@ -484,14 +484,12 @@ *---------------------------------------------------------------------- */ int TclGuessPackageName( - const char *fileName, /* Name of file containing package (already - * translated to local form if needed). */ - Tcl_DString *bufPtr) /* Initialized empty dstring. Append package - * name to this if possible. */ + TCL_UNUSED(const char *) /*fileName*/, + TCL_UNUSED(Tcl_DString *) /*bufPtr*/) { return 0; } /* @@ -511,11 +509,11 @@ */ #ifdef TCL_LOAD_FROM_MEMORY MODULE_SCOPE void * TclpLoadMemoryGetBuffer( - Tcl_Interp *interp, /* Used for error reporting. */ + TCL_UNUSED(Tcl_Interp *), int size) /* Size of desired buffer. */ { void *buffer = NULL; /* @@ -586,11 +584,11 @@ * Try to create an object file image that we can load from. */ if (codeSize >= 0) { NSObjectFileImageReturnCode err = NSObjectFileImageSuccess; - const struct fat_header *fh = buffer; + const struct fat_header *fh = (const struct fat_header *)buffer; uint32_t ms = 0; #ifndef __LP64__ const struct mach_header *mh = NULL; # define mh_size sizeof(struct mach_header) # define mh_magic MH_MAGIC @@ -615,32 +613,32 @@ void *fatarchs = (char*)buffer + sizeof(struct fat_header); const NXArchInfo *arch = NXGetLocalArchInfo(); struct fat_arch *fa; if (fh->magic != FAT_MAGIC) { - swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); + swap_fat_arch((struct fat_arch *)fatarchs, fh_nfat_arch, arch->byteorder); } fa = NXFindBestFatArch(arch->cputype | arch_abi, - arch->cpusubtype, fatarchs, fh_nfat_arch); + arch->cpusubtype, (struct fat_arch *)fatarchs, fh_nfat_arch); if (fa) { - mh = (void *)((char *) buffer + fa->offset); + mh = (const struct mach_header_64 *)((char *) buffer + fa->offset); ms = fa->size; } else { err = NSObjectFileImageInappropriateFile; } if (fh->magic != FAT_MAGIC) { - swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); + swap_fat_arch((struct fat_arch *)fatarchs, fh_nfat_arch, arch->byteorder); } } else { err = NSObjectFileImageInappropriateFile; } } else { /* * Thin binary */ - mh = buffer; + mh = (const struct mach_header_64 *)buffer; ms = codeSize; } if (ms && !(ms >= mh_size && mh->magic == mh_magic && mh->filetype == MH_BUNDLE)) { err = NSObjectFileImageInappropriateFile; @@ -691,18 +689,18 @@ /* * Stash the module reference within the load handle we create and return. */ - modulePtr = Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; - dyldLoadHandle = Tcl_Alloc(sizeof(Tcl_DyldLoadHandle)); + dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = NULL; dyldLoadHandle->dyldLibHeader = NULL; dyldLoadHandle->modulePtr = modulePtr; - newHandle = Tcl_Alloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *loadHandle = newHandle; *unloadProcPtr = &UnloadFile; Index: unix/tclLoadNext.c ================================================================== --- unix/tclLoadNext.c +++ unix/tclLoadNext.c @@ -59,11 +59,11 @@ const char *native; int result = 1; NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); - fileName = TclGetString(pathPtr); + fileName = Tcl_GetString(pathPtr); /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. @@ -99,11 +99,11 @@ NXCloseMemory(errorStream, NX_FREEBUFFER); return TCL_ERROR; } NXCloseMemory(errorStream, NX_FREEBUFFER); - newHandle = Tcl_Alloc(sizeof(Tcl_LoadHandle)); + newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle)); newHandle->clientData = INT2PTR(1); newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *loadHandle = newHandle; *unloadProcPtr = &UnloadFile; @@ -173,11 +173,11 @@ UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - Tcl_Free(loadHandle); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * Index: unix/tclLoadOSF.c ================================================================== --- unix/tclLoadOSF.c +++ unix/tclLoadOSF.c @@ -77,11 +77,11 @@ int flags) { Tcl_LoadHandle newHandle; ldr_module_t lm; char *pkg; - char *fileName = TclGetString(pathPtr); + char *fileName = Tcl_GetString(pathPtr); const char *native; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a @@ -126,11 +126,11 @@ if ((pkg = strrchr(fileName, '/')) == NULL) { pkg = fileName; } else { pkg++; } - newHandle = Tcl_Alloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); newHandle->clientData = pkg; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; *loadHandle = newHandle; *unloadProcPtr = &UnloadFile; @@ -191,11 +191,11 @@ UnloadFile( Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - Tcl_Free(loadHandle); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * Index: unix/tclLoadShl.c ================================================================== --- unix/tclLoadShl.c +++ unix/tclLoadShl.c @@ -55,11 +55,11 @@ int flags) { shl_t handle; Tcl_LoadHandle newHandle; const char *native; - char *fileName = TclGetString(pathPtr); + char *fileName = Tcl_GetString(pathPtr); /* * The flags below used to be BIND_IMMEDIATE; they were changed at the * suggestion of Wolfgang Kechel (wolfgang@prs.de): "This enables * verbosity for missing symbols when loading a shared lib and allows to @@ -95,11 +95,11 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", fileName, Tcl_PosixError(interp))); return TCL_ERROR; } - newHandle = Tcl_Alloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile; *loadHandle = newHandle; return TCL_OK; @@ -180,11 +180,11 @@ * that represents the loaded file. */ { shl_t handle = (shl_t) loadHandle->clientData; shl_unload(handle); - Tcl_Free(loadHandle); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * Index: unix/tclSelectNotfy.c ================================================================== --- unix/tclSelectNotfy.c +++ unix/tclSelectNotfy.c @@ -208,18 +208,22 @@ /* * Import of critical bits of Windows API when building threaded with Cygwin. */ #if defined(__CYGWIN__) +#ifdef __cplusplus +extern "C" { +#endif typedef struct { void *hwnd; /* Messaging window. */ unsigned int *message; /* Message payload. */ - int wParam; /* Event-specific "word" parameter. */ - int lParam; /* Event-specific "long" parameter. */ + size_t wParam; /* Event-specific "word" parameter. */ + size_t lParam; /* Event-specific "long" parameter. */ int time; /* Event timestamp. */ int x; /* Event location (where meaningful). */ int y; + int lPrivate; } MSG; typedef struct { unsigned int style; void *lpfnWndProc; @@ -227,41 +231,47 @@ int cbWndExtra; void *hInstance; void *hIcon; void *hCursor; void *hbrBackground; - void *lpszMenuName; + const void *lpszMenuName; const void *lpszClassName; -} WNDCLASS; +} WNDCLASSW; +#ifdef __clang__ +#pragma clang diagnostic ignored "-Wignored-attributes" +#endif extern void __stdcall CloseHandle(void *); extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, void *); extern void *__stdcall CreateWindowExW(void *, const void *, const void *, - DWORD, int, int, int, int, void *, void *, void *, + unsigned int, int, int, int, int, void *, void *, void *, void *); -extern DWORD __stdcall DefWindowProcW(void *, int, void *, void *); +extern unsigned int __stdcall DefWindowProcW(void *, int, void *, void *); extern unsigned char __stdcall DestroyWindow(void *); extern int __stdcall DispatchMessageW(const MSG *); extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int); -extern void __stdcall MsgWaitForMultipleObjects(DWORD, void *, - unsigned char, DWORD, DWORD); +extern void __stdcall MsgWaitForMultipleObjects(unsigned int, void *, + unsigned char, unsigned int, unsigned int); extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int); extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *, void *); extern void __stdcall PostQuitMessage(int); -extern void *__stdcall RegisterClassW(const WNDCLASS *); +extern void *__stdcall RegisterClassW(const WNDCLASSW *); extern unsigned char __stdcall ResetEvent(void *); extern unsigned char __stdcall TranslateMessage(const MSG *); /* * Threaded-cygwin specific constants and functions in this file: */ -static const WCHAR className[] = L"TclNotifier"; -static DWORD __stdcall NotifierProc(void *hwnd, unsigned int message, +static const wchar_t className[] = L"TclNotifier"; +static unsigned int __stdcall NotifierProc(void *hwnd, unsigned int message, void *wParam, void *lParam); +#ifdef __cplusplus +} +#endif #endif /* TCL_THREADS && __CYGWIN__ */ #include "tclUnixNotfy.c" @@ -295,27 +305,27 @@ /* * Initialize thread specific condition variable for this thread. */ if (tsdPtr->waitCVinitialized == 0) { #ifdef __CYGWIN__ - WNDCLASS class; - - class.style = 0; - class.cbClsExtra = 0; - class.cbWndExtra = 0; - class.hInstance = TclWinGetTclInstance(); - class.hbrBackground = NULL; - class.lpszMenuName = NULL; - class.lpszClassName = className; - class.lpfnWndProc = NotifierProc; - class.hIcon = NULL; - class.hCursor = NULL; - - RegisterClassW(&class); - tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName, - class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL, - TclWinGetTclInstance(), NULL); + WNDCLASSW clazz; + + clazz.style = 0; + clazz.cbClsExtra = 0; + clazz.cbWndExtra = 0; + clazz.hInstance = TclWinGetTclInstance(); + clazz.hbrBackground = NULL; + clazz.lpszMenuName = NULL; + clazz.lpszClassName = className; + clazz.lpfnWndProc = (void *)NotifierProc; + clazz.hIcon = NULL; + clazz.hCursor = NULL; + + RegisterClassW(&clazz); + tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName, + clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL, + clazz.hInstance, NULL); tsdPtr->event = CreateEventW(NULL, 1 /* manual */, 0 /* !signaled */, NULL); #else pthread_cond_init(&tsdPtr->waitCV, NULL); #endif /* __CYGWIN__ */ @@ -365,11 +375,11 @@ *---------------------------------------------------------------------- */ void Tcl_FinalizeNotifier( - ClientData clientData) /* Not used. */ + ClientData clientData) { if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); return; } else { @@ -462,11 +472,11 @@ if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { - filePtr = Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; tsdPtr->firstFileHandlerPtr = filePtr; } @@ -581,17 +591,17 @@ if (prevPtr == NULL) { tsdPtr->firstFileHandlerPtr = filePtr->nextPtr; } else { prevPtr->nextPtr = filePtr->nextPtr; } - Tcl_Free(filePtr); + ckfree(filePtr); } } #if defined(__CYGWIN__) -static DWORD __stdcall +static unsigned int __stdcall NotifierProc( void *hwnd, unsigned int message, void *wParam, void *lParam) @@ -638,10 +648,11 @@ return tclNotifierHooks.waitForEventProc(timePtr); } else { FileHandler *filePtr; int mask; Tcl_Time vTime; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); #if TCL_THREADS int waitForFiles; # ifdef __CYGWIN__ MSG msg; # endif /* __CYGWIN__ */ @@ -653,11 +664,10 @@ */ struct timeval timeout, *timeoutPtr; int numFound; #endif /* TCL_THREADS */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Set up the timeout structure. Note that if there are no events to * check for, we return with a negative result rather than blocking * forever. @@ -758,11 +768,11 @@ FD_ZERO(&tsdPtr->readyMasks.exception); if (!tsdPtr->eventReady) { #ifdef __CYGWIN__ if (!PeekMessageW(&msg, NULL, 0, 0, 0)) { - DWORD timeout; + unsigned int timeout; if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; } else { timeout = 0xFFFFFFFF; @@ -793,16 +803,16 @@ while (PeekMessageW(&msg, NULL, 0, 0, 0)) { /* * Retrieve and dispatch the message. */ - DWORD result = GetMessageW(&msg, NULL, 0, 0); + unsigned int result = GetMessageW(&msg, NULL, 0, 0); if (result == 0) { PostQuitMessage(msg.wParam); /* What to do here? */ - } else if (result != (DWORD) -1) { + } else if (result != (unsigned int) -1) { TranslateMessage(&msg); DispatchMessageW(&msg); } } ResetEvent(tsdPtr->event); @@ -875,11 +885,11 @@ * non-zero since an event must still be on the queue. */ if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = - Tcl_Alloc(sizeof(FileHandlerEvent)); + (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); } @@ -917,20 +927,20 @@ */ #if TCL_THREADS static TCL_NORETURN void NotifierThreadProc( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr; fd_set readableMask; fd_set writableMask; fd_set exceptionMask; int i; int fds[2], receivePipe; long found; - struct timeval poll = {0., 0.}, *timePtr; + struct timeval poll = {0, 0}, *timePtr; char buf[2]; int numFdBits = 0; if (pipe(fds) != 0) { Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe"); Index: unix/tclUnixChan.c ================================================================== --- unix/tclUnixChan.c +++ unix/tclUnixChan.c @@ -94,11 +94,11 @@ #ifdef SUPPORTS_TTY /* * The following structure is used to set or get the serial port attributes in - * a platform-independant manner. + * a platform-independent manner. */ typedef struct { int baud; int parity; @@ -117,41 +117,43 @@ /* * Static routines for this file: */ -static int FileBlockModeProc(ClientData instanceData, int mode); -static int FileCloseProc(ClientData instanceData, - Tcl_Interp *interp); -static int FileGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int FileInputProc(ClientData instanceData, char *buf, +static int FileBlockModeProc(void *instanceData, int mode); +static int FileCloseProc(void *instanceData, + Tcl_Interp *interp, int flags); +static int FileGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int FileOutputProc(ClientData instanceData, +static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static int FileSeekProc(ClientData instanceData, long offset, +#ifndef TCL_NO_DEPRECATED +static int FileSeekProc(void *instanceData, long offset, int mode, int *errorCode); -static int FileTruncateProc(ClientData instanceData, +#endif +static int FileTruncateProc(void *instanceData, Tcl_WideInt length); -static Tcl_WideInt FileWideSeekProc(ClientData instanceData, +static Tcl_WideInt FileWideSeekProc(void *instanceData, Tcl_WideInt offset, int mode, int *errorCode); -static void FileWatchProc(ClientData instanceData, int mask); +static void FileWatchProc(void *instanceData, int mask); #ifdef SUPPORTS_TTY -static int TtyCloseProc(ClientData instanceData, - Tcl_Interp *interp); +static int TtyCloseProc(void *instanceData, + Tcl_Interp *interp, int flags); static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr); -static int TtyGetOptionProc(ClientData instanceData, +static int TtyGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int TtyGetBaud(speed_t speed); static speed_t TtyGetSpeed(int baud); static void TtyInit(int fd); static void TtyModemStatusStr(int status, Tcl_DString *dsPtr); static int TtyParseMode(Tcl_Interp *interp, const char *mode, TtyAttrs *ttyPtr); static void TtySetAttributes(int fd, TtyAttrs *ttyPtr); -static int TtySetOptionProc(ClientData instanceData, +static int TtySetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); #endif /* SUPPORTS_TTY */ /* @@ -159,19 +161,23 @@ */ static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - FileCloseProc, /* Close proc. */ + TCL_CLOSE2PROC, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ +#ifndef TCL_NO_DEPRECATED FileSeekProc, /* Seek proc. */ +#else + NULL, +#endif NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ - NULL, /* close2proc. */ + FileCloseProc, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* wide seek proc. */ NULL, @@ -185,19 +191,19 @@ */ static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TtyCloseProc, /* Close proc. */ + TCL_CLOSE2PROC, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TtySetOptionProc, /* Set option proc. */ TtyGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ - NULL, /* close2proc. */ + TtyCloseProc, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ NULL, /* thread action proc. */ @@ -220,18 +226,17 @@ * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int FileBlockModeProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ int mode) /* The mode to set. Can be TCL_MODE_BLOCKING * or TCL_MODE_NONBLOCKING. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) { return errno; } @@ -256,17 +261,17 @@ *---------------------------------------------------------------------- */ static int FileInputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; int bytesRead; /* How many bytes were actually read from the * input device? */ *errorCodePtr = 0; @@ -275,11 +280,11 @@ * appropriately, and read will unblock as soon as a short read is * possible, if the channel is in blocking mode. If the channel is * nonblocking, the read will never block. */ - bytesRead = read(fsPtr->fd, buf, toRead); + bytesRead = read(fsPtr->fd, buf, (size_t) toRead); if (bytesRead > -1) { return bytesRead; } *errorCodePtr = errno; return -1; @@ -303,16 +308,16 @@ *---------------------------------------------------------------------- */ static int FileOutputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; int written; *errorCodePtr = 0; if (toWrite == 0) { @@ -322,11 +327,11 @@ * pipe behind the file). */ return 0; } - written = write(fsPtr->fd, buf, toWrite); + written = write(fsPtr->fd, buf, (size_t) toWrite); if (written > -1) { return written; } *errorCodePtr = errno; return -1; @@ -350,15 +355,20 @@ *---------------------------------------------------------------------- */ static int FileCloseProc( - ClientData instanceData, /* File state. */ - Tcl_Interp *interp) /* For error reporting - unused. */ + void *instanceData, /* File state. */ + TCL_UNUSED(Tcl_Interp *), + int flags) { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; int errorCode = 0; + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } Tcl_DeleteFileHandler(fsPtr->fd); /* * Do not close standard channels while in thread-exit. @@ -368,22 +378,26 @@ || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) { if (close(fsPtr->fd) < 0) { errorCode = errno; } } - Tcl_Free(fsPtr); + ckfree(fsPtr); return errorCode; } #ifdef SUPPORTS_TTY static int TtyCloseProc( - ClientData instanceData, - Tcl_Interp *interp) + void *instanceData, + Tcl_Interp *interp, + int flags) { - TtyState *ttyPtr = instanceData; + TtyState *ttyPtr = (TtyState*)instanceData; + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } /* * If we've been asked by the user to drain or flush, do so now. */ switch (ttyPtr->closeMode) { @@ -408,11 +422,11 @@ /* * Delegate to close for files. */ - return FileCloseProc(instanceData, interp); + return FileCloseProc(instanceData, interp, flags); } #endif /* SUPPORTS_TTY */ /* *---------------------------------------------------------------------- @@ -430,20 +444,20 @@ * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED static int FileSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_SET or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; Tcl_WideInt oldLoc, newLoc; /* * Save our current place in case we need to roll-back the seek. */ @@ -471,10 +485,11 @@ } else { *errorCodePtr = (newLoc == -1) ? errno : 0; } return (int) newLoc; } +#endif /* *---------------------------------------------------------------------- * * FileWideSeekProc -- @@ -494,17 +509,17 @@ *---------------------------------------------------------------------- */ static Tcl_WideInt FileWideSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_WideInt offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_CUR or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; Tcl_WideInt newLoc; newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); *errorCodePtr = (newLoc == -1) ? errno : 0; @@ -528,16 +543,16 @@ *---------------------------------------------------------------------- */ static void FileWatchProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; /* * Make sure we only register for events that are valid on this file. Note * that we are passing Tcl_NotifyChannel directly to Tcl_CreateFileHandler * with the channel pointer as the client data. @@ -570,15 +585,15 @@ *---------------------------------------------------------------------- */ static int FileGetHandleProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; if (direction & fsPtr->validMask) { *handlePtr = INT2PTR(fsPtr->fd); return TCL_OK; } @@ -637,17 +652,17 @@ *---------------------------------------------------------------------- */ static int TtySetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { - TtyState *fsPtr = instanceData; - size_t len, vlen; + TtyState *fsPtr = (TtyState *)instanceData; + unsigned int len, vlen; TtyAttrs tty; int argc; const char **argv; struct termios iostate; @@ -728,11 +743,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -xchar: should be a list of" " two elements with each a single 8-bit character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - Tcl_Free(argv); + ckfree(argv); return TCL_ERROR; } tcgetattr(fsPtr->fileState.fd, &iostate); @@ -751,11 +766,11 @@ if ((character > 0xFF) || argv[1][charLen]) { goto badXchar; } iostate.c_cc[VSTOP] = character; } - Tcl_Free(argv); + ckfree(argv); tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; } @@ -793,18 +808,18 @@ "bad value for -ttycontrol: should be a list of" " signal,value pairs", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } - Tcl_Free(argv); + ckfree(argv); return TCL_ERROR; } ioctl(fsPtr->fileState.fd, TIOCMGET, &control); for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { - Tcl_Free(argv); + ckfree(argv); return TCL_ERROR; } if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_DTR); @@ -824,11 +839,11 @@ } else { ioctl(fsPtr->fileState.fd, TIOCCBRK, NULL); } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); - Tcl_Free(argv); + ckfree(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -835,17 +850,17 @@ "bad signal \"%s\" for -ttycontrol: must be" " DTR, RTS or BREAK", argv[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } - Tcl_Free(argv); + ckfree(argv); return TCL_ERROR; } } /* -ttycontrol options loop */ ioctl(fsPtr->fileState.fd, TIOCMSET, &control); - Tcl_Free(argv); + ckfree(argv); return TCL_OK; #else /* TIOCMGET&TIOCMSET */ UNSUPPORTED_OPTION("-ttycontrol"); #endif /* TIOCMGET&TIOCMSET */ } @@ -976,17 +991,17 @@ *---------------------------------------------------------------------- */ static int TtyGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { - TtyState *fsPtr = instanceData; - size_t len; + TtyState *fsPtr = (TtyState *)instanceData; + unsigned int len; char buf[3*TCL_INTEGER_SPACE + 16]; int valid = 0; /* Flag if valid option parsed. */ struct termios iostate; if (optionName == NULL) { @@ -1650,11 +1665,11 @@ Tcl_Panic("TclpOpenFileChannel: invalid mode value"); return NULL; } - native = Tcl_FSGetNativePath(pathPtr); + native = (const char *)Tcl_FSGetNativePath(pathPtr); if (native == NULL) { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), "\": filename is invalid on this platform", NULL); @@ -1710,11 +1725,11 @@ translation = NULL; channelTypePtr = &fileChannelType; sprintf(channelName, "file%d", fd); } - fsPtr = Tcl_Alloc(sizeof(TtyState)); + fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fileState.fd = fd; #ifdef SUPPORTS_TTY if (channelTypePtr == &ttyChannelType) { fsPtr->closeMode = CLOSE_DEFAULT; @@ -1761,49 +1776,44 @@ *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeFileChannel( - ClientData handle, /* OS level handle. */ + void *handle, /* OS level handle. */ int mode) /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { TtyState *fsPtr; char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; - struct stat buf; + struct sockaddr sockaddr; + socklen_t sockaddrLen = sizeof(sockaddr); if (mode == 0) { return NULL; } + + sockaddr.sa_family = AF_UNSPEC; #ifdef SUPPORTS_TTY if (isatty(fd)) { channelTypePtr = &ttyChannelType; sprintf(channelName, "serial%d", fd); } else #endif /* SUPPORTS_TTY */ - if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { - struct sockaddr sockaddr; - socklen_t sockaddrLen = sizeof(sockaddr); - - sockaddr.sa_family = AF_UNSPEC; - if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) - && (sockaddrLen > 0) - && (sockaddr.sa_family == AF_INET - || sockaddr.sa_family == AF_INET6)) { - return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); - } - goto normalChannelAfterAll; + if ((getsockname(fd, (struct sockaddr *) &sockaddr, &sockaddrLen) == 0) + && (sockaddrLen > 0) + && (sockaddr.sa_family == AF_INET + || sockaddr.sa_family == AF_INET6)) { + return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); } else { - normalChannelAfterAll: channelTypePtr = &fileChannelType; sprintf(channelName, "file%d", fd); } - fsPtr = Tcl_Alloc(sizeof(TtyState)); + fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); fsPtr->fileState.fd = fd; fsPtr->fileState.validMask = mode | TCL_EXCEPTION; fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName, fsPtr, mode); #ifdef SUPPORTS_TTY @@ -1930,21 +1940,20 @@ Tcl_GetOpenFile( Tcl_Interp *interp, /* Interpreter in which to find file. */ const char *chanID, /* String that identifies file. */ int forWriting, /* 1 means the file is going to be used for * writing, 0 means for reading. */ - int checkUsage, /* 1 means verify that the file was opened in - * a mode that allows the access specified by - * "forWriting". Ignored, we always check that + TCL_UNUSED(int), /* Obsolete argument. + * Ignored, we always check that * the channel is open for the requested * mode. */ - ClientData *filePtr) /* Store pointer to FILE structure here. */ + void **filePtr) /* Store pointer to FILE structure here. */ { Tcl_Channel chan; int chanMode, fd; const Tcl_ChannelType *chanTypePtr; - ClientData data; + void *data; FILE *f; chan = Tcl_GetChannel(interp, chanID, &chanMode); if (chan == NULL) { return TCL_ERROR; @@ -2025,14 +2034,14 @@ *---------------------------------------------------------------------- */ static int FileTruncateProc( - ClientData instanceData, + void *instanceData, Tcl_WideInt length) { - FileState *fsPtr = instanceData; + FileState *fsPtr = (FileState *)instanceData; int result; #ifdef HAVE_TYPE_OFF64_T /* * We assume this goes with the type for now... Index: unix/tclUnixCompat.c ================================================================== --- unix/tclUnixCompat.c +++ unix/tclUnixCompat.c @@ -6,10 +6,12 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#include +#include #include #include /* * See also: SC_BLOCKING_STYLE in unix/tcl.m4 @@ -114,14 +116,14 @@ static int CopyString(const char *src, char *buf, int buflen); #endif #ifdef NEED_PW_CLEANER -static void FreePwBuf(ClientData ignored); +static void FreePwBuf(ClientData dummy); #endif #ifdef NEED_GR_CLEANER -static void FreeGrBuf(ClientData ignored); +static void FreeGrBuf(ClientData dummy); #endif #endif /* TCL_THREADS */ /* *--------------------------------------------------------------------------- @@ -197,11 +199,11 @@ if (tsdPtr->pbuf == NULL) { tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } - tsdPtr->pbuf = Tcl_Alloc(tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, &pwPtr); @@ -210,11 +212,11 @@ break; } else if (e != ERANGE) { return NULL; } tsdPtr->pbuflen *= 2; - tsdPtr->pbuf = Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWNAM_R_4) return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); @@ -277,11 +279,11 @@ if (tsdPtr->pbuf == NULL) { tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } - tsdPtr->pbuf = Tcl_Alloc(tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, &pwPtr); @@ -290,11 +292,11 @@ break; } else if (e != ERANGE) { return NULL; } tsdPtr->pbuflen *= 2; - tsdPtr->pbuf = Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWUID_R_4) return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); @@ -332,15 +334,15 @@ */ #ifdef NEED_PW_CLEANER static void FreePwBuf( - ClientData ignored) + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_Free(tsdPtr->pbuf); + ckfree(tsdPtr->pbuf); } #endif /* NEED_PW_CLEANER */ /* *--------------------------------------------------------------------------- @@ -380,11 +382,11 @@ if (tsdPtr->gbuf == NULL) { tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } - tsdPtr->gbuf = Tcl_Alloc(tsdPtr->gbuflen); + tsdPtr->gbuf = (char*)ckalloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, &grPtr); @@ -393,11 +395,11 @@ break; } else if (e != ERANGE) { return NULL; } tsdPtr->gbuflen *= 2; - tsdPtr->gbuf = Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRNAM_R_4) return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); @@ -460,11 +462,11 @@ if (tsdPtr->gbuf == NULL) { tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } - tsdPtr->gbuf = Tcl_Alloc(tsdPtr->gbuflen); + tsdPtr->gbuf = (char*)ckalloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, &grPtr); @@ -473,11 +475,11 @@ break; } else if (e != ERANGE) { return NULL; } tsdPtr->gbuflen *= 2; - tsdPtr->gbuf = Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRGID_R_4) return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); @@ -515,15 +517,15 @@ */ #ifdef NEED_GR_CLEANER static void FreeGrBuf( - ClientData ignored) + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_Free(tsdPtr->gbuf); + ckfree(tsdPtr->gbuf); } #endif /* NEED_GR_CLEANER */ /* *--------------------------------------------------------------------------- @@ -681,12 +683,12 @@ CopyGrp( struct group *tgtPtr, char *buf, int buflen) { - register char *p = buf; - register int copied, len = 0; + char *p = buf; + int copied, len = 0; /* * Copy username. */ @@ -883,11 +885,11 @@ * length. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { int i, j, len = 0; - char *p, **new; + char *p, **newBuffer; if (src == NULL) { return 0; } @@ -899,11 +901,11 @@ len = sizeof(char *) * (i + 1); /* Leave place for the array. */ if (len > buflen) { return -1; } - new = (char **) buf; + newBuffer = (char **) buf; p = buf + len; for (j = 0; j < i; j++) { int sz = (elsize<0 ? (int) strlen(src[j]) + 1 : elsize); @@ -910,14 +912,14 @@ len += sz; if (len > buflen) { return -1; } memcpy(p, src[j], sz); - new[j] = p; + newBuffer[j] = p; p = buf + len; } - new[j] = NULL; + newBuffer[j] = NULL; return len; } #endif /* NEED_COPYARRAY */ Index: unix/tclUnixFCmd.c ================================================================== --- unix/tclUnixFCmd.c +++ unix/tclUnixFCmd.c @@ -39,10 +39,12 @@ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. */ #include "tclInt.h" +#include +#include #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include #endif #endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ @@ -109,20 +111,12 @@ * IMPORTANT: The permissions attribute is assumed to be the third item (i.e. * to be indexed with '2' in arrays) in code in tclIOUtil.c and possibly * elsewhere in Tcl's core. */ -#ifdef DJGPP - -/* - * See contrib/djgpp/tclDjgppFCmd.c for definition. - */ - -extern TclFileAttrProcs tclpFileAttrProcs[]; -extern const char *const tclpFileAttrStrings[]; - -#else /* !DJGPP */ +#ifndef DJGPP + enum { #if defined(__CYGWIN__) UNIX_ARCHIVE_ATTRIBUTE, #endif UNIX_GROUP_ATTRIBUTE, @@ -138,14 +132,13 @@ #endif #ifdef MAC_OSX_TCL MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE, MACOSX_RSRCLENGTH_ATTRIBUTE, #endif - UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ + UNIX_INVALID_ATTRIBUTE }; -MODULE_SCOPE const char *const tclpFileAttrStrings[]; const char *const tclpFileAttrStrings[] = { #if defined(__CYGWIN__) "-archive", #endif "-group", @@ -163,11 +156,10 @@ "-creator", "-type", "-hidden", "-rsrclength", #endif NULL }; -MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; const TclFileAttrProcs tclpFileAttrProcs[] = { #if defined(__CYGWIN__) {GetUnixFileAttributes, SetUnixFileAttributes}, #endif {GetGroupAttribute, SetGroupAttribute}, @@ -327,12 +319,12 @@ int TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile((const char *)Tcl_FSGetNativePath(srcPathPtr), + (const char *)Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( const char *src, /* Pathname of file or dir to be renamed @@ -443,18 +435,18 @@ int TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - const char *src = Tcl_FSGetNativePath(srcPathPtr); + const char *src = (const char *)Tcl_FSGetNativePath(srcPathPtr); Tcl_StatBuf srcStatBuf; if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ return TCL_ERROR; } - return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); + return DoCopyFile(src, (const char *)Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); } static int DoCopyFile( const char *src, /* Pathname of file to be copied (native). */ @@ -550,11 +542,11 @@ const Tcl_StatBuf *statBufPtr, /* Used to determine mode and blocksize. */ int dontCopyAtts) /* If flag set, don't copy attributes. */ { int srcFd, dstFd; - size_t blockSize; /* Optimal I/O blocksize for filesystem */ + unsigned blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; #ifdef DJGPP #define BINMODE |O_BINARY @@ -606,25 +598,25 @@ */ if (blockSize <= 0) { blockSize = DEFAULT_COPY_BLOCK_SIZE; } - buffer = Tcl_Alloc(blockSize); + buffer = (char *)ckalloc(blockSize); while (1) { - nread = read(srcFd, buffer, blockSize); - if ((nread == TCL_IO_FAILURE) || (nread == 0)) { + nread = (size_t) read(srcFd, buffer, blockSize); + if ((nread == (size_t) -1) || (nread == 0)) { break; } if ((size_t) write(dstFd, buffer, nread) != nread) { - nread = TCL_IO_FAILURE; + nread = (size_t) -1; break; } } - Tcl_Free(buffer); + ckfree(buffer); close(srcFd); - if ((close(dstFd) != 0) || (nread == TCL_IO_FAILURE)) { + if ((close(dstFd) != 0) || (nread == (size_t) -1)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) { /* @@ -705,11 +697,11 @@ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); + return DoCreateDirectory((const char *)Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( const char *path) /* Pathname of directory to create (native). */ @@ -956,12 +948,12 @@ * source hierarchy, e.g. by deleting * files. */ { Tcl_StatBuf statBuf; const char *source, *errfile; - int result; - size_t targetLen, sourceLen; + int result, sourceLen; + int targetLen; #ifndef HAVE_FTS int numProcessed = 0; Tcl_DirEntry *dirEntPtr; TclDIR *dirPtr; #else @@ -970,11 +962,11 @@ FTSENT *ent; #endif errfile = NULL; result = TCL_OK; - targetLen = 0; /* lint. */ + targetLen = 0; source = Tcl_DStringValue(sourcePtr); if (TclOSlstat(source, &statBuf) != 0) { /* INTL: Native. */ errfile = source; goto end; @@ -1236,18 +1228,18 @@ */ static int TraversalDelete( Tcl_DString *srcPtr, /* Source pathname (native). */ - Tcl_DString *ignore, /* Destination pathname (not used). */ - const Tcl_StatBuf *statBufPtr, - /* Stat info for file specified by srcPtr. */ + TCL_UNUSED(Tcl_DString *), + TCL_UNUSED(const Tcl_StatBuf *), int type, /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { + switch (type) { case DOTREE_F: if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { return TCL_OK; } @@ -1285,11 +1277,15 @@ *--------------------------------------------------------------------------- */ static int CopyFileAtts( - const char *src, /* Path name of source file (native). */ +#ifdef MAC_OSX_TCL + const char *src, /* Path name of source file (native). */ +#else + TCL_UNUSED(const char *) /*src*/, +#endif const char *dst, /* Path name of target file (native). */ const Tcl_StatBuf *statBufPtr) /* Stat info for source file */ { struct utimbuf tval; @@ -1311,12 +1307,12 @@ if (chmod(dst, newMode)) { /* INTL: Native. */ return TCL_ERROR; } } - tval.actime = statBufPtr->st_atime; - tval.modtime = statBufPtr->st_mtime; + tval.actime = Tcl_GetAccessTimeFromStat(statBufPtr); + tval.modtime = Tcl_GetModificationTimeFromStat(statBufPtr); if (utime(dst, &tval)) { /* INTL: Native. */ return TCL_ERROR; } #ifdef MAC_OSX_TCL @@ -1343,11 +1339,11 @@ */ static int GetGroupAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; struct group *groupPtr; @@ -1397,11 +1393,11 @@ */ static int GetOwnerAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; struct passwd *pwPtr; @@ -1449,11 +1445,11 @@ */ static int GetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; @@ -1491,11 +1487,11 @@ */ static int SetGroupAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New group for file. */ { Tcl_WideInt gid; int result; @@ -1503,15 +1499,14 @@ if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; - size_t length; - string = TclGetStringFromObj(attributePtr, &length); + string = TclGetString(attributePtr); - native = Tcl_UtfToExternalDString(NULL, string, length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { if (interp != NULL) { @@ -1525,11 +1520,11 @@ return TCL_ERROR; } gid = groupPtr->gr_gid; } - native = Tcl_FSGetNativePath(fileName); + native = (const char *)Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1558,11 +1553,11 @@ */ static int SetOwnerAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New owner for file. */ { Tcl_WideInt uid; int result; @@ -1570,15 +1565,14 @@ if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; - size_t length; - string = TclGetStringFromObj(attributePtr, &length); + string = TclGetString(attributePtr); - native = Tcl_UtfToExternalDString(NULL, string, length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { if (interp != NULL) { @@ -1592,11 +1586,11 @@ return TCL_ERROR; } uid = pwPtr->pw_uid; } - native = Tcl_FSGetNativePath(fileName); + native = (const char *)Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1625,11 +1619,11 @@ */ static int SetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { Tcl_WideInt mode; mode_t newMode; @@ -1686,11 +1680,11 @@ } return TCL_ERROR; } } - native = Tcl_FSGetNativePath(fileName); + native = (const char *)Tcl_FSGetNativePath(fileName); result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set permissions for file \"%s\": %s", @@ -1747,11 +1741,11 @@ *---------------------------------------------------------------------- */ static int GetModeFromPermString( - Tcl_Interp *interp, /* The interp we are using for errors. */ + TCL_UNUSED(Tcl_Interp *), const char *modeStringPtr, /* Permissions string */ mode_t *modePtr) /* pointer to the mode value */ { mode_t newMode; mode_t oldMode; /* Storage for the value of the old mode (that @@ -1837,26 +1831,26 @@ for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { if (!who_found) { /* who */ switch (*(modeStringPtr+n+i)) { case 'u': - who |= 0x9c0; + who |= 0x9C0; continue; case 'g': who |= 0x438; continue; case 'o': who |= 0x207; continue; case 'a': - who |= 0xfff; + who |= 0xFFF; continue; } } who_found = 1; if (who == 0) { - who = 0xfff; + who = 0xFFF; } if (!op_found) { /* op */ switch (*(modeStringPtr+n+i)) { case '+': @@ -1885,11 +1879,11 @@ continue; case 'x': what |= 0x49; continue; case 's': - what |= 0xc00; + what |= 0xC00; continue; case 't': what |= 0x200; continue; case ',': @@ -1920,68 +1914,70 @@ /* *--------------------------------------------------------------------------- * * TclpObjNormalizePath -- * - * This function scans through a path specification and replaces it, in - * place, with a normalized version. A normalized version is one in which - * all symlinks in the path are replaced with their expanded form (except - * a symlink at the very end of the path). + * Replaces each component except that last one in a pathname that is a + * symbolic link with the fully resolved target of that link. * * Results: - * The new 'nextCheckpoint' value, giving as far as we could understand - * in the path. + * Stores the resulting path in pathPtr and returns the offset of the last + * byte processed to obtain the resulting path. * * Side effects: - * The pathPtr string, is modified. * *--------------------------------------------------------------------------- */ int TclpObjNormalizePath( - Tcl_Interp *interp, - Tcl_Obj *pathPtr, - int nextCheckpoint) + TCL_UNUSED(Tcl_Interp *), + Tcl_Obj *pathPtr, /* An unshared object containing the path to + * normalize. */ + int nextCheckpoint) /* offset to start at in pathPtr. Must either + * be 0 or the offset of a directory separator + * at the end of a path part that is already + * normalized. I.e. this is not the index of + * the byte just after the separator. */ + { const char *currentPathEndPosition; char cur; - size_t pathLen; - const char *path = TclGetStringFromObj(pathPtr, &pathLen); + const char *path = TclGetString(pathPtr); + size_t pathLen = pathPtr->length; Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH char normPath[MAXPATHLEN]; #endif - /* - * We add '1' here because if nextCheckpoint is zero we know that '/' - * exists, and if it isn't zero, it must point at a directory separator - * which we also know exists. - */ - currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } #ifndef NO_REALPATH - /* - * For speed, try to get the entire path in one go. - */ - if (nextCheckpoint == 0 && haveRealpath) { - char *lastDir = strrchr(currentPathEndPosition, '/'); + /* + * Try to get the entire path in one go + */ + + const char *lastDir = strrchr(currentPathEndPosition, '/'); if (lastDir != NULL) { nativePath = Tcl_UtfToExternalDString(NULL, path, lastDir-path, &ds); if (Realpath(nativePath, normPath) != NULL) { if (*nativePath != '/' && *normPath == '/') { /* - * realpath has transformed a relative path into an - * absolute path, we do not know how to handle this. + * realpath transformed a relative path into an + * absolute path. Fall back to the long way. + */ + + /* + * To do: This logic seems to be out of date. This whole + * routine should be reviewed and cleaed up. */ } else { nextCheckpoint = lastDir - path; goto wholeStringOk; } @@ -2016,65 +2012,63 @@ break; } /* - * Update the acceptable point. + * Assign the end of the current component to nextCheckpoint */ nextCheckpoint = currentPathEndPosition - path; } else if (cur == 0) { /* - * Reached end of string. + * The end of the string. */ break; } currentPathEndPosition++; } /* - * We should really now convert this to a canonical path. We do that with - * 'realpath' if we have it available. Otherwise we could step through - * every single path component, checking whether it is a symlink, but that - * would be a lot of work, and most modern OSes have 'realpath'. + * Call 'realpath' to obtain a canonical path. */ #ifndef NO_REALPATH if (haveRealpath) { - /* - * If we only had '/foo' or '/' then we never increment nextCheckpoint - * and we don't need or want to go through 'Realpath'. Also, on some - * platforms, passing an empty string to 'Realpath' will give us the - * normalized pwd, which is not what we want at all! - */ - if (nextCheckpoint == 0) { + /* + * The path contains at most one component, e.g. '/foo' or '/', so + * so there is nothing to resolve. Also, on some platforms + * 'Realpath' transforms an empty string into the normalized pwd, + * which is the wrong answer. + */ + return 0; } nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { - size_t newNormLen; + int newNormLen; wholeStringOk: newNormLen = strlen(normPath); if ((newNormLen == Tcl_DStringLength(&ds)) && (strcmp(normPath, nativePath) == 0)) { /* - * String is unchanged. + * The original path is unchanged. */ Tcl_DStringFree(&ds); /* - * Enable this to have the native FS claim normalization of - * the whole path for existing files. That would permit the - * caller to declare normalization complete without calls to - * additional filesystems. Saving lots of calls is probably - * worth the extra access() time here. When no other FS's are - * registered though, things are less clear. + * Uncommenting this would mean that this native filesystem + * routine claims the path is normalized if the file exists, + * which would permit the caller to avoid iterating through + * other filesystems filesystems. Saving lots of calls is + * probably worth the extra access() time, but in the common + * case that no other filesystems are registered this is an + * unnecessary expense. * if (0 == access(normPath, F_OK)) { return pathLen; } */ @@ -2081,29 +2075,29 @@ return nextCheckpoint; } /* - * Free up the native path and put in its place the converted, - * normalized path. + * Free the original path and replace it with the normalized path. */ Tcl_DStringFree(&ds); - Tcl_ExternalToUtfDString(NULL, normPath, newNormLen, &ds); + Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); if (path[nextCheckpoint] != '\0') { /* - * Not at end, append remaining path. + * Append the remaining path components. */ int normLen = Tcl_DStringLength(&ds); Tcl_DStringAppend(&ds, path + nextCheckpoint, pathLen - nextCheckpoint); /* - * We recognise up to and including the directory separator. + * characters up to and including the directory separator have + * been processed */ nextCheckpoint = normLen + 1; } else { /* @@ -2111,14 +2105,10 @@ */ nextCheckpoint = Tcl_DStringLength(&ds); } - /* - * Overwrite with the normalized path. - */ - Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); } Tcl_DStringFree(&ds); } @@ -2171,61 +2161,60 @@ Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) { - Tcl_DString template, tmp; + Tcl_DString templ, tmp; const char *string; int fd; - size_t length; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { - string = TclGetStringFromObj(dirObj, &length); - Tcl_UtfToExternalDString(NULL, string, length, &template); + string = TclGetString(dirObj); + Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); } else { - Tcl_DStringInit(&template); - Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ + Tcl_DStringInit(&templ); + Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */ } - TclDStringAppendLiteral(&template, "/"); + TclDStringAppendLiteral(&templ, "/"); if (basenameObj) { - string = TclGetStringFromObj(basenameObj, &length); - Tcl_UtfToExternalDString(NULL, string, length, &tmp); - TclDStringAppendDString(&template, &tmp); + string = TclGetString(basenameObj); + Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { - TclDStringAppendLiteral(&template, "tcl"); + TclDStringAppendLiteral(&templ, "tcl"); } - TclDStringAppendLiteral(&template, "_XXXXXX"); + TclDStringAppendLiteral(&templ, "_XXXXXX"); #ifdef HAVE_MKSTEMPS if (extensionObj) { - string = TclGetStringFromObj(extensionObj, &length); - Tcl_UtfToExternalDString(NULL, string, length, &tmp); - TclDStringAppendDString(&template, &tmp); - fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); + string = TclGetString(extensionObj); + Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp); + TclDStringAppendDString(&templ, &tmp); + fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else #endif { - fd = mkstemp(Tcl_DStringValue(&template)); + fd = mkstemp(Tcl_DStringValue(&templ)); } if (fd == -1) { - Tcl_DStringFree(&template); + Tcl_DStringFree(&templ); return -1; } if (resultingNameObj) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template), - Tcl_DStringLength(&template), &tmp); + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), &tmp); Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else { /* @@ -2232,14 +2221,14 @@ * Try to delete the file immediately since we're not reporting the * name to anyone. Note that we're *not* handling any errors from * this! */ - unlink(Tcl_DStringValue(&template)); + unlink(Tcl_DStringValue(&templ)); errno = 0; } - Tcl_DStringFree(&template); + Tcl_DStringFree(&templ); return fd; } /* @@ -2295,11 +2284,11 @@ Tcl_Obj * TclpCreateTemporaryDirectory( Tcl_Obj *dirObj, Tcl_Obj *basenameObj) { - Tcl_DString template, tmp; + Tcl_DString templ, tmp; const char *string; #define DEFAULT_TEMP_DIR_PREFIX "tcl" /* @@ -2307,51 +2296,51 @@ * some defaults. */ if (dirObj) { string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template); + Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); } else { - Tcl_DStringInit(&template); - Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ + Tcl_DStringInit(&templ); + Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */ } - if (Tcl_DStringValue(&template)[Tcl_DStringLength(&template) - 1] != '/') { - TclDStringAppendLiteral(&template, "/"); + if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') { + TclDStringAppendLiteral(&templ, "/"); } if (basenameObj) { string = TclGetString(basenameObj); if (basenameObj->length) { Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); - TclDStringAppendDString(&template, &tmp); + TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { - TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX); + TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX); } } else { - TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX); + TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX); } - TclDStringAppendLiteral(&template, "_XXXXXX"); + TclDStringAppendLiteral(&templ, "_XXXXXX"); /* * Make the temporary directory. */ - if (mkdtemp(Tcl_DStringValue(&template)) == NULL) { - Tcl_DStringFree(&template); + if (mkdtemp(Tcl_DStringValue(&templ)) == NULL) { + Tcl_DStringFree(&templ); return NULL; } /* * The template has been updated. Tell the caller what it was. */ - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template), - Tcl_DStringLength(&template), &tmp); - Tcl_DStringFree(&template); + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), &tmp); + Tcl_DStringFree(&templ); return TclDStringToObj(&tmp); } #if defined(__CYGWIN__) @@ -2368,16 +2357,16 @@ static WCHAR * winPathFromObj( Tcl_Obj *fileName) { - size_t size; - const char *native = Tcl_FSGetNativePath(fileName); + int size; + const char *native = (const char *)Tcl_FSGetNativePath(fileName); WCHAR *winPath; size = cygwin_conv_path(1, native, NULL, 0); - winPath = Tcl_Alloc(size); + winPath = (WCHAR *)ckalloc(size); cygwin_conv_path(1, native, winPath, size); return winPath; } @@ -2388,34 +2377,36 @@ /* *---------------------------------------------------------------------- * * GetUnixFileAttributes * - * Gets the readonly attribute of a file. + * Gets an attribute of a file. * * Results: - * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there - * is no error. The object will have ref count 0. + * A standard Tcl result. * * Side effects: - * A new object is allocated. + * If there is no error assigns to *attributePtrPtr the address of a new + * Tcl_Obj having a refCount of zero and containing the value of the + * specified attribute. + * * *---------------------------------------------------------------------- */ static int GetUnixFileAttributes( - Tcl_Interp *interp, /* The interp we are using for errors. */ + Tcl_Interp *interp, /* The interp to report errors to. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Obj *fileName, /* The pathname of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* Where to store the result. */ { int fileAttributes; WCHAR *winPath = winPathFromObj(fileName); fileAttributes = GetFileAttributesW(winPath); - Tcl_Free(winPath); + ckfree(winPath); if (fileAttributes == -1) { StatError(interp, fileName); return TCL_ERROR; } @@ -2458,11 +2449,11 @@ winPath = winPathFromObj(fileName); fileAttributes = old = GetFileAttributesW(winPath); if (fileAttributes == -1) { - Tcl_Free(winPath); + ckfree(winPath); StatError(interp, fileName); return TCL_ERROR; } if (yesNo) { @@ -2471,16 +2462,16 @@ fileAttributes &= ~attributeArray[objIndex]; } if ((fileAttributes != old) && !SetFileAttributesW(winPath, fileAttributes)) { - Tcl_Free(winPath); + ckfree(winPath); StatError(interp, fileName); return TCL_ERROR; } - Tcl_Free(winPath); + ckfree(winPath); return TCL_OK; } #elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) /* *---------------------------------------------------------------------- @@ -2500,11 +2491,11 @@ */ static int GetUnixFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; @@ -2541,11 +2532,11 @@ */ static int SetUnixFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { Tcl_StatBuf statBuf; int result, readonly; @@ -2570,11 +2561,11 @@ statBuf.st_flags |= UF_IMMUTABLE; } else { statBuf.st_flags &= ~UF_IMMUTABLE; } - native = Tcl_FSGetNativePath(fileName); + native = (const char *)Tcl_FSGetNativePath(fileName); result = chflags(native, statBuf.st_flags); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not set flags for file \"%s\": %s", Index: unix/tclUnixFile.c ================================================================== --- unix/tclUnixFile.c +++ unix/tclUnixFile.c @@ -32,20 +32,20 @@ * The computed path name is stored as a ProcessGlobalValue. * *--------------------------------------------------------------------------- */ +#ifdef __CYGWIN__ void TclpFindExecutable( - const char *argv0) /* The value of the application's argv[0] - * (native). */ + TCL_UNUSED(const char *) /*argv0*/) { Tcl_Encoding encoding; -#ifdef __CYGWIN__ - size_t length; - char buf[PATH_MAX * 2]; - char name[PATH_MAX * TCL_UTF_MAX + 1]; + int length; + wchar_t buf[PATH_MAX]; + char name[PATH_MAX * 3 + 1]; + GetModuleFileNameW(NULL, buf, PATH_MAX); cygwin_conv_path(3, buf, name, PATH_MAX); length = strlen(name); if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) { /* Strip '.exe' part. */ @@ -52,11 +52,18 @@ length -= 4; } encoding = Tcl_GetEncoding(NULL, NULL); TclSetObjNameOfExecutable( Tcl_NewStringObj(name, length), encoding); +} #else +void +TclpFindExecutable( + const char *argv0) /* The value of the application's argv[0] + * (native). */ +{ + Tcl_Encoding encoding; const char *name, *p; Tcl_StatBuf statBuf; Tcl_DString buffer, nameString, cwd, utfName; if (argv0 == NULL) { @@ -96,11 +103,11 @@ * Search through all the directories named in the PATH variable to see if * argv[0] is in one of them. If so, use that file name. */ while (1) { - while (TclIsSpaceProc(*p)) { + while (TclIsSpaceProcM(*p)) { p++; } name = p; while ((*p != ':') && (*p != 0)) { p++; @@ -190,12 +197,12 @@ Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); Tcl_DStringFree(&utfName); done: Tcl_DStringFree(&buffer); -#endif } +#endif /* *---------------------------------------------------------------------- * * TclpMatchInDirectory -- @@ -247,13 +254,13 @@ */ Tcl_Obj *tailPtr; const char *nativeTail; - native = Tcl_FSGetNativePath(pathPtr); + native = (const char *)Tcl_FSGetNativePath(pathPtr); tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL); - nativeTail = Tcl_FSGetNativePath(tailPtr); + nativeTail = (const char *)Tcl_FSGetNativePath(tailPtr); matchResult = NativeMatchType(interp, native, nativeTail, types); if (matchResult == 1) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } Tcl_DecrRefCount(tailPtr); @@ -267,11 +274,12 @@ Tcl_StatBuf statBuf; Tcl_DString ds; /* native encoding of dir */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); - dirName = TclGetStringFromObj(fileNamePtr, &dirLength); + dirName = TclGetString(fileNamePtr); + dirLength = fileNamePtr->length; Tcl_DStringAppend(&dsOrig, dirName, dirLength); /* * Make sure that the directory part of the name really is a * directory. If the directory name is "", use the name "." instead, @@ -552,10 +560,12 @@ &buf, types); if (matchResult != 1) { return matchResult; } } +#else + (void)interp; #endif /* MAC_OSX_TCL */ return 1; } @@ -619,11 +629,11 @@ int TclpObjAccess( Tcl_Obj *pathPtr, /* Path of file to access */ int mode) /* Permission setting. */ { - const char *path = Tcl_FSGetNativePath(pathPtr); + const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return access(path, mode); @@ -647,11 +657,11 @@ int TclpObjChdir( Tcl_Obj *pathPtr) /* Path to new working directory */ { - const char *path = Tcl_FSGetNativePath(pathPtr); + const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return chdir(path); @@ -676,11 +686,11 @@ int TclpObjLstat( Tcl_Obj *pathPtr, /* Path of file to stat */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { - return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr); + return TclOSlstat((const char *)Tcl_FSGetNativePath(pathPtr), bufPtr); } /* *--------------------------------------------------------------------------- * @@ -717,11 +727,11 @@ return NULL; } #endif /* USEGETWD */ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { - char *newCd = Tcl_Alloc(strlen(buffer) + 1); + char *newCd = (char*)ckalloc(strlen(buffer) + 1); strcpy(newCd, buffer); return newCd; } @@ -844,11 +854,11 @@ int TclpObjStat( Tcl_Obj *pathPtr, /* Path of file to stat */ Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */ { - const char *path = Tcl_FSGetNativePath(pathPtr); + const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } return TclOSstat(path, bufPtr); @@ -861,11 +871,11 @@ Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction) { if (toPtr != NULL) { - const char *src = Tcl_FSGetNativePath(pathPtr); + const char *src = (const char *)Tcl_FSGetNativePath(pathPtr); const char *target = NULL; if (src == NULL) { return NULL; } @@ -907,11 +917,11 @@ */ Tcl_DecrRefCount(absPtr); Tcl_DecrRefCount(dirPtr); } else { - target = Tcl_FSGetNativePath(toPtr); + target = (const char*)Tcl_FSGetNativePath(toPtr); if (target == NULL) { return NULL; } if (access(target, F_OK) == -1) { /* @@ -937,11 +947,10 @@ */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { Tcl_DString ds; Tcl_Obj *transPtr; - size_t length; /* * Now we don't want to link to the absolute, normalized path. * Relative links are quite acceptable (but links to ~user are not * -- these must be expanded first). @@ -949,12 +958,12 @@ transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr); if (transPtr == NULL) { return NULL; } - target = TclGetStringFromObj(transPtr, &length); - target = Tcl_UtfToExternalDString(NULL, target, length, &ds); + target = TclGetString(transPtr); + target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { toPtr = NULL; } @@ -980,11 +989,11 @@ if (transPtr == NULL) { return NULL; } Tcl_DecrRefCount(transPtr); - length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); + length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; } Tcl_ExternalToUtfDString(NULL, link, length, &ds); @@ -1014,11 +1023,11 @@ *--------------------------------------------------------------------------- */ Tcl_Obj * TclpFilesystemPathType( - Tcl_Obj *pathPtr) + TCL_UNUSED(Tcl_Obj *)) { /* * All native paths are of the same type. */ @@ -1103,21 +1112,22 @@ return NULL; } Tcl_IncrRefCount(validPathPtr); } - str = TclGetStringFromObj(validPathPtr, &len); + str = TclGetString(validPathPtr); + len = validPathPtr->length; Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ Tcl_DecrRefCount(validPathPtr); Tcl_DStringFree(&ds); return NULL; } Tcl_DecrRefCount(validPathPtr); - nativePathPtr = Tcl_Alloc(len); + nativePathPtr = (char *)ckalloc(len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); return nativePathPtr; } @@ -1154,11 +1164,11 @@ * ASCII representation when running on Unix. */ len = (strlen((const char*) clientData) + 1) * sizeof(char); - copy = Tcl_Alloc(len); + copy = (char *)ckalloc(len); memcpy(copy, clientData, len); return copy; } /* @@ -1180,11 +1190,11 @@ int TclpUtime( Tcl_Obj *pathPtr, /* File to modify */ struct utimbuf *tval) /* New modification date structure */ { - return utime(Tcl_FSGetNativePath(pathPtr), tval); + return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval); } #ifdef __CYGWIN__ int @@ -1191,11 +1201,11 @@ TclOSstat( const char *name, void *cygstat) { struct stat buf; - Tcl_StatBuf *statBuf = cygstat; + Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = stat(name, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; @@ -1214,11 +1224,11 @@ TclOSlstat( const char *name, void *cygstat) { struct stat buf; - Tcl_StatBuf *statBuf = cygstat; + Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat; int result = lstat(name, &buf); statBuf->st_mode = buf.st_mode; statBuf->st_ino = buf.st_ino; statBuf->st_dev = buf.st_dev; Index: unix/tclUnixInit.c ================================================================== --- unix/tclUnixInit.c +++ unix/tclUnixInit.c @@ -7,12 +7,10 @@ * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. */ #include "tclInt.h" -#include -#include #ifdef HAVE_LANGINFO # include # ifdef __APPLE__ # if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* Support for weakly importing nl_langinfo on Darwin. */ @@ -31,47 +29,56 @@ # include # endif #endif #ifdef __CYGWIN__ +#ifdef __cplusplus +extern "C" { +#endif +#ifdef __clang__ +#pragma clang diagnostic ignored "-Wignored-attributes" +#endif DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *); DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *); DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); +#ifdef __cplusplus +} +#endif #define NUMPROCESSORS 11 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" }; typedef struct { union { - DWORD dwOemId; + unsigned int dwOemId; struct { int wProcessorArchitecture; int wReserved; }; }; - DWORD dwPageSize; + unsigned int dwPageSize; void *lpMinimumApplicationAddress; void *lpMaximumApplicationAddress; void *dwActiveProcessorMask; - DWORD dwNumberOfProcessors; - DWORD dwProcessorType; - DWORD dwAllocationGranularity; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; int wProcessorLevel; int wProcessorRevision; } SYSTEM_INFO; typedef struct { - DWORD dwOSVersionInfoSize; - DWORD dwMajorVersion; - DWORD dwMinorVersion; - DWORD dwBuildNumber; - DWORD dwPlatformId; + unsigned int dwOSVersionInfoSize; + unsigned int dwMajorVersion; + unsigned int dwMinorVersion; + unsigned int dwBuildNumber; + unsigned int dwPlatformId; wchar_t szCSDVersion[128]; } OSVERSIONINFOW; #endif #ifdef HAVE_COREFOUNDATION @@ -124,13 +131,13 @@ * "bug fixes" that have been added to deal with the wide variability seen * among existing platforms. */ static const LocaleTable localeTable[] = { - {"", "iso8859-1"}, - {"ansi-1251", "cp1251"}, - {"ansi_x3.4-1968", "iso8859-1"}, + {"", "iso8859-1"}, + {"ansi-1251", "cp1251"}, + {"ansi_x3.4-1968", "iso8859-1"}, {"ascii", "ascii"}, {"big5", "big5"}, {"cp1250", "cp1250"}, {"cp1251", "cp1251"}, {"cp1252", "cp1252"}, @@ -163,65 +170,65 @@ {"dingbats", "dingbats"}, {"ebcdic", "ebcdic"}, {"euc-cn", "euc-cn"}, {"euc-jp", "euc-jp"}, {"euc-kr", "euc-kr"}, - {"eucjp", "euc-jp"}, - {"euckr", "euc-kr"}, - {"euctw", "euc-cn"}, + {"eucjp", "euc-jp"}, + {"euckr", "euc-kr"}, + {"euctw", "euc-cn"}, {"gb12345", "gb12345"}, {"gb1988", "gb1988"}, {"gb2312", "gb2312"}, - {"gb2312-1980", "gb2312"}, + {"gb2312-1980", "gb2312"}, {"gb2312-raw", "gb2312-raw"}, - {"greek8", "cp869"}, - {"ibm1250", "cp1250"}, - {"ibm1251", "cp1251"}, - {"ibm1252", "cp1252"}, - {"ibm1253", "cp1253"}, - {"ibm1254", "cp1254"}, - {"ibm1255", "cp1255"}, - {"ibm1256", "cp1256"}, - {"ibm1257", "cp1257"}, - {"ibm1258", "cp1258"}, - {"ibm437", "cp437"}, - {"ibm737", "cp737"}, - {"ibm775", "cp775"}, - {"ibm850", "cp850"}, - {"ibm852", "cp852"}, - {"ibm855", "cp855"}, - {"ibm857", "cp857"}, - {"ibm860", "cp860"}, - {"ibm861", "cp861"}, - {"ibm862", "cp862"}, - {"ibm863", "cp863"}, - {"ibm864", "cp864"}, - {"ibm865", "cp865"}, - {"ibm866", "cp866"}, - {"ibm869", "cp869"}, - {"ibm874", "cp874"}, - {"ibm932", "cp932"}, - {"ibm936", "cp936"}, - {"ibm949", "cp949"}, - {"ibm950", "cp950"}, - {"iso-2022", "iso2022"}, - {"iso-2022-jp", "iso2022-jp"}, - {"iso-2022-kr", "iso2022-kr"}, - {"iso-8859-1", "iso8859-1"}, - {"iso-8859-10", "iso8859-10"}, - {"iso-8859-13", "iso8859-13"}, - {"iso-8859-14", "iso8859-14"}, - {"iso-8859-15", "iso8859-15"}, - {"iso-8859-16", "iso8859-16"}, - {"iso-8859-2", "iso8859-2"}, - {"iso-8859-3", "iso8859-3"}, - {"iso-8859-4", "iso8859-4"}, - {"iso-8859-5", "iso8859-5"}, - {"iso-8859-6", "iso8859-6"}, - {"iso-8859-7", "iso8859-7"}, - {"iso-8859-8", "iso8859-8"}, - {"iso-8859-9", "iso8859-9"}, + {"greek8", "cp869"}, + {"ibm1250", "cp1250"}, + {"ibm1251", "cp1251"}, + {"ibm1252", "cp1252"}, + {"ibm1253", "cp1253"}, + {"ibm1254", "cp1254"}, + {"ibm1255", "cp1255"}, + {"ibm1256", "cp1256"}, + {"ibm1257", "cp1257"}, + {"ibm1258", "cp1258"}, + {"ibm437", "cp437"}, + {"ibm737", "cp737"}, + {"ibm775", "cp775"}, + {"ibm850", "cp850"}, + {"ibm852", "cp852"}, + {"ibm855", "cp855"}, + {"ibm857", "cp857"}, + {"ibm860", "cp860"}, + {"ibm861", "cp861"}, + {"ibm862", "cp862"}, + {"ibm863", "cp863"}, + {"ibm864", "cp864"}, + {"ibm865", "cp865"}, + {"ibm866", "cp866"}, + {"ibm869", "cp869"}, + {"ibm874", "cp874"}, + {"ibm932", "cp932"}, + {"ibm936", "cp936"}, + {"ibm949", "cp949"}, + {"ibm950", "cp950"}, + {"iso-2022", "iso2022"}, + {"iso-2022-jp", "iso2022-jp"}, + {"iso-2022-kr", "iso2022-kr"}, + {"iso-8859-1", "iso8859-1"}, + {"iso-8859-10", "iso8859-10"}, + {"iso-8859-13", "iso8859-13"}, + {"iso-8859-14", "iso8859-14"}, + {"iso-8859-15", "iso8859-15"}, + {"iso-8859-16", "iso8859-16"}, + {"iso-8859-2", "iso8859-2"}, + {"iso-8859-3", "iso8859-3"}, + {"iso-8859-4", "iso8859-4"}, + {"iso-8859-5", "iso8859-5"}, + {"iso-8859-6", "iso8859-6"}, + {"iso-8859-7", "iso8859-7"}, + {"iso-8859-8", "iso8859-8"}, + {"iso-8859-9", "iso8859-9"}, {"iso2022", "iso2022"}, {"iso2022-jp", "iso2022-jp"}, {"iso2022-kr", "iso2022-kr"}, {"iso8859-1", "iso8859-1"}, {"iso8859-10", "iso8859-10"}, @@ -235,51 +242,51 @@ {"iso8859-5", "iso8859-5"}, {"iso8859-6", "iso8859-6"}, {"iso8859-7", "iso8859-7"}, {"iso8859-8", "iso8859-8"}, {"iso8859-9", "iso8859-9"}, - {"iso88591", "iso8859-1"}, - {"iso885915", "iso8859-15"}, - {"iso88592", "iso8859-2"}, - {"iso88595", "iso8859-5"}, - {"iso88596", "iso8859-6"}, - {"iso88597", "iso8859-7"}, - {"iso88598", "iso8859-8"}, - {"iso88599", "iso8859-9"}, -#ifdef hpux - {"ja", "shiftjis"}, -#else - {"ja", "euc-jp"}, -#endif - {"ja_jp", "euc-jp"}, - {"ja_jp.euc", "euc-jp"}, - {"ja_jp.eucjp", "euc-jp"}, - {"ja_jp.jis", "iso2022-jp"}, - {"ja_jp.mscode", "shiftjis"}, - {"ja_jp.sjis", "shiftjis"}, - {"ja_jp.ujis", "euc-jp"}, - {"japan", "euc-jp"}, -#ifdef hpux - {"japanese", "shiftjis"}, -#else - {"japanese", "euc-jp"}, -#endif - {"japanese-sjis", "shiftjis"}, - {"japanese-ujis", "euc-jp"}, - {"japanese.euc", "euc-jp"}, - {"japanese.sjis", "shiftjis"}, + {"iso88591", "iso8859-1"}, + {"iso885915", "iso8859-15"}, + {"iso88592", "iso8859-2"}, + {"iso88595", "iso8859-5"}, + {"iso88596", "iso8859-6"}, + {"iso88597", "iso8859-7"}, + {"iso88598", "iso8859-8"}, + {"iso88599", "iso8859-9"}, +#ifdef hpux + {"ja", "shiftjis"}, +#else + {"ja", "euc-jp"}, +#endif + {"ja_jp", "euc-jp"}, + {"ja_jp.euc", "euc-jp"}, + {"ja_jp.eucjp", "euc-jp"}, + {"ja_jp.jis", "iso2022-jp"}, + {"ja_jp.mscode", "shiftjis"}, + {"ja_jp.sjis", "shiftjis"}, + {"ja_jp.ujis", "euc-jp"}, + {"japan", "euc-jp"}, +#ifdef hpux + {"japanese", "shiftjis"}, +#else + {"japanese", "euc-jp"}, +#endif + {"japanese-sjis", "shiftjis"}, + {"japanese-ujis", "euc-jp"}, + {"japanese.euc", "euc-jp"}, + {"japanese.sjis", "shiftjis"}, {"jis0201", "jis0201"}, {"jis0208", "jis0208"}, {"jis0212", "jis0212"}, - {"jp_jp", "shiftjis"}, - {"ko", "euc-kr"}, - {"ko_kr", "euc-kr"}, - {"ko_kr.euc", "euc-kr"}, - {"ko_kw.euckw", "euc-kr"}, + {"jp_jp", "shiftjis"}, + {"ko", "euc-kr"}, + {"ko_kr", "euc-kr"}, + {"ko_kr.euc", "euc-kr"}, + {"ko_kw.euckw", "euc-kr"}, {"koi8-r", "koi8-r"}, {"koi8-u", "koi8-u"}, - {"korean", "euc-kr"}, + {"korean", "euc-kr"}, {"ksc5601", "ksc5601"}, {"maccenteuro", "macCentEuro"}, {"maccroatian", "macCroatian"}, {"maccyrillic", "macCyrillic"}, {"macdingbats", "macDingbats"}, @@ -289,27 +296,27 @@ {"macroman", "macRoman"}, {"macromania", "macRomania"}, {"macthai", "macThai"}, {"macturkish", "macTurkish"}, {"macukraine", "macUkraine"}, - {"roman8", "iso8859-1"}, - {"ru", "iso8859-5"}, - {"ru_ru", "iso8859-5"}, - {"ru_su", "iso8859-5"}, + {"roman8", "iso8859-1"}, + {"ru", "iso8859-5"}, + {"ru_ru", "iso8859-5"}, + {"ru_su", "iso8859-5"}, {"shiftjis", "shiftjis"}, - {"sjis", "shiftjis"}, + {"sjis", "shiftjis"}, {"symbol", "symbol"}, {"tis-620", "tis-620"}, - {"tis620", "tis-620"}, - {"turkish8", "cp857"}, - {"utf8", "utf-8"}, - {"zh", "cp936"}, - {"zh_cn.gb2312", "euc-cn"}, - {"zh_cn.gbk", "euc-cn"}, - {"zh_cz.gb2312", "euc-cn"}, - {"zh_tw", "euc-tw"}, - {"zh_tw.big5", "big5"}, + {"tis620", "tis-620"}, + {"turkish8", "cp857"}, + {"utf8", "utf-8"}, + {"zh", "cp936"}, + {"zh_cn.gb2312", "euc-cn"}, + {"zh_cn.gbk", "euc-cn"}, + {"zh_cz.gb2312", "euc-cn"}, + {"zh_tw", "euc-tw"}, + {"zh_tw.big5", "big5"}, }; #ifdef HAVE_COREFOUNDATION static int MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath); @@ -333,11 +340,11 @@ /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals and + * Initialize all the platform-dependent things like signals and * floating-point error handling. * * Called at process initialization time. * * Results: @@ -409,11 +416,11 @@ setlocale(LC_CTYPE, ""); /* * In case the initial locale is not "C", ensure that the numeric * processing is done in "C" locale regardless. This is needed because Tcl - * relies on routines like strtod, but should not have locale dependent + * relies on routines like strtol/strtoul, but should not have locale dependent * behavior. */ setlocale(LC_NUMERIC, "C"); @@ -446,11 +453,11 @@ */ void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 Tcl_Obj *pathPtr, *objPtr; const char *str; @@ -503,11 +510,11 @@ pathv[pathc - 1] = installLib + 4; str = Tcl_JoinPath(pathc, pathv, &ds); Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds)); } - Tcl_Free(pathv); + ckfree(pathv); } /* * Finally, look for the library relative to the compiled-in path. This is * needed when users install Tcl with an exec-prefix that is different @@ -535,12 +542,13 @@ } } Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = TclGetStringFromObj(pathPtr, lengthPtr); - *valuePtr = Tcl_Alloc(*lengthPtr + 1); + str = TclGetString(pathPtr); + *lengthPtr = pathPtr->length; + *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, str, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } /* @@ -876,11 +884,12 @@ osInfoInitialized = 1; } GetSystemInfo(&sysInfo); - Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "os", + "Windows NT", TCL_GLOBAL_ONLY); sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sysInfo.wProcessorArchitecture], @@ -978,31 +987,31 @@ * Locate the entry in environ for a given name. On Unix this routine is * case sensetive, on Windows this matches mixed case. * * Results: * The return value is the index in environ of an entry with the name - * "name", or TCL_IO_FAILURE if there is no such entry. The integer at *lengthPtr is + * "name", or -1 if there is no such entry. The integer at *lengthPtr is * filled in with the length of name (if a matching entry is found) or * the length of the environ array (if no matching entry is found). * * Side effects: * None. * *---------------------------------------------------------------------- */ -size_t +int TclpFindVariable( const char *name, /* Name of desired environment variable * (native). */ - size_t *lengthPtr) /* Used to return length of name (for + int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - size_t i, result = TCL_IO_FAILURE; - register const char *env, *p1, *p2; + int i, result = -1; + const char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); @@ -1043,30 +1052,35 @@ * *---------------------------------------------------------------------- */ #ifdef HAVE_COREFOUNDATION +#ifdef TCL_FRAMEWORK static int MacOSXGetLibraryPath( Tcl_Interp *interp, int maxPathLen, char *tclLibPath) { - int foundInFramework = TCL_ERROR; - -#ifdef TCL_FRAMEWORK - foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, + return Tcl_MacOSXOpenVersionedBundleResources(interp, "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath); -#endif - - return foundInFramework; +} +#else +static int +MacOSXGetLibraryPath( + TCL_UNUSED(Tcl_Interp *), + TCL_UNUSED(int), + TCL_UNUSED(char *)) +{ + return TCL_ERROR; } +#endif #endif /* HAVE_COREFOUNDATION */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: unix/tclUnixNotfy.c ================================================================== --- unix/tclUnixNotfy.c +++ unix/tclUnixNotfy.c @@ -106,11 +106,11 @@ tclNotifierHooks.alertNotifierProc(clientData); return; } else { #ifdef NOTIFIER_SELECT #if TCL_THREADS - ThreadSpecificData *tsdPtr = clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; pthread_mutex_lock(¬ifierMutex); tsdPtr->eventReady = 1; # ifdef __CYGWIN__ @@ -119,11 +119,11 @@ pthread_cond_broadcast(&tsdPtr->waitCV); # endif /* __CYGWIN__ */ pthread_mutex_unlock(¬ifierMutex); #endif /* TCL_THREADS */ #else /* !NOTIFIER_SELECT */ - ThreadSpecificData *tsdPtr = clientData; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; #if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD) uint64_t eventFdVal = 1; if (write(tsdPtr->triggerEventFd, &eventFdVal, sizeof(eventFdVal)) != sizeof(eventFdVal)) { Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd", Index: unix/tclUnixPipe.c ================================================================== --- unix/tclUnixPipe.c +++ unix/tclUnixPipe.c @@ -46,20 +46,20 @@ /* * Declarations for local functions defined in this file: */ -static int PipeBlockModeProc(ClientData instanceData, int mode); -static int PipeClose2Proc(ClientData instanceData, +static int PipeBlockModeProc(void *instanceData, int mode); +static int PipeClose2Proc(void *instanceData, Tcl_Interp *interp, int flags); -static int PipeGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int PipeInputProc(ClientData instanceData, char *buf, +static int PipeGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int PipeInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int PipeOutputProc(ClientData instanceData, +static int PipeOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static void PipeWatchProc(ClientData instanceData, int mask); +static void PipeWatchProc(void *instanceData, int mask); static void RestoreSignals(void); static int SetupStdFile(TclFile file, int type); /* * This structure describes the channel type structure for command pipe based @@ -105,11 +105,11 @@ TclFile TclpMakeFile( Tcl_Channel channel, /* Channel to get file from. */ int direction) /* Either TCL_READABLE or TCL_WRITABLE. */ { - ClientData data; + void *data; if (Tcl_GetChannelHandle(channel, direction, &data) != TCL_OK) { return NULL; } @@ -266,11 +266,11 @@ */ Tcl_Obj * TclpTempFileNameForLibrary( Tcl_Interp *interp, /* Tcl interpreter. */ - Tcl_Obj *path) /* Path name of the library in the VFS. */ + TCL_UNUSED(Tcl_Obj *) /*path*/) { Tcl_Obj *retval = TclpTempFileName(); if (retval == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -372,11 +372,10 @@ * A process is created. * *--------------------------------------------------------------------------- */ - /* ARGSUSED */ int TclpCreateProcess( Tcl_Interp *interp, /* Interpreter in which to leave errors that * occurred when creating the child process. * Error messages from the child process @@ -430,12 +429,12 @@ /* * We need to allocate and convert this before the fork so it is properly * deallocated later */ - dsArray = TclStackAlloc(interp, argc * sizeof(Tcl_DString)); - newArgv = TclStackAlloc(interp, (argc+1) * sizeof(char *)); + dsArray = (Tcl_DString *)TclStackAlloc(interp, argc * sizeof(Tcl_DString)); + newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *)); newArgv[argc] = NULL; for (i = 0; i < argc; i++) { newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]); } @@ -522,11 +521,11 @@ TclpCloseFile(errPipeOut); errPipeOut = NULL; fd = GetFd(errPipeIn); - count = read(fd, errSpace, sizeof(errSpace) - 1); + count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1)); if (count > 0) { char *end; errSpace[count] = 0; errno = strtol(errSpace, &end, 10); @@ -742,11 +741,11 @@ * closed or the processes are detached (in a * background exec). */ { char channelName[16 + TCL_INTEGER_SPACE]; int channelId; - PipeState *statePtr = Tcl_Alloc(sizeof(PipeState)); + PipeState *statePtr = (PipeState *)ckalloc(sizeof(PipeState)); int mode; statePtr->inFile = readFile; statePtr->outFile = writeFile; statePtr->errorFile = errorFile; @@ -808,11 +807,11 @@ int Tcl_CreatePipe( Tcl_Interp *interp, /* Errors returned in result. */ Tcl_Channel *rchan, /* Returned read side. */ Tcl_Channel *wchan, /* Returned write side. */ - int flags) /* Reserved for future use. */ + TCL_UNUSED(int) /*flags*/) /* Reserved for future use. */ { int fileNums[2]; if (pipe(fileNums) < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s", @@ -867,20 +866,20 @@ chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { return; } - pipePtr = Tcl_GetChannelInstanceData(chan); + pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj( PTR2INT(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - Tcl_Free(pipePtr->pidPtr); + ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; } } /* @@ -898,19 +897,18 @@ * Sets the device into blocking or non-blocking mode. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int PipeBlockModeProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - PipeState *psPtr = instanceData; + PipeState *psPtr = (PipeState *)instanceData; if (psPtr->inFile && TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) { return errno; } @@ -941,15 +939,15 @@ *---------------------------------------------------------------------- */ static int PipeClose2Proc( - ClientData instanceData, /* The pipe to close. */ + void *instanceData, /* The pipe to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { - PipeState *pipePtr = instanceData; + PipeState *pipePtr = (PipeState *)instanceData; Tcl_Channel errChan; int errorCode, result; errorCode = 0; result = 0; @@ -1007,13 +1005,13 @@ result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr, errChan); } if (pipePtr->numPids != 0) { - Tcl_Free(pipePtr->pidPtr); + ckfree(pipePtr->pidPtr); } - Tcl_Free(pipePtr); + ckfree(pipePtr); if (errorCode == 0) { return result; } return errorCode; } @@ -1036,17 +1034,17 @@ *---------------------------------------------------------------------- */ static int PipeInputProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { - PipeState *psPtr = instanceData; + PipeState *psPtr = (PipeState *)instanceData; int bytesRead; /* How many bytes were actually read from the * input device? */ *errorCodePtr = 0; @@ -1057,11 +1055,11 @@ * nonblocking, the read will never block. Some OSes can throw an * interrupt error, for which we should immediately retry. [Bug #415131] */ do { - bytesRead = read(GetFd(psPtr->inFile), buf, toRead); + bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { *errorCodePtr = errno; return -1; @@ -1087,16 +1085,16 @@ *---------------------------------------------------------------------- */ static int PipeOutputProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { - PipeState *psPtr = instanceData; + PipeState *psPtr = (PipeState *)instanceData; int written; *errorCodePtr = 0; /* @@ -1103,11 +1101,11 @@ * Some OSes can throw an interrupt error, for which we should immediately * retry. [Bug #415131] */ do { - written = write(GetFd(psPtr->outFile), buf, toWrite); + written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite); } while ((written < 0) && (errno == EINTR)); if (written < 0) { *errorCodePtr = errno; return -1; @@ -1132,16 +1130,16 @@ *---------------------------------------------------------------------- */ static void PipeWatchProc( - ClientData instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - PipeState *psPtr = instanceData; + PipeState *psPtr = (PipeState *)instanceData; int newmask; if (psPtr->inFile) { newmask = mask & (TCL_READABLE | TCL_EXCEPTION); if (newmask) { @@ -1180,15 +1178,15 @@ *---------------------------------------------------------------------- */ static int PipeGetHandleProc( - ClientData instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { - PipeState *psPtr = instanceData; + PipeState *psPtr = (PipeState *)instanceData; if (direction == TCL_READABLE && psPtr->inFile) { *handlePtr = INT2PTR(GetFd(psPtr->inFile)); return TCL_OK; } @@ -1247,14 +1245,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_PidObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; @@ -1272,11 +1269,11 @@ } else { /* * Get the channel and make sure that it refers to a pipe. */ - chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); + chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == NULL) { return TCL_ERROR; } if (Tcl_GetChannelType(chan) != &pipeChannelType) { return TCL_OK; @@ -1284,11 +1281,11 @@ /* * Extract the process IDs from the pipe structure. */ - pipePtr = Tcl_GetChannelInstanceData(chan); + pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan); resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); } Index: unix/tclUnixPort.h ================================================================== --- unix/tclUnixPort.h +++ unix/tclUnixPort.h @@ -84,47 +84,53 @@ # define TclOSseek lseek # define TclOSopen open #endif #ifdef __CYGWIN__ - +#ifdef __cplusplus +extern "C" { +#endif /* Make some symbols available without including */ # define DWORD unsigned int # define CP_UTF8 65001 # define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 # define HANDLE void * # define HINSTANCE void * # define SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; - __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *); - __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const char *, int); +#ifdef __clang__ +#pragma clang diagnostic push +#pragma clang diagnostic ignored "-Wignored-attributes" +#endif + __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const void *, void *); + __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const void *, int); __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const void *, int, char *, int, const char *, void *); __declspec(dllimport) extern __stdcall int MultiByteToWideChar(int, int, const char *, int, WCHAR *, int); __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *); - __declspec(dllimport) extern __stdcall int IsDebuggerPresent(); - __declspec(dllimport) extern __stdcall int GetLastError(); + __declspec(dllimport) extern __stdcall int IsDebuggerPresent(void); + __declspec(dllimport) extern __stdcall int GetLastError(void); __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *); __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int); - __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int); -/* On Cygwin, the environment is imported from the Cygwin DLL. */ -#ifndef __x86_64__ -# define environ __cygwin_environ - extern char **__cygwin_environ; +#ifdef __clang__ +#pragma clang diagnostic pop #endif # define timezone _timezone extern int TclOSstat(const char *name, void *statBuf); extern int TclOSlstat(const char *name, void *statBuf); +#ifdef __cplusplus +} +#endif #elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) -# define TclOSstat stat64 -# define TclOSlstat lstat64 +# define TclOSstat(name, buf) stat64(name, (struct stat64 *)buf) +# define TclOSlstat(name,buf) lstat64(name, (struct stat64 *)buf) #else -# define TclOSstat stat -# define TclOSlstat lstat +# define TclOSstat(name, buf) stat(name, (struct stat *)buf) +# define TclOSlstat(name, buf) lstat(name, (struct stat *)buf) #endif /* *--------------------------------------------------------------------------- * Miscellaneous includes that might be missing. @@ -153,10 +159,12 @@ # include #endif #include #ifdef HAVE_STDINT_H # include +#else +# include "../compat/stdint.h" #endif #include MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); @@ -238,33 +246,33 @@ * in header files above. *--------------------------------------------------------------------------- */ #ifndef WIFEXITED -# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0) +# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xFF) == 0) #endif #ifndef WEXITSTATUS -# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) +# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xFF) #endif #ifndef WIFSIGNALED # define WIFSIGNALED(stat) \ (((*((int *) &(stat)))) && ((*((int *) &(stat))) \ - == ((*((int *) &(stat))) & 0x00ff))) + == ((*((int *) &(stat))) & 0x00FF))) #endif #ifndef WTERMSIG -# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) +# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7F) #endif #ifndef WIFSTOPPED -# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177) +# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xFF) == 0177) #endif #ifndef WSTOPSIG -# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) +# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xFF) #endif /* *--------------------------------------------------------------------------- * Define constants for waitpid() system call if they aren't defined by a @@ -669,13 +677,13 @@ *--------------------------------------------------------------------------- * The following defines wrap the system memory allocation routines. *--------------------------------------------------------------------------- */ -#define TclpSysAlloc(size) malloc(size) -#define TclpSysFree(ptr) free(ptr) -#define TclpSysRealloc(ptr, size) realloc(ptr, size) +#define TclpSysAlloc(size, isBin) malloc((size_t)(size)) +#define TclpSysFree(ptr) free((char *)(ptr)) +#define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size)) /* *--------------------------------------------------------------------------- * The following macros and declaration wrap the C runtime library functions. *--------------------------------------------------------------------------- Index: unix/tclUnixSock.c ================================================================== --- unix/tclUnixSock.c +++ unix/tclUnixSock.c @@ -64,11 +64,11 @@ * Only needed for server sockets */ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */ - ClientData acceptProcData; /* The data for the accept proc. */ + void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets */ @@ -127,39 +127,45 @@ /* * Static routines for this file: */ +static void TcpAsyncCallback(void *clientData, int mask); static int TcpConnect(Tcl_Interp *interp, TcpState *state); -static void TcpAccept(ClientData data, int mask); -static int TcpBlockModeProc(ClientData data, int mode); -static int TcpCloseProc(ClientData instanceData, +static void TcpAccept(void *data, int mask); +static int TcpBlockModeProc(void *data, int mode); +static int TcpCloseProc(void *instanceData, Tcl_Interp *interp); -static int TcpClose2Proc(ClientData instanceData, +static int TcpClose2Proc(void *instanceData, Tcl_Interp *interp, int flags); -static int TcpGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int TcpGetOptionProc(ClientData instanceData, +static int TcpGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int TcpGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static int TcpInputProc(ClientData instanceData, char *buf, +static int TcpInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int TcpOutputProc(ClientData instanceData, +static int TcpOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static void TcpWatchProc(ClientData instanceData, int mask); +static void TcpThreadActionProc(void *instanceData, int action); +static void TcpWatchProc(void *instanceData, int mask); static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); -static void WrapNotify(ClientData clientData, int mask); +static void WrapNotify(void *clientData, int mask); /* * This structure describes the channel type structure for TCP socket * based IO: */ static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ +#ifndef TCL_NO_DEPRECATED TcpCloseProc, /* Close proc. */ +#else + TCL_CLOSE2PROC, /* Close proc. */ +#endif TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ @@ -168,11 +174,11 @@ TcpClose2Proc, /* Close2 proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc. */ - NULL, /* thread action proc. */ + TcpThreadActionProc, /* thread action proc. */ NULL /* truncate proc. */ }; /* * The following variable holds the network name of this host. @@ -215,11 +221,11 @@ */ static void InitializeHostName( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; #ifndef NO_UNAME @@ -237,16 +243,16 @@ */ char *dot = strchr(u.nodename, '.'); if (dot != NULL) { - char *node = Tcl_Alloc(dot - u.nodename + 1); + char *node = (char *)ckalloc(dot - u.nodename + 1); memcpy(node, u.nodename, dot - u.nodename); node[dot - u.nodename] = '\0'; hp = TclpGetHostByName(node); - Tcl_Free(node); + ckfree(node); } } if (hp != NULL) { native = hp->h_name; } else { @@ -281,15 +287,15 @@ #endif /* NO_UNAME */ *encodingPtr = Tcl_GetEncoding(NULL, NULL); if (native) { *lengthPtr = strlen(native); - *valuePtr = Tcl_Alloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, native, *lengthPtr + 1); } else { *lengthPtr = 0; - *valuePtr = Tcl_Alloc(1); + *valuePtr = (char *)ckalloc(1); *valuePtr[0] = '\0'; } } /* @@ -311,12 +317,11 @@ */ const char * Tcl_GetHostName(void) { - Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName); - return TclGetString(tclObj); + return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); } /* * ---------------------------------------------------------------------- * @@ -333,11 +338,11 @@ * ---------------------------------------------------------------------- */ int TclpHasSockets( - Tcl_Interp *interp) /* Not used. */ + TCL_UNUSED(Tcl_Interp *)) { return TCL_OK; } /* @@ -377,19 +382,18 @@ * Sets the device into blocking or nonblocking mode. * * ---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpBlockModeProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; if (mode == TCL_MODE_BLOCKING) { CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } else { SET_BITS(statePtr->flags, TCP_NONBLOCKING); @@ -523,27 +527,26 @@ * Reads input from the input device of the channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpInputProc( - ClientData instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int bytesRead; *errorCodePtr = 0; if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } - bytesRead = recv(statePtr->fds.fd, buf, bufSize, 0); + bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0); if (bytesRead > -1) { return bytesRead; } if (errno == ECONNRESET) { /* @@ -577,23 +580,23 @@ *---------------------------------------------------------------------- */ static int TcpOutputProc( - ClientData 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. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int written; *errorCodePtr = 0; if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } - written = send(statePtr->fds.fd, buf, toWrite, 0); + written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0); if (written > -1) { return written; } *errorCodePtr = errno; @@ -616,17 +619,16 @@ * Closes the socket of the channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpCloseProc( - ClientData instanceData, /* The socket to close. */ - Tcl_Interp *interp) /* For error reporting - unused. */ + void *instanceData, /* The socket to close. */ + TCL_UNUSED(Tcl_Interp *)) { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int errorCode = 0; TcpFdList *fds; /* * Delete a file handler that may be active for this socket if this is a @@ -648,20 +650,20 @@ } fds = statePtr->fds.next; while (fds != NULL) { TcpFdList *next = fds->next; - Tcl_Free(fds); + ckfree(fds); fds = next; } if (statePtr->addrlist != NULL) { freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { freeaddrinfo(statePtr->myaddrlist); } - Tcl_Free(statePtr); + ckfree(statePtr); return errorCode; } /* *---------------------------------------------------------------------- @@ -680,41 +682,31 @@ *---------------------------------------------------------------------- */ static int TcpClose2Proc( - ClientData instanceData, /* The socket to close. */ - Tcl_Interp *interp, /* For error reporting. */ + void *instanceData, /* The socket to close. */ + TCL_UNUSED(Tcl_Interp *), int flags) /* Flags that indicate which side to close. */ { - TcpState *statePtr = instanceData; - int errorCode = 0; - int sd; + TcpState *statePtr = (TcpState *)instanceData; + int readError = 0; + int writeError = 0; /* * Shutdown the OS socket handle. */ - - switch(flags) { - case TCL_CLOSE_READ: - sd = SHUT_RD; - break; - case TCL_CLOSE_WRITE: - sd = SHUT_WR; - break; - default: - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "socket close2proc called bidirectionally", -1)); - } - return TCL_ERROR; - } - if (shutdown(statePtr->fds.fd,sd) < 0) { - errorCode = errno; - } - - return errorCode; + if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { + return TcpCloseProc(instanceData, NULL); + } + if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) { + readError = errno; + } + if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0)) { + writeError = errno; + } + return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * @@ -841,19 +833,19 @@ *---------------------------------------------------------------------- */ static int TcpGetOptionProc( - ClientData 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 * values. */ Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; size_t len = 0; WaitForConnect(statePtr, NULL); if (optionName != NULL) { @@ -991,10 +983,55 @@ } /* * ---------------------------------------------------------------------- * + * TcpThreadActionProc -- + * + * Handles detach/attach for asynchronously connecting socket. + * + * Reassigning the file handler associated with thread-related channel + * notification, responsible for callbacks (signaling that asynchronous + * connection attempt has succeeded or failed). + * + * Results: + * None. + * + * ---------------------------------------------------------------------- + */ + +static void +TcpThreadActionProc( + void *instanceData, + int action) +{ + TcpState *statePtr = (TcpState *)instanceData; + + if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { + /* + * Async-connecting socket must get reassigned handler if it have been + * transferred to another thread. Remove the handler if the socket is + * not managed by this thread anymore and create new handler (TSD related) + * so the callback will run in the correct thread, bug [f583715154]. + */ + switch (action) { + case TCL_CHANNEL_THREAD_REMOVE: + CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); + Tcl_DeleteFileHandler(statePtr->fds.fd); + break; + case TCL_CHANNEL_THREAD_INSERT: + Tcl_CreateFileHandler(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, statePtr); + SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); + break; + } + } +} + +/* + * ---------------------------------------------------------------------- + * * TcpWatchProc -- * * Initialize the notifier to watch the fd from this channel. * * Results: @@ -1007,11 +1044,11 @@ * ---------------------------------------------------------------------- */ static void WrapNotify( - ClientData clientData, + void *clientData, int mask) { TcpState *statePtr = (TcpState *) clientData; int newmask = mask & statePtr->interest; @@ -1036,16 +1073,16 @@ Tcl_NotifyChannel(statePtr->channel, newmask); } static void TcpWatchProc( - ClientData 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. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; if (statePtr->acceptProc != NULL) { /* * Make sure we don't mess with server sockets since they will never * be readable or writable at the Tcl level. This keeps Tcl scripts @@ -1107,18 +1144,17 @@ * None. * * ---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpGetHandleProc( - ClientData instanceData, /* The socket state. */ - int direction, /* Not used. */ - ClientData *handlePtr) /* Where to store the handle. */ + void *instanceData, /* The socket state. */ + TCL_UNUSED(int) /*direction*/, + void **handlePtr) /* Where to store the handle. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->fds.fd); return TCL_OK; } @@ -1134,16 +1170,14 @@ * ---------------------------------------------------------------------- */ static void TcpAsyncCallback( - ClientData clientData, /* The socket state. */ - int mask) /* Events of interest; an OR-ed combination of - * TCL_READABLE, TCL_WRITABLE and - * TCL_EXCEPTION. */ + void *clientData, /* The socket state. */ + TCL_UNUSED(int) /*mask*/) { - TcpConnect(NULL, clientData); + TcpConnect(NULL, (TcpState *)clientData); } /* * ---------------------------------------------------------------------- * @@ -1181,10 +1215,11 @@ { socklen_t optlen; int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); int ret = -1, error = EHOSTUNREACH; int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); + static const int reuseaddr = 1; if (async_callback) { goto reenter; } @@ -1191,11 +1226,10 @@ for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; statePtr->addr = statePtr->addr->ai_next) { for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; statePtr->myaddr = statePtr->myaddr->ai_next) { - int reuseaddr = 1; /* * No need to try combinations of local and remote addresses of * different families. */ @@ -1398,11 +1432,11 @@ /* * Allocate a new TcpState for this socket. */ - statePtr = Tcl_Alloc(sizeof(TcpState)); + statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->flags = async ? TCP_ASYNC_CONNECT : 0; statePtr->cachedBlocking = TCL_MODE_BLOCKING; statePtr->addrlist = addrlist; statePtr->myaddrlist = myaddrlist; @@ -1445,11 +1479,11 @@ *---------------------------------------------------------------------- */ Tcl_Channel Tcl_MakeTcpClientChannel( - ClientData sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock, TCL_READABLE | TCL_WRITABLE); } @@ -1477,11 +1511,11 @@ * TCL_WRITABLE to indicate file mode. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; - statePtr = Tcl_Alloc(sizeof(TcpState)); + statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->fds.fd = PTR2INT(sock); statePtr->flags = 0; sprintf(channelName, SOCK_TEMPLATE, (long)statePtr); @@ -1520,11 +1554,11 @@ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ - ClientData acceptProcData) /* Data for the callback. */ + void *acceptProcData) /* Data for the callback. */ { int status = 0, sock = -1, optvalue, port, chosenport; struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */ TcpState *statePtr = NULL; char channelName[SOCK_CHAN_LENGTH]; @@ -1700,18 +1734,18 @@ if (statePtr == NULL) { /* * Allocate a new TcpState for this socket. */ - statePtr = Tcl_Alloc(sizeof(TcpState)); + statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; sprintf(channelName, SOCK_TEMPLATE, (long) statePtr); newfds = &statePtr->fds; } else { - newfds = Tcl_Alloc(sizeof(TcpFdList)); + newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList)); memset(newfds, (int) 0, sizeof(TcpFdList)); fds->next = newfds; } newfds->fd = sock; newfds->statePtr = statePtr; @@ -1765,17 +1799,16 @@ * connection acceptance mechanism. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void TcpAccept( - ClientData data, /* Callback token. */ - int mask) /* Not used. */ + void *data, /* Callback token. */ + TCL_UNUSED(int) /*mask*/) { - TcpFdList *fds = data; /* Client data of server socket. */ + TcpFdList *fds = (TcpFdList *)data; /* Client data of server socket. */ int newsock; /* The new client socket */ TcpState *newSockState; /* State for new socket. */ address addr; /* The remote address */ socklen_t len; /* For accept interface */ char channelName[SOCK_CHAN_LENGTH]; @@ -1792,11 +1825,11 @@ * inherited by child processes. */ (void) fcntl(newsock, F_SETFD, FD_CLOEXEC); - newSockState = Tcl_Alloc(sizeof(TcpState)); + newSockState = (TcpState *)ckalloc(sizeof(TcpState)); memset(newSockState, 0, sizeof(TcpState)); newSockState->flags = 0; newSockState->fds.fd = newsock; sprintf(channelName, SOCK_TEMPLATE, (long) newSockState); Index: unix/tclUnixTest.c ================================================================== --- unix/tclUnixTest.c +++ unix/tclUnixTest.c @@ -60,20 +60,17 @@ /* * Forward declarations of functions defined later in this file: */ -static Tcl_CmdProc TestalarmCmd; +static Tcl_ObjCmdProc TestalarmCmd; static Tcl_ObjCmdProc TestchmodCmd; -static Tcl_CmdProc TestfilehandlerCmd; -static Tcl_CmdProc TestfilewaitCmd; -static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_ObjCmdProc TestforkObjCmd; -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_CmdProc TestgetopenfileCmd; -static Tcl_CmdProc TestgotsigCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; +static Tcl_ObjCmdProc TestfilehandlerCmd; +static Tcl_ObjCmdProc TestfilewaitCmd; +static Tcl_ObjCmdProc TestfindexecutableCmd; +static Tcl_ObjCmdProc TestforkCmd; +static Tcl_ObjCmdProc TestgotsigCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- @@ -96,27 +93,21 @@ TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, + Tcl_CreateObjCommand(interp, "testfilehandler", TestfilehandlerCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testfilewait", TestfilewaitCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testfindexecutable", TestfindexecutableCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testfork", TestforkCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testalarm", TestalarmCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testgotsig", TestgotsigCmd, NULL, NULL); return TCL_OK; } /* @@ -136,14 +127,14 @@ *---------------------------------------------------------------------- */ static int TestfilehandlerCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { Pipe *pipePtr; int i, mask, timeout; static int initialized = 0; char buffer[4000]; @@ -159,57 +150,53 @@ testPipes[i].readFile = NULL; } initialized = 1; } - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ..."); return TCL_ERROR; } pipePtr = NULL; - if (argc >= 3) { - if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) { + if (objc >= 3) { + if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) { return TCL_ERROR; } if (i >= MAX_PIPES) { - Tcl_AppendResult(interp, "bad index ", argv[2], NULL); + Tcl_AppendResult(interp, "bad index ", objv[2], NULL); return TCL_ERROR; } pipePtr = &testPipes[i]; } - if (strcmp(argv[1], "close") == 0) { + if (strcmp(Tcl_GetString(objv[1]), "close") == 0) { for (i = 0; i < MAX_PIPES; i++) { if (testPipes[i].readFile != NULL) { TclpCloseFile(testPipes[i].readFile); testPipes[i].readFile = NULL; TclpCloseFile(testPipes[i].writeFile); testPipes[i].writeFile = NULL; } } - } else if (strcmp(argv[1], "clear") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " clear index\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "clear") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } pipePtr->readCount = pipePtr->writeCount = 0; - } else if (strcmp(argv[1], "counts") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "counts") == 0) { char buf[TCL_INTEGER_SPACE * 2]; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " counts index\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); Tcl_AppendResult(interp, buf, NULL); - } else if (strcmp(argv[1], "create") == 0) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " create index readMode writeMode\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode"); return TCL_ERROR; } if (pipePtr->readFile == NULL) { if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) { Tcl_AppendResult(interp, "couldn't open pipe: ", @@ -226,100 +213,96 @@ #endif } pipePtr->readCount = 0; pipePtr->writeCount = 0; - if (strcmp(argv[3], "readable") == 0) { + if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE, TestFileHandlerProc, pipePtr); - } else if (strcmp(argv[3], "off") == 0) { + } else if (strcmp(Tcl_GetString(objv[3]), "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->readFile)); - } else if (strcmp(argv[3], "disabled") == 0) { + } else if (strcmp(Tcl_GetString(objv[3]), "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", NULL); return TCL_ERROR; } - if (strcmp(argv[4], "writable") == 0) { + if (strcmp(Tcl_GetString(objv[4]), "writable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE, TestFileHandlerProc, pipePtr); - } else if (strcmp(argv[4], "off") == 0) { + } else if (strcmp(Tcl_GetString(objv[4]), "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile)); - } else if (strcmp(argv[4], "disabled") == 0) { + } else if (strcmp(Tcl_GetString(objv[4]), "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", NULL); return TCL_ERROR; } - } else if (strcmp(argv[1], "empty") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " empty index\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "empty") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { /* Empty loop body. */ } - } else if (strcmp(argv[1], "fill") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fill index\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "fill") == 0) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } memset(buffer, 'a', 4000); - while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { + while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { /* Empty loop body. */ - } - } else if (strcmp(argv[1], "fillpartial") == 0) { + } + } else if (strcmp(Tcl_GetString(objv[1]), "fillpartial") == 0) { char buf[TCL_INTEGER_SPACE]; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fillpartial index\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "index"); return TCL_ERROR; } memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); Tcl_AppendResult(interp, buf, NULL); - } else if (strcmp(argv[1], "oneevent") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); - } else if (strcmp(argv[1], "wait") == 0) { - if (argc != 5) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " wait index readable|writable timeout\"", NULL); + } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "index readable|writable timeout"); + return TCL_ERROR; + } + if (pipePtr->readFile == NULL) { + Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", NULL); return TCL_ERROR; } - if (pipePtr->readFile == NULL) { - Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL); - return TCL_ERROR; - } - if (strcmp(argv[3], "readable") == 0) { + if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) { mask = TCL_READABLE; file = pipePtr->readFile; } else { mask = TCL_WRITABLE; file = pipePtr->writeFile; } - if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], &timeout) != TCL_OK) { return TCL_ERROR; } i = TclUnixWaitForFile(GetFd(file), mask, timeout); if (i & TCL_READABLE) { Tcl_AppendElement(interp, "readable"); } if (i & TCL_WRITABLE) { Tcl_AppendElement(interp, "writable"); } - } else if (strcmp(argv[1], "windowevent") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "windowevent") == 0) { Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be close, clear, counts, create, empty, fill, " "fillpartial, oneevent, wait, or windowevent", NULL); return TCL_ERROR; } return TCL_OK; @@ -329,11 +312,11 @@ TestFileHandlerProc( ClientData clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { - Pipe *pipePtr = clientData; + Pipe *pipePtr = (Pipe *)clientData; if (mask & TCL_READABLE) { pipePtr->readCount++; } if (mask & TCL_WRITABLE) { @@ -358,37 +341,36 @@ *---------------------------------------------------------------------- */ static int TestfilewaitCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; int fd; ClientData data; - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " file readable|writable|both timeout\"", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout"); return TCL_ERROR; } - channel = Tcl_GetChannel(interp, argv[1], NULL); + channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (channel == NULL) { return TCL_ERROR; } - if (strcmp(argv[2], "readable") == 0) { + if (strcmp(Tcl_GetString(objv[2]), "readable") == 0) { mask = TCL_READABLE; - } else if (strcmp(argv[2], "writable") == 0){ + } else if (strcmp(Tcl_GetString(objv[2]), "writable") == 0){ mask = TCL_WRITABLE; - } else if (strcmp(argv[2], "both") == 0){ + } else if (strcmp(Tcl_GetString(objv[2]), "both") == 0){ mask = TCL_WRITABLE|TCL_READABLE; } else { - Tcl_AppendResult(interp, "bad argument \"", argv[2], + Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]), "\": must be readable, writable, or both", NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, @@ -395,11 +377,11 @@ (ClientData*) &data) != TCL_OK) { Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } fd = PTR2INT(data); - if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], &timeout) != TCL_OK) { return TCL_ERROR; } result = TclUnixWaitForFile(fd, mask, timeout); if (result & TCL_READABLE) { Tcl_AppendElement(interp, "readable"); @@ -427,27 +409,26 @@ *---------------------------------------------------------------------- */ static int TestfindexecutableCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Obj *saveName; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " argv0\"", NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "argv0"); return TCL_ERROR; } saveName = TclGetObjNameOfExecutable(); Tcl_IncrRefCount(saveName); - TclpFindExecutable(argv[1]); + TclpFindExecutable(Tcl_GetString(objv[1])); Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); TclSetObjNameOfExecutable(saveName, NULL); Tcl_DecrRefCount(saveName); return TCL_OK; @@ -454,87 +435,11 @@ } /* *---------------------------------------------------------------------- * - * TestgetopenfileCmd -- - * - * This function implements the "testgetopenfile" command. It is used to - * get a FILE * value from a registered channel. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetopenfileCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - ClientData filePtr; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName forWriting\"", NULL); - return TCL_ERROR; - } - if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr) - == TCL_ERROR) { - return TCL_ERROR; - } - if (filePtr == NULL) { - Tcl_AppendResult(interp, - "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); - return TCL_ERROR; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestsetencpathCmd -- - * - * This function implements the "testsetencpath" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetencpathObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); - return TCL_ERROR; - } - - Tcl_SetEncodingSearchPath(objv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestforkObjCmd -- + * TestforkCmd -- * * This function implements the "testfork" command. It is used to * fork the Tcl process for specific test cases. * * Results: @@ -545,12 +450,12 @@ * *---------------------------------------------------------------------- */ static int -TestforkObjCmd( - ClientData clientData, /* Not used. */ +TestforkCmd( + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { pid_t pid; @@ -575,43 +480,10 @@ } /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- - * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetencpathObjCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestalarmCmd -- * * Test that EINTR is handled correctly by generating and handling a * signal. This requires using the SA_RESTART flag when registering the * signal handler. @@ -625,23 +497,21 @@ *---------------------------------------------------------------------- */ static int TestalarmCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { #ifdef SA_RESTART - unsigned int sec; + unsigned int sec = 1; struct sigaction action; - if (argc > 1) { - Tcl_GetInt(interp, argv[1], (int *)&sec); - } else { - sec = 1; + if (objc > 1) { + Tcl_GetIntFromObj(interp, objv[1], (int *)&sec); } /* * Setup the signal handling that automatically retries any interrupted * I/O system calls. @@ -656,10 +526,11 @@ return TCL_ERROR; } (void) alarm(sec); return TCL_OK; #else + Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL); return TCL_ERROR; #endif @@ -681,11 +552,11 @@ *---------------------------------------------------------------------- */ static void AlarmHandler( - int signum) + TCL_UNUSED(int) /*signum*/) { gotsig = "1"; } /* @@ -704,14 +575,14 @@ *---------------------------------------------------------------------- */ static int TestgotsigCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *)) { Tcl_AppendResult(interp, gotsig, NULL); gotsig = "0"; return TCL_OK; } @@ -735,11 +606,11 @@ *--------------------------------------------------------------------------- */ static int TestchmodCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { int i, mode; Index: unix/tclUnixThrd.c ================================================================== --- unix/tclUnixThrd.c +++ unix/tclUnixThrd.c @@ -158,10 +158,18 @@ { pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime); } #endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */ +#ifndef TCL_NO_DEPRECATED +typedef struct { + char nabuf[16]; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; +#endif /* TCL_NO_DEPRECATED */ + /* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. */ @@ -212,11 +220,11 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ ClientData clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + int stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #if TCL_THREADS pthread_attr_t attr; @@ -226,11 +234,11 @@ pthread_attr_init(&attr); pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); #ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE if (stackSize != TCL_THREAD_STACK_DEFAULT) { - pthread_attr_setstacksize(&attr, stackSize); + pthread_attr_setstacksize(&attr, (size_t) stackSize); #ifdef TCL_THREAD_STACK_MIN } else { /* * Certain systems define a thread stack size that by default is too * small for many operations. The user has the option of defining @@ -256,13 +264,13 @@ if (!(flags & TCL_THREAD_JOINABLE)) { pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); } if (pthread_create(&theThread, &attr, - (void * (*)(void *)) proc, (void *) clientData) && + (void * (*)(void *))(void *)proc, (void *) clientData) && pthread_create(&theThread, NULL, - (void * (*)(void *)) proc, (void *) clientData)) { + (void * (*)(void *))(void *)proc, (void *) clientData)) { result = TCL_ERROR; } else { *idPtr = (Tcl_ThreadId) theThread; result = TCL_OK; } @@ -567,11 +575,11 @@ if (*mutexPtr == NULL) { /* * Double inside master lock check to avoid a race condition. */ - pmutexPtr = Tcl_Alloc(sizeof(PMutex)); + pmutexPtr = (PMutex *)ckalloc(sizeof(PMutex)); PMutexInit(pmutexPtr); *mutexPtr = (Tcl_Mutex) pmutexPtr; TclRememberMutex(mutexPtr); } pthread_mutex_unlock(&masterLock); @@ -631,11 +639,11 @@ { PMutex *pmutexPtr = *(PMutex **) mutexPtr; if (pmutexPtr != NULL) { PMutexDestroy(pmutexPtr); - Tcl_Free(pmutexPtr); + ckfree(pmutexPtr); *mutexPtr = NULL; } } /* @@ -677,11 +685,11 @@ * Double check inside mutex to avoid race, then initialize condition * variable if necessary. */ if (*condPtr == NULL) { - pcondPtr = Tcl_Alloc(sizeof(pthread_cond_t)); + pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t)); pthread_cond_init(pcondPtr, NULL); *condPtr = (Tcl_Condition) pcondPtr; TclRememberCondition(condPtr); } pthread_mutex_unlock(&masterLock); @@ -765,15 +773,63 @@ { pthread_cond_t *pcondPtr = *(pthread_cond_t **) condPtr; if (pcondPtr != NULL) { pthread_cond_destroy(pcondPtr); - Tcl_Free(pcondPtr); + ckfree(pcondPtr); *condPtr = NULL; } } +#endif /* TCL_THREADS */ + +/* + *---------------------------------------------------------------------- + * + * TclpReaddir, TclpInetNtoa -- + * + * These procedures replace core C versions to be used in a threaded + * environment. + * + * Results: + * See documentation of C functions. + * + * Side effects: + * See documentation of C functions. + * + * Notes: + * TclpReaddir is no longer used by the core (see 1095909), but it + * appears in the internal stubs table (see #589526). + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +Tcl_DirEntry * +TclpReaddir( + TclDIR * dir) +{ + return TclOSreaddir(dir); +} + +#undef TclpInetNtoa +char * +TclpInetNtoa( + struct in_addr addr) +{ +#if TCL_THREADS + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + unsigned char *b = (unsigned char*) &addr.s_addr; + + sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); + return tsdPtr->nabuf; +#else + return inet_ntoa(addr); +#endif +} +#endif /* TCL_NO_DEPRECATED */ +#if TCL_THREADS /* * Additions by AOL for specialized thread memory allocator. */ #ifdef USE_THREAD_ALLOC @@ -786,13 +842,13 @@ Tcl_Mutex * TclpNewAllocMutex(void) { AllocMutex *lockPtr; - register PMutex *plockPtr; + PMutex *plockPtr; - lockPtr = malloc(sizeof(AllocMutex)); + lockPtr = (AllocMutex *)malloc(sizeof(AllocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } plockPtr = &lockPtr->plock; lockPtr->tlock = (Tcl_Mutex) plockPtr; @@ -859,11 +915,11 @@ void * TclpThreadCreateKey(void) { pthread_key_t *ptkeyPtr; - ptkeyPtr = TclpSysAlloc(sizeof(pthread_key_t)); + ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0); if (NULL == ptkeyPtr) { Tcl_Panic("unable to allocate thread key!"); } if (pthread_key_create(ptkeyPtr, NULL)) { @@ -875,11 +931,11 @@ void TclpThreadDeleteKey( void *keyPtr) { - pthread_key_t *ptkeyPtr = keyPtr; + pthread_key_t *ptkeyPtr = (pthread_key_t *)keyPtr; if (pthread_key_delete(*ptkeyPtr)) { Tcl_Panic("unable to delete key!"); } @@ -889,11 +945,11 @@ void TclpThreadSetMasterTSD( void *tsdKeyPtr, void *ptr) { - pthread_key_t *ptkeyPtr = tsdKeyPtr; + pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr; if (pthread_setspecific(*ptkeyPtr, ptr)) { Tcl_Panic("unable to set master TSD value"); } } @@ -900,11 +956,11 @@ void * TclpThreadGetMasterTSD( void *tsdKeyPtr) { - pthread_key_t *ptkeyPtr = tsdKeyPtr; + pthread_key_t *ptkeyPtr = (pthread_key_t*)tsdKeyPtr; return pthread_getspecific(*ptkeyPtr); } #endif /* TCL_THREADS */ Index: unix/tclUnixTime.c ================================================================== --- unix/tclUnixTime.c +++ unix/tclUnixTime.c @@ -9,18 +9,45 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include #if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL) #include #endif +/* + * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread + * safety, this structure must be in thread-specific data. The 'tmKey' + * variable is the key to this buffer. + */ + +#ifndef TCL_NO_DEPRECATED +static Tcl_ThreadDataKey tmKey; +typedef struct { + struct tm gmtime_buf; + struct tm localtime_buf; +} ThreadSpecificData; + +/* + * If we fall back on the thread-unsafe versions of gmtime and localtime, use + * this mutex to try to protect them. + */ + +TCL_DECLARE_MUTEX(tmMutex) + +static char *lastTZ = NULL; /* Holds the last setting of the TZ + * environment variable, or an empty string if + * the variable was not set. */ + /* * Static functions declared in this file. */ + +static void SetTZIfNecessary(void); +static void CleanupMemory(ClientData clientData); +#endif /* TCL_NO_DEPRECATED */ static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, ClientData clientData); @@ -29,11 +56,11 @@ * TIP #233 (Virtualized Time): Data for the time hooks, if any. */ Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; -ClientData tclTimeClientData = NULL; +void *tclTimeClientData = NULL; /* *---------------------------------------------------------------------- * * TclpGetSeconds -- @@ -48,11 +75,11 @@ * None. * *---------------------------------------------------------------------- */ -Tcl_WideUInt +unsigned long TclpGetSeconds(void) { return time(NULL); } @@ -88,11 +115,11 @@ * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no garantees on what the * resolution will be. In Tcl we will call this value a "click". The - * start time is also system dependant. + * start time is also system dependent. * * Results: * Number of clicks from some start time. * * Side effects: @@ -99,34 +126,34 @@ * None. * *---------------------------------------------------------------------- */ -Tcl_WideUInt +unsigned long TclpGetClicks(void) { - Tcl_WideUInt now; + unsigned long now; #ifdef NO_GETTOD if (tclGetTimeProcPtr != NativeGetTime) { Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); - now = (Tcl_WideUInt)time.sec*1000000 + time.usec; + now = time.sec*1000000 + time.usec; } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; - now = (Tcl_WideUInt) times(&dummy); + now = (unsigned long) times(&dummy); } #else Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); - now = (Tcl_WideUInt)time.sec*1000000 + time.usec; + now = time.sec*1000000 + time.usec; #endif return now; } #ifdef TCL_WIDE_CLICKS @@ -135,11 +162,11 @@ *---------------------------------------------------------------------- * * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest - * resolution clock available on the system. There are no guarantees on + * resolution clock available on the system. There are no garantees on * what the resolution will be. In Tcl we will call this value a "click". * The start time is also system dependent. * * Results: * Number of WideInt clicks from some start time. @@ -292,10 +319,120 @@ } /* *---------------------------------------------------------------------- * + * TclpGetDate -- + * + * This function converts between seconds and struct tm. If useGMT is + * true, then the returned date will be in Greenwich Mean Time (GMT). + * Otherwise, it will be in the local time zone. + * + * Results: + * Returns a static tm structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +struct tm * +TclpGetDate( + const time_t *time, + int useGMT) +{ + if (useGMT) { + return TclpGmtime(time); + } else { + return TclpLocaltime(time); + } +} + +/* + *---------------------------------------------------------------------- + * + * TclpGmtime -- + * + * Wrapper around the 'gmtime' library function to make it thread safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes gmtime or gmtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpGmtime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * Get a thread-local buffer to hold the returned time. + */ + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); + +#ifdef HAVE_GMTIME_R + gmtime_r(timePtr, &tsdPtr->gmtime_buf); +#else + Tcl_MutexLock(&tmMutex); + memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); + Tcl_MutexUnlock(&tmMutex); +#endif + + return &tsdPtr->gmtime_buf; +} + +/* + *---------------------------------------------------------------------- + * + * TclpLocaltime -- + * + * Wrapper around the 'localtime' library function to make it thread + * safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes localtime or localtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpLocaltime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * Get a thread-local buffer to hold the returned time. + */ + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); + + SetTZIfNecessary(); +#ifdef HAVE_LOCALTIME_R + localtime_r(timePtr, &tsdPtr->localtime_buf); +#else + Tcl_MutexLock(&tmMutex); + memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); + Tcl_MutexUnlock(&tmMutex); +#endif + + return &tsdPtr->localtime_buf; +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the * virtualization of Tcl's access to time information. * @@ -369,12 +506,12 @@ *---------------------------------------------------------------------- */ static void NativeScaleTime( - Tcl_Time *timePtr, - ClientData clientData) + TCL_UNUSED(Tcl_Time *), + TCL_UNUSED(ClientData)) { /* Native scale is 1:1. Nothing is done */ } /* @@ -395,21 +532,87 @@ */ static void NativeGetTime( Tcl_Time *timePtr, - ClientData clientData) + TCL_UNUSED(ClientData)) { struct timeval tv; (void) gettimeofday(&tv, NULL); timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } +/* + *---------------------------------------------------------------------- + * + * SetTZIfNecessary -- + * + * Determines whether a call to 'tzset' is needed prior to the next call + * to 'localtime' or examination of the 'timezone' variable. + * + * Results: + * None. + * + * Side effects: + * If 'tzset' has never been called in the current process, or if the + * value of the environment variable TZ has changed since the last call + * to 'tzset', then 'tzset' is called again. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +static void +SetTZIfNecessary(void) +{ + const char *newTZ = getenv("TZ"); + + Tcl_MutexLock(&tmMutex); + if (newTZ == NULL) { + newTZ = ""; + } + if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { + tzset(); + if (lastTZ == NULL) { + Tcl_CreateExitHandler(CleanupMemory, NULL); + } else { + ckfree(lastTZ); + } + lastTZ = (char *)ckalloc(strlen(newTZ) + 1); + strcpy(lastTZ, newTZ); + } + Tcl_MutexUnlock(&tmMutex); +} + +/* + *---------------------------------------------------------------------- + * + * CleanupMemory -- + * + * Releases the private copy of the TZ environment variable upon exit + * from Tcl. + * + * Results: + * None. + * + * Side effects: + * Frees allocated memory. + * + *---------------------------------------------------------------------- + */ + +static void +CleanupMemory( + TCL_UNUSED(ClientData)) +{ + ckfree(lastTZ); +} +#endif /* TCL_NO_DEPRECATED */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: unix/tclXtNotify.c ================================================================== --- unix/tclXtNotify.c +++ unix/tclXtNotify.c @@ -230,11 +230,11 @@ *---------------------------------------------------------------------- */ static void NotifierExitHandler( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); } for (; notifier.firstFileHandlerPtr != NULL; ) { @@ -266,11 +266,11 @@ static void SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { - unsigned long timeout; + long timeout; if (!initialized) { InitNotifier(); } @@ -279,11 +279,11 @@ XtRemoveTimeOut(notifier.currentTimeout); } if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; notifier.currentTimeout = XtAppAddTimeOut(notifier.appContext, - timeout, TimerProc, NULL); + (unsigned long) timeout, TimerProc, NULL); } else { notifier.currentTimeout = 0; } } @@ -303,11 +303,11 @@ *---------------------------------------------------------------------- */ static void TimerProc( - XtPointer clientData, /* Not used. */ + TCL_UNUSED(XtPointer), XtIntervalId *id) { if (*id != notifier.currentTimeout) { return; } @@ -357,11 +357,11 @@ if (filePtr->fd == fd) { break; } } if (filePtr == NULL) { - filePtr = Tcl_Alloc(sizeof(FileHandler)); + filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->read = 0; filePtr->write = 0; filePtr->except = 0; filePtr->readyMask = 0; @@ -468,11 +468,11 @@ XtRemoveInput(filePtr->write); } if (filePtr->mask & TCL_EXCEPTION) { XtRemoveInput(filePtr->except); } - Tcl_Free(filePtr); + ckfree(filePtr); } /* *---------------------------------------------------------------------- * @@ -523,11 +523,11 @@ /* * This is an interesting event, so put it onto the event queue. */ filePtr->readyMask |= mask; - fileEvPtr = Tcl_Alloc(sizeof(FileHandlerEvent)); + fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); /* Index: unix/tclXtTest.c ================================================================== --- unix/tclXtTest.c +++ unix/tclXtTest.c @@ -76,11 +76,11 @@ *---------------------------------------------------------------------- */ static int TesteventloopCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of Index: win/Makefile.in ================================================================== --- win/Makefile.in +++ win/Makefile.in @@ -21,10 +21,11 @@ exec_prefix = @exec_prefix@ bindir = @bindir@ libdir = @libdir@ includedir = @includedir@ datarootdir = @datarootdir@ +runstatedir = @runstatedir@ mandir = @mandir@ # The following definition can be set to non-null for special systems like AFS # with replication. It allows the pathnames used for installation to be # different than those used for actually reference files at run-time. @@ -46,10 +47,13 @@ LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) # Path name to use when installing library scripts. SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) +# Path name to use when installing Tcl modules. +MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 + # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) # Directory in which to (optionally) install the private tcl headers: PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) @@ -79,11 +83,11 @@ # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE -D_ATL_XP_TARGETING +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING -DMP_FIXED_CUTOFFS -DMP_NO_STDINT # To compile without backward compatibility and deprecated code uncomment the # following NO_DEPRECATED_FLAGS = #NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED @@ -94,17 +98,18 @@ #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. -TOP_DIR = $(shell cd @srcdir@/..; pwd -P) +TOP_DIR = $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P) GENERIC_DIR = $(TOP_DIR)/generic -TOMMATH_DIR = $(TOP_DIR)/libtommath WIN_DIR = $(TOP_DIR)/win COMPAT_DIR = $(TOP_DIR)/compat PKGS_DIR = $(TOP_DIR)/pkgs ZLIB_DIR = $(COMPAT_DIR)/zlib +MINIZIP_DIR = $(ZLIB_DIR)/contrib/minizip +TOMMATH_DIR = $(TOP_DIR)/libtommath # Converts a POSIX path to a Windows native path. CYGPATH = @CYGPATH@ libdir_native = $(shell $(CYGPATH) '$(libdir)') @@ -111,19 +116,19 @@ bindir_native = $(shell $(CYGPATH) '$(bindir)') includedir_native = $(shell $(CYGPATH) '$(includedir)') mandir_native = $(shell $(CYGPATH) '$(mandir)') TCL_LIBRARY_NATIVE = $(shell $(CYGPATH) '$(TCL_LIBRARY)') GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)') -TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)') -ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W || pwd -P) +SCRIPT_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(SCRIPT_INSTALL_DIR)') +INCLUDE_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(INCLUDE_INSTALL_DIR)') +MAN_INSTALL_DIR_NATIVE = $(shell $(CYGPATH) '$(MAN_INSTALL_DIR)') +ROOT_DIR_WIN_NATIVE = $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P) ZLIB_DIR_NATIVE = $(shell $(CYGPATH) '$(ZLIB_DIR)') -#GENERIC_DIR_NATIVE = $(GENERIC_DIR) -#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) -#WIN_DIR_NATIVE = $(WIN_DIR) -#ROOT_DIR_NATIVE = $(ROOT_DIR) +MINIZIP_DIR_NATIVE = $(shell $(CYGPATH) '$(MINIZIP_DIR)') +TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)') # Fully qualify library path so that `make test` # does not depend on the current directory. LIBRARY_DIR1 = $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P) LIBRARY_DIR = $(shell $(CYGPATH) '$(LIBRARY_DIR1)') @@ -152,17 +157,18 @@ REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ - package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde];\ - package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry] + package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\ + package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry] TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll +TOMMATH_DLL_FILE = libtommath.dll -SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ +SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} WINE = @WINE@ CAT32 = cat32$(EXEEXT) @@ -178,11 +184,11 @@ @SET_MAKE@ # Setting the VPATH variable to a list of paths will cause the Makefile to # look into these paths when resolving .c to .obj dependencies. -VPATH = $(GENERIC_DIR):$(TOMMATH_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR) +VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR):$(TOMMATH_DIR) AR = @AR@ RANLIB = @RANLIB@ CC = @CC@ RC = @RC@ @@ -199,11 +205,11 @@ STLIB_LD = @STLIB_LD@ SHLIB_LD = @SHLIB_LD@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_SUFFIX = @SHLIB_SUFFIX@ -LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@') +LIBS = @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@') $(shell $(CYGPATH) '@TOMMATH_LIBS@') RMDIR = rm -rf MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f @@ -247,20 +253,20 @@ zutil.$(HOST_OBJEXT) \ minizip.$(HOST_OBJEXT) ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ -CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ --I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \ --DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ +CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ +-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ +${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ --I"${GENERIC_DIR_NATIVE}" -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ +-I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ ${COMPILE_DEBUG_FLAGS} TCLTEST_OBJS = \ tclTest.$(OBJEXT) \ @@ -314,12 +320,12 @@ tclIOUtil.$(OBJEXT) \ tclLink.$(OBJEXT) \ tclLiteral.$(OBJEXT) \ tclListObj.$(OBJEXT) \ tclLoad.$(OBJEXT) \ + tclMainW.$(OBJEXT) \ tclMain.$(OBJEXT) \ - tclMain2.$(OBJEXT) \ tclNamesp.$(OBJEXT) \ tclNotify.$(OBJEXT) \ tclOO.$(OBJEXT) \ tclOOBasic.$(OBJEXT) \ tclOOCall.$(OBJEXT) \ @@ -358,13 +364,10 @@ tclVar.$(OBJEXT) \ tclZipfs.$(OBJEXT) \ tclZlib.$(OBJEXT) TOMMATH_OBJS = \ - bn_reverse.${OBJEXT} \ - bn_fast_s_mp_mul_digs.${OBJEXT} \ - bn_fast_s_mp_sqr.${OBJEXT} \ bn_mp_add.${OBJEXT} \ bn_mp_add_d.${OBJEXT} \ bn_mp_and.${OBJEXT} \ bn_mp_clamp.${OBJEXT} \ bn_mp_clear.${OBJEXT} \ @@ -379,25 +382,20 @@ bn_mp_div_d.${OBJEXT} \ bn_mp_div_2.${OBJEXT} \ bn_mp_div_2d.${OBJEXT} \ bn_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ - bn_mp_expt_d.${OBJEXT} \ - bn_mp_expt_d_ex.${OBJEXT} \ - bn_s_mp_get_bit.${OBJEXT} \ - bn_mp_get_int.${OBJEXT} \ - bn_mp_get_long.${OBJEXT} \ - bn_mp_get_long_long.${OBJEXT} \ + bn_mp_expt_u32.${OBJEXT} \ + bn_mp_get_mag_u64.${OBJEXT} \ bn_mp_grow.${OBJEXT} \ bn_mp_init.${OBJEXT} \ bn_mp_init_copy.${OBJEXT} \ + bn_mp_init_i64.${OBJEXT} \ bn_mp_init_multi.${OBJEXT} \ bn_mp_init_set.${OBJEXT} \ - bn_mp_init_set_int.${OBJEXT} \ bn_mp_init_size.${OBJEXT} \ - bn_mp_karatsuba_mul.${OBJEXT} \ - bn_mp_karatsuba_sqr.$(OBJEXT) \ + bn_mp_init_u64.${OBJEXT} \ bn_mp_lshd.${OBJEXT} \ bn_mp_mod.${OBJEXT} \ bn_mp_mod_2d.${OBJEXT} \ bn_mp_mul.${OBJEXT} \ bn_mp_mul_2.${OBJEXT} \ @@ -407,32 +405,35 @@ bn_mp_or.${OBJEXT} \ bn_mp_radix_size.${OBJEXT} \ bn_mp_radix_smap.${OBJEXT} \ bn_mp_read_radix.${OBJEXT} \ bn_mp_rshd.${OBJEXT} \ - bn_mp_set.${OBJEXT} \ - bn_mp_set_int.${OBJEXT} \ - bn_mp_set_long.${OBJEXT} \ - bn_mp_set_long_long.${OBJEXT} \ + bn_mp_set_i64.${OBJEXT} \ + bn_mp_set_u64.${OBJEXT} \ bn_mp_shrink.${OBJEXT} \ bn_mp_sqr.${OBJEXT} \ bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ bn_mp_signed_rsh.${OBJEXT} \ - bn_mp_to_unsigned_bin.${OBJEXT} \ - bn_mp_to_unsigned_bin_n.${OBJEXT} \ - bn_mp_toom_mul.${OBJEXT} \ - bn_mp_toom_sqr.${OBJEXT} \ - bn_mp_toradix_n.${OBJEXT} \ - bn_mp_unsigned_bin_size.${OBJEXT} \ + bn_mp_to_ubin.${OBJEXT} \ + bn_mp_to_radix.${OBJEXT} \ + bn_mp_ubin_size.${OBJEXT} \ bn_mp_xor.${OBJEXT} \ bn_mp_zero.${OBJEXT} \ bn_s_mp_add.${OBJEXT} \ + bn_s_mp_balance_mul.$(OBJEXT) \ + bn_s_mp_karatsuba_mul.${OBJEXT} \ + bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ + bn_s_mp_mul_digs_fast.${OBJEXT} \ + bn_s_mp_reverse.${OBJEXT} \ + bn_s_mp_sqr_fast.${OBJEXT} \ bn_s_mp_sqr.${OBJEXT} \ - bn_s_mp_sub.${OBJEXT} + bn_s_mp_sub.${OBJEXT} \ + bn_s_mp_toom_mul.${OBJEXT} \ + bn_s_mp_toom_sqr.${OBJEXT} WIN_OBJS = \ tclWin32Dll.$(OBJEXT) \ tclWinChan.$(OBJEXT) \ @@ -472,11 +473,11 @@ inftrees.$(OBJEXT) \ trees.$(OBJEXT) \ uncompr.$(OBJEXT) \ zutil.$(OBJEXT) -TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@ +TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} @ZLIB_OBJS@ @TOMMATH_OBJS@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc packages @@ -484,32 +485,34 @@ # To start from windows shell use: # > tcltest.cmd -verbose bps -file fileName.test # or from mingw/msys shell: # $ ./tcltest -verbose bps -file fileName.test -tcltest.cmd: +tcltest.cmd: Makefile @echo 'Create tcltest.cmd helpers'; @(\ echo '@echo off'; \ echo 'rem set LANG=en_US'; \ echo 'set BDP=%~dp0'; \ echo 'set OWD=%CD%'; \ echo 'cd /d %TEMP%'; \ - echo 'rem "%BDP%\$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" %*'; \ - echo '"%BDP%\$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $(TESTFLAGS) -load "$(TEST_LOAD_PRMS)" %*'; \ + echo 'rem "%BDP%\$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_FACILITIES)" %*'; \ + echo '"%BDP%\$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" %TESTFLAGS% -load "$(TEST_LOAD_PRMS)" %*'; \ echo 'cd /d %OWD%'; \ ) > tcltest.cmd; @(\ echo '#!/bin/sh'; \ echo '#LANG=en_US'; \ echo 'BDP=$$(dirname $$(readlink -f %0))'; \ echo 'cd /tmp'; \ - echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ - echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $(TESTFLAGS) -load "$(TEST_LOAD_PRMS)" "$$@"'; \ - ) > tcltest; + echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \ + echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \ + ) > tcltest.sh; -tcltest: $(TCLSH) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd +tcltest.sh: tcltest.cmd + +tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH) winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} @@ -546,14 +549,15 @@ cd ..) $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + $(COPY) tclsh.exe.manifest $(TCLSH).manifest @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c - $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) $(CAT32): cat32.$(OBJEXT) $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE) # The following targets are configured by autoconf to generate either a shared @@ -562,13 +566,14 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ -${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE} +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ ${TCL_ZIP_FILE} @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest @VC_MANIFEST_EMBED_DLL@ @if test "${ZIPFS_BUILD}" = "1" ; then \ cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \ ${NATIVE_ZIP} -A ${TCL_DLL_FILE} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ @@ -579,30 +584,42 @@ @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ ${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest ${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT} @$(RM) ${TEST_EXE_FILE} $(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + $(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest # use pre-built zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ else \ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ fi; + +# use pre-built libtommath.dll +${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE} + @if test "@TOMMATH_LIBS@set" != "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \ + $(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + else \ + $(COPY) $(TOMMATH_DIR)/win32/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \ + fi; # Add the object extension to the implicit rules. By default .obj is not # automatically added. .SUFFIXES: .${OBJEXT} @@ -610,33 +627,39 @@ .SUFFIXES: .rc # Special case object targets tclTestMain.${OBJEXT}: tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DBUILD_tcl $(EXTFLAGS) $(CC_OBJNAME) $(WIN_DIR)/tclAppInit.c + $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinInit.${OBJEXT}: tclWinInit.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) -testMain.${OBJEXT}: tclAppInit.c - $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME) +tclWinReg.${OBJEXT}: tclWinReg.c + $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) -tclMain2.${OBJEXT}: tclMain.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +tclWinDde.${OBJEXT}: tclWinDde.c + $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + +tclAppInit.${OBJEXT}: tclAppInit.c + $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) + +tclMainW.${OBJEXT}: tclMain.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) # TIP #430, ZipFS Support tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ - -DCFG_RUNTIME_PATH=\"$(bindir_native)\" \ + -DCFG_RUNTIME_PATH="\"$(bindir_native)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ - $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip @DEPARG@ $(CC_OBJNAME) + $(ZLIB_INCLUDE) -I$(MINIZIP_DIR_NATIVE) @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -645,21 +668,21 @@ # every path can be configured separately we do not remember one general # prefix/exec_prefix but all the different paths individually. tclPkgConfig.${OBJEXT}: tclPkgConfig.c $(CC) -c $(CC_SWITCHES) \ - -DCFG_INSTALL_LIBDIR=\"$(LIB_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_BINDIR=\"$(BIN_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_SCRDIR=\"$(SCRIPT_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_INCDIR=\"$(INCLUDE_INSTALL_DIR_NATIVE)\" \ - -DCFG_INSTALL_DOCDIR=\"$(MAN_INSTALL_DIR)\" \ - \ - -DCFG_RUNTIME_LIBDIR=\"$(libdir_native)\" \ - -DCFG_RUNTIME_BINDIR=\"$(bindir_native)\" \ - -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \ - -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \ - -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \ + -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR_NATIVE)\"" \ + -DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR_NATIVE)\"" \ + \ + -DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ + -DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \ + -DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) @@ -702,11 +725,11 @@ deflate.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c ioapi.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c iowin32.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c infback.$(HOST_OBJEXT): @@ -732,11 +755,11 @@ zutil.$(HOST_OBJEXT): $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c minizip.$(HOST_OBJEXT): - $(HOST_CC) -o $@ -I$(ZLIB_DIR) -DIOAPI_NO_64 -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) $(HOST_CC) -o $@ $(MINIZIP_OBJS) # The following target generates the file generic/tclDate.c from the yacc @@ -749,18 +772,10 @@ bison --output-file=$(GENERIC_DIR)/tclDate.c \ --name-prefix=TclDate \ --no-lines \ $(GENERIC_DIR)/tclGetDate.y -# The following target generates the file generic/tclTomMath.h. It needs to be -# run (and the results checked) after updating to a new release of libtommath. - -gentommath_h: - $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \ - "$(TOMMATH_DIR_NATIVE)/tommath.h" \ - > "$(GENERIC_DIR_NATIVE)/tclTomMath.h" - INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) INSTALL_DOC_TARGETS = install-doc INSTALL_PACKAGE_TARGETS = install-packages INSTALL_DEV_TARGETS = install-headers INSTALL_EXTRA_TARGETS = @@ -768,28 +783,28 @@ $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) install: $(INSTALL_TARGETS) install-binaries: binaries - @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ + @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)"; \ do \ - if [ ! -d $$i ] ; then \ + if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ - $(MKDIR) $$i; \ - chmod 755 $$i; \ + $(MKDIR) "$$i"; \ + chmod 755 "$$i"; \ else true; \ fi; \ done; @for i in dde${DDEDOTVER} reg${REGDOTVER}; \ do \ - if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ + if [ ! -d "$(LIB_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ - $(MKDIR) $(LIB_INSTALL_DIR)/$$i; \ + $(MKDIR) "$(LIB_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; - @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \ + @for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TOMMATH_DLL_FILE) $(TCLSH); \ do \ if [ -f $$i ]; then \ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \ fi; \ @@ -801,86 +816,99 @@ $(COPY) $$i "$(LIB_INSTALL_DIR)"; \ fi; \ done @if [ -f $(DDE_DLL_FILE) ]; then \ echo Installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + $(COPY) $(DDE_DLL_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ + $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo Installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ + $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \ fi install-libraries-zipfs-shared: libraries install-libraries-zipfs-static: install-libraries-zipfs-shared - $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" + $(COPY) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" install-libraries: libraries install-tzdata install-msgs - @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ - $(SCRIPT_INSTALL_DIR); \ + @for i in "$(prefix)/lib" "$(INCLUDE_INSTALL_DIR)" \ + "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \ do \ - if [ ! -d $$i ] ; then \ + if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ - $(MKDIR) $$i; \ + $(MKDIR) "$$i"; \ + else true; \ + fi; \ + done; + @for i in opt0.4 cookiejar0.2 encoding; \ + do \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \ + echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; - @for i in opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \ + @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ do \ - if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ - echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ - $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \ + if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ + echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ + $(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \ else true; \ fi; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing package http 2.9.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.9.0.tm; - @echo "Installing library opt0.4 directory"; + @echo "Installing package cookiejar 0.2" + @for j in $(ROOT_DIR)/library/cookiejar/*.{tcl,txt.gz}; \ + do \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ + done; + @echo "Installing package http 2.9.1 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.1.tm"; + @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.7.0.tm; - @echo "Installing package tcltest 2.4.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/tcltest-2.4.0.tm; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.0.tm"; + @echo "Installing package tcltest 2.5.3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.3.tm"; @echo "Installing package platform 1.0.14 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform-1.0.14.tm; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.14.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform/shell-1.1.4.tm; + @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"; @echo "Installing encodings"; - @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ + @for i in $(ROOT_DIR)/library/encoding/*.enc; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; install-tzdata: @echo "Installing time zone data" @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ - "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR_NATIVE)/tzdata" install-msgs: @echo "Installing message catalogs" - @$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ - "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" + $(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR_NATIVE)/msgs" install-doc: doc install-headers: @for i in "$(INCLUDE_INSTALL_DIR)"; \ @@ -895,11 +923,12 @@ @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclTomMath.h \ - $(GENERIC_DIR)/tclTomMathDecls.h ; \ + $(GENERIC_DIR)/tclTomMathDecls.h \ + $(TOMMATH_DIR)/tommath.h ; \ do \ $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \ done; # Optional target to install private headers @@ -925,17 +954,17 @@ # tcltest, i.e.: # % make test TESTFLAGS="-verbose bps -file fileName.test" test: test-tcl test-packages -test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) +test-tcl: tcltest TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ $(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "$(TEST_LOAD_FACILITIES)" | $(WINE) ./$(CAT32) + -load "$(TEST_LOAD_FACILITIES)" # Useful target to launch a built tclsh with the proper path,... -runtest: binaries $(TCLSH) $(TEST_DLL_FILE) +runtest: tcltest @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ $(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` @@ -957,11 +986,11 @@ cleanhelp: $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest + $(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh $(RM) *.pch *.ilk *.pdb $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} $(RM) *.zip $(RMDIR) *.vfs @@ -1068,11 +1097,11 @@ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & # tk8.* up two directories from the TOOL_DIR. # TOOL_DIR=$(ROOT_DIR)/tools HTML_INSTALL_DIR=$(ROOT_DIR)/html Index: win/README ================================================================== --- win/README +++ win/README @@ -1,6 +1,6 @@ -Tcl 9.0 for Windows +Tcl 8.7 for Windows 1. Introduction --------------- This is the directory where you configure and compile the Windows @@ -14,11 +14,11 @@ 2. Compiling Tcl ---------------- In order to compile Tcl for Windows, you need the following: - Tcl 9.0 Source Distribution (plus any patches) + Tcl 8.7 Source Distribution (plus any patches) and Visual C++ 6 or newer @@ -77,13 +77,13 @@ Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh90.exe, you must ensure that tcl90.dll is +Note that in order to run tclsh87.exe, you must ensure that tcl87.dll is on your path, in the system directory, or in the directory containing -tclsh90.exe. +tclsh87.exe. Note: Tcl no longer provides support for Win32s. 3. Test suite ------------- @@ -91,9 +91,9 @@ This distribution contains an extensive test suite for Tcl. Some of the tests are timing dependent and will fail from time to time. If a test is failing consistently, please send us a bug report with as much detail as you can manage to our tracker: - http://core.tcl.tk/tcl/reportlist + https://core.tcl-lang.org/tcl/reportlist In order to run the test suite, you build the "test" target using the appropriate makefile for your compiler. Index: win/cat.c ================================================================== --- win/cat.c +++ win/cat.c @@ -26,16 +26,16 @@ char buf[1024]; int n; const char *err; while (1) { - n = read(0, buf, sizeof(buf)); + n = _read(0, buf, sizeof(buf)); if (n <= 0) { break; } - write(1, buf, n); + _write(1, buf, n); } err = (sizeof(int) == 2) ? "stderr16" : "stderr32"; - write(2, err, strlen(err)); + _write(2, err, (unsigned int)strlen(err)); return 0; } Index: win/configure ================================================================== --- win/configure +++ win/configure @@ -708,12 +708,15 @@ ZIP_PROG_OPTIONS ZIP_PROG TCLSH_PROG EXEEXT_FOR_BUILD CC_FOR_BUILD +TOMMATH_OBJS ZLIB_OBJS +TOMMATH_LIBS ZLIB_LIBS +TOMMATH_DLL_FILE ZLIB_DLL_FILE CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG DL_LIBS @@ -776,10 +779,11 @@ ac_subst_files='' ac_user_opts=' enable_option_checking with_encoding enable_shared +enable_time64bit enable_64bit enable_zipfs enable_symbols enable_embedded_manifest ' @@ -1398,10 +1402,11 @@ Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) + --enable-time64bit force 64-bit time_t for 32-bit build (default: off) --enable-64bit enable 64bit support (where applicable) --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) @@ -1616,55 +1621,96 @@ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run -# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES -# --------------------------------------------- -# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR # accordingly. -ac_fn_c_check_decl () +ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - as_decl_name=`echo $2|sed 's/ *(.*//'` - as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 -$as_echo_n "checking whether $as_decl_name is declared... " >&6; } + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -#ifndef $as_decl_name -#ifdef __cplusplus - (void) $as_decl_use; -#else - (void) $as_decl_name; -#endif -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + eval "$3=\$ac_header_compiler" fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } +fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno -} # ac_fn_c_check_decl +} # ac_fn_c_check_header_mongrel # ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists and can be compiled using the include files in # INCLUDES, setting the cache variable VAR accordingly. @@ -2105,14 +2151,14 @@ # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=9.0 -TCL_MAJOR_VERSION=9 -TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a0" +TCL_VERSION=8.7 +TCL_MAJOR_VERSION=8 +TCL_MINOR_VERSION=7 +TCL_PATCH_LEVEL="a4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 @@ -3745,10 +3791,29 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi + +#-------------------------------------------------------------------- +# Check whether --enable-time64bit was given. +#-------------------------------------------------------------------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5 +$as_echo_n "checking force of 64-bit time_t... " >&6; } +# Check whether --enable-time64bit was given. +if test "${enable_time64bit+set}" = set; then : + enableval=$enable_time64bit; tcl_ok=$enableval +else + tcl_ok=no +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 +$as_echo "\"$tcl_ok\"" >&6; } +if test "$tcl_ok" = "yes"; then + CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" +fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -3909,18 +3974,18 @@ $as_echo "$ac_cv_cross" >&6; } if test "$ac_cv_cross" = "yes"; then case "$do64bit" in amd64|x64|yes) - CC="x86_64-w64-mingw32-gcc" + CC="x86_64-w64-mingw32-${CC}" LD="x86_64-w64-mingw32-ld" AR="x86_64-w64-mingw32-ar" RANLIB="x86_64-w64-mingw32-ranlib" RC="x86_64-w64-mingw32-windres" ;; *) - CC="i686-w64-mingw32-gcc" + CC="i686-w64-mingw32-${CC}" LD="i686-w64-mingw32-ld" AR="i686-w64-mingw32-ar" RANLIB="i686-w64-mingw32-ranlib" RC="i686-w64-mingw32-windres" ;; @@ -4150,13 +4215,22 @@ EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith" + CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= + + case "${CC}" in + *++) + CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" + ;; + *) + CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement" + ;; + esac # Specify the CC output file names based on the target name CC_OBJNAME="-o \$@" CC_EXENAME="-o \$@" @@ -4248,33 +4322,19 @@ # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" - # This is a 2-stage check to make sure we have the 64-bit SDK - # We have to know where the SDK is installed. - # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs if test "$do64bit" != "no" ; then - if test "x${MSSDK}x" = "xx" ; then - MSSDK="C:/Progra~1/Microsoft Platform SDK" - fi - MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` - PATH64="" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" - PATH64="${MSSDK}/Bin/Win64" ;; esac - if test ! -d "${PATH64}" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK" >&5 -$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;} - fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 $as_echo " Using 64-bit $MACHINE mode" >&6; } fi LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" @@ -4286,30 +4346,16 @@ *) ;; esac if test "$do64bit" != "no" ; then - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. TEA has the - # TEA_PATH_NOSPACE to avoid this issue. - # Check if _WIN64 is already recognized, and if so we don't - # need to modify CC. - ac_fn_c_check_decl "$LINENO" "_WIN64" "ac_cv_have_decl__WIN64" "$ac_includes_default" -if test "x$ac_cv_have_decl__WIN64" = xyes; then : - -else - CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ - -I\"${MSSDK}/Include/crt\" \ - -I\"${MSSDK}/Include/crt/sys\"" -fi - - RC="\"${MSSDK}/bin/rc.exe\"" + RC="rc" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" - LINKBIN="\"${PATH64}/link.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE}" + LINKBIN="link" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="$LIBS bufferoverflowU.lib" else RC="rc" @@ -4500,10 +4546,19 @@ if test "$tcl_cv_winnt_ignore_void" = "yes" ; then $as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h fi + + ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" +if test "x$ac_cv_header_stdbool_h" = xyes; then : + +$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h + +fi + + # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. @@ -4559,12 +4614,13 @@ TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}" ;; esac #------------------------------------------------------------------------ -# Add stuff for zlib; note that this is mostly done in the makefile now -# as we just assume that the platform hasn't got a usable z.lib +# Add stuff for zlib/libtommath; note that this is mostly done in the +# makefile now as we just assume that the platform hasn't got usable +# z.lib/tommath.lib #------------------------------------------------------------------------ if test "${enable_shared+set}" = "set"; then : enableval="$enable_shared" @@ -4577,34 +4633,50 @@ fi if test "$tcl_ok" = "yes"; then : ZLIB_DLL_FILE=\${ZLIB_DLL_FILE} + TOMMATH_DLL_FILE=\${TOMMATH_DLL_FILE} + + +$as_echo "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h + if test "$do64bit" != "no"; then : + +$as_echo "#define MP_64BIT 1" >>confdefs.h + if test "$GCC" == "yes"; then : ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a + TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a + else ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib + + TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib fi else ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib + TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib + fi else ZLIB_OBJS=\${ZLIB_OBJS} + + TOMMATH_OBJS=\${TOMMATH_OBJS} fi $as_echo "#define HAVE_ZLIB 1" >>confdefs.h @@ -5275,13 +5347,13 @@ # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" + TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib}" else - TCL_PACKAGE_PATH="${prefix}/lib" + TCL_PACKAGE_PATH="{${prefix}/lib}" fi # The tclsh.exe.manifest requires these # TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs # the release level, and must account for interim release versioning Index: win/configure.ac ================================================================== --- win/configure.ac +++ win/configure.ac @@ -9,14 +9,14 @@ # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=9.0 -TCL_MAJOR_VERSION=9 -TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a0" +TCL_VERSION=8.7 +TCL_MAJOR_VERSION=8 +TCL_MINOR_VERSION=7 +TCL_PATCH_LEVEL="a4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=4 @@ -88,10 +88,24 @@ # The statements below define a collection of symbols related to # building libtcl as a shared library instead of a static library. #-------------------------------------------------------------------- SC_ENABLE_SHARED + +#-------------------------------------------------------------------- +# Check whether --enable-time64bit was given. +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([force of 64-bit time_t]) +AC_ARG_ENABLE(time64bit, + AC_HELP_STRING([--enable-time64bit], + [force 64-bit time_t for 32-bit build (default: off)]), + [tcl_ok=$enableval], [tcl_ok=no]) +AC_MSG_RESULT("$tcl_ok") +if test "$tcl_ok" = "yes"; then + CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" +fi #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -108,12 +122,13 @@ TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}" ;; esac #------------------------------------------------------------------------ -# Add stuff for zlib; note that this is mostly done in the makefile now -# as we just assume that the platform hasn't got a usable z.lib +# Add stuff for zlib/libtommath; note that this is mostly done in the +# makefile now as we just assume that the platform hasn't got usable +# z.lib/tommath.lib #------------------------------------------------------------------------ AS_IF([test "${enable_shared+set}" = "set"], [ enableval="$enable_shared" tcl_ok=$enableval @@ -120,21 +135,28 @@ ], [ tcl_ok=yes ]) AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) + AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}]) + AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath]) AS_IF([test "$do64bit" != "no"], [ + AC_DEFINE(MP_64BIT, 1, [Using libtommath.dll in 64-bit mode]) AS_IF([test "$GCC" == "yes"],[ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a]) + AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a]) ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib]) + AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/tommath.lib]) ]) ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib]) + AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win32/tommath.lib]) ]) ], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) + AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) AC_CHECK_TYPE([intptr_t], [ AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ @@ -385,13 +407,13 @@ # consists of one directory for machine-dependent binaries and # another for platform-independent scripts. #-------------------------------------------------------------------- if test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" + TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib}" else - TCL_PACKAGE_PATH="${prefix}/lib" + TCL_PACKAGE_PATH="{${prefix}/lib}" fi # The tclsh.exe.manifest requires these # TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs # the release level, and must account for interim release versioning Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -14,11 +14,11 @@ #------------------------------------------------------------------------------ # General usage: # nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]] # -# For MACRODEF, see TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) +# For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) # or examine Sections 6-8 in rules.vc. # # Possible values of TARGET are: # release -- Builds the core, the shell and the dlls. (default) # dlls -- Just builds the windows extensions @@ -48,10 +48,77 @@ # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform # SDK (not expressly needed), run setenv.bat after # vcvars32.bat according to the instructions for it. This can also # turn on the 64-bit compiler, if your SDK has it. +# +# Basic macros and options usable on the commandline (see rules.vc for more info): +# OPTS=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,time64bit,unchecked,utfmax,none +# Sets special options for the core. The default is for none. +# Any combination of the above may be used (comma separated). +# 'none' will over-ride everything to nothing. +# +# msvcrt = Affects the static option only to switch it from +# using libcmt(d) as the C runtime [by default] to +# msvcrt(d). This is useful for static embedding +# support. +# nothreads = Turns off full multithreading support (default on). +# pbds = Produce separate debug symbol files. +# profile = Adds profiling hooks. Map file is assumed. +# static = Builds a static library of the core instead of a +# dll. The shell will be static (and large), as well. +# staticpkg = Affects the static option only to switch +# tclshXX.exe to have the dde and reg extension linked +# inside it. +# symbols = Adds symbols for step debugging. +# thrdalloc = Use the thread allocator (shared global free pool). +# time64bit = Forces a build using 64-bit time_t for 32-bit build +# (CRT library should support this). +# unchecked = Allows a symbols build to not use the debug +# enabled runtime (msvcrt.dll not msvcrtd.dll +# or libcmt.lib not libcmtd.lib). +# utfmax = Forces a build allowing 4-byte UTF-8 sequences +# internally. +# +# STATS=compdbg,memdbg,none +# Sets optional memory and bytecode compiler debugging code added +# to the core. The default is for none. Any combination of the +# above may be used (comma separated). 'none' will over-ride +# everything to nothing. +# +# compdbg = Enables byte compilation logging. +# memdbg = Enables the debugging memory allocator. +# +# CHECKS=64bit,fullwarn,nodep,none +# Sets special macros for checking compatibility. +# +# 64bit = Enable 64bit portability warnings (if available) +# fullwarn = Builds with full compiler and link warnings enabled. +# Very verbose. +# nodep = Turns off compatibility macros to ensure the core +# isn't being built with deprecated functions. +# +# MACHINE=(ALPHA|AMD64|IA64|IX86) +# Set the machine type used for the compiler, linker, and +# resource compiler. This hook is needed to tell the tools +# when alternate platforms are requested. IX86 is the default +# when not specified. If the CPU environment variable has been +# set (ie: recent Platform SDK) then MACHINE is set from CPU. +# +# TMP_DIR= +# OUT_DIR= +# Hooks to allow the intermediate and output directories to be +# changed. $(OUT_DIR) is assumed to be +# $(BINROOT)\(Release|Debug) based on if symbols are requested. +# $(TMP_DIR) will de $(OUT_DIR)\ by default. +# +# TESTPAT= +# Reads the tests requested to be run from this file. +# +# CFG_ENCODING=encoding +# name of encoding for configuration information. Defaults +# to cp1252 # # Examples: # c:\tcl_src\win\>nmake -f makefile.vc release # c:\tcl_src\win\>nmake -f makefile.vc test # c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl @@ -87,10 +154,16 @@ !if [echo REM = This file is generated from makefile.vc > versions.vc] !endif !if [echo PKG_HTTP_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] !endif +!if [echo PKG_OPT_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\opt\pkgIndex.tcl opt >> versions.vc] +!endif +!if [echo PKG_COOKIEJAR_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\cookiejar\pkgIndex.tcl cookiejar >> versions.vc] +!endif !if [echo PKG_TCLTEST_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc] !endif !if [echo PKG_MSGCAT_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc] @@ -143,10 +216,11 @@ !if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif + $(OUT_DIR)\tommath.lib \ !endif $(TMP_DIR)\testMain.obj COREOBJS = \ $(TMP_DIR)\regcomp.obj \ @@ -193,12 +267,12 @@ $(TMP_DIR)\tclIORTrans.obj \ $(TMP_DIR)\tclLink.obj \ $(TMP_DIR)\tclListObj.obj \ $(TMP_DIR)\tclLiteral.obj \ $(TMP_DIR)\tclLoad.obj \ + $(TMP_DIR)\tclMainW.obj \ $(TMP_DIR)\tclMain.obj \ - $(TMP_DIR)\tclMain2.obj \ $(TMP_DIR)\tclNamesp.obj \ $(TMP_DIR)\tclNotify.obj \ $(TMP_DIR)\tclOO.obj \ $(TMP_DIR)\tclOOBasic.obj \ $(TMP_DIR)\tclOOCall.obj \ @@ -236,10 +310,11 @@ $(TMP_DIR)\tclUtil.obj \ $(TMP_DIR)\tclVar.obj \ $(TMP_DIR)\tclZipfs.obj \ $(TMP_DIR)\tclZlib.obj +!if $(STATIC_BUILD) ZLIBOBJS = \ $(TMP_DIR)\adler32.obj \ $(TMP_DIR)\compress.obj \ $(TMP_DIR)\crc32.obj \ $(TMP_DIR)\deflate.obj \ @@ -248,15 +323,16 @@ $(TMP_DIR)\inflate.obj \ $(TMP_DIR)\inftrees.obj \ $(TMP_DIR)\trees.obj \ $(TMP_DIR)\uncompr.obj \ $(TMP_DIR)\zutil.obj +!else +ZLIBOBJS = $(OUT_DIR)\zdll.lib +!endif +!if $(STATIC_BUILD) TOMMATHOBJS = \ - $(TMP_DIR)\bn_reverse.obj \ - $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \ - $(TMP_DIR)\bn_fast_s_mp_sqr.obj \ $(TMP_DIR)\bn_mp_add.obj \ $(TMP_DIR)\bn_mp_add_d.obj \ $(TMP_DIR)\bn_mp_and.obj \ $(TMP_DIR)\bn_mp_clamp.obj \ $(TMP_DIR)\bn_mp_clear.obj \ @@ -271,25 +347,20 @@ $(TMP_DIR)\bn_mp_div_d.obj \ $(TMP_DIR)\bn_mp_div_2.obj \ $(TMP_DIR)\bn_mp_div_2d.obj \ $(TMP_DIR)\bn_mp_div_3.obj \ $(TMP_DIR)\bn_mp_exch.obj \ - $(TMP_DIR)\bn_mp_expt_d.obj \ - $(TMP_DIR)\bn_mp_expt_d_ex.obj \ - $(TMP_DIR)\bn_s_mp_get_bit.obj \ - $(TMP_DIR)\bn_mp_get_int.obj \ - $(TMP_DIR)\bn_mp_get_long.obj \ - $(TMP_DIR)\bn_mp_get_long_long.obj \ + $(TMP_DIR)\bn_mp_expt_u32.obj \ + $(TMP_DIR)\bn_mp_get_mag_u64.obj \ $(TMP_DIR)\bn_mp_grow.obj \ $(TMP_DIR)\bn_mp_init.obj \ $(TMP_DIR)\bn_mp_init_copy.obj \ + $(TMP_DIR)\bn_mp_init_i64.obj \ $(TMP_DIR)\bn_mp_init_multi.obj \ $(TMP_DIR)\bn_mp_init_set.obj \ - $(TMP_DIR)\bn_mp_init_set_int.obj \ $(TMP_DIR)\bn_mp_init_size.obj \ - $(TMP_DIR)\bn_mp_karatsuba_mul.obj \ - $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \ + $(TMP_DIR)\bn_mp_init_u64.obj \ $(TMP_DIR)\bn_mp_lshd.obj \ $(TMP_DIR)\bn_mp_mod.obj \ $(TMP_DIR)\bn_mp_mod_2d.obj \ $(TMP_DIR)\bn_mp_mul.obj \ $(TMP_DIR)\bn_mp_mul_2.obj \ @@ -299,32 +370,38 @@ $(TMP_DIR)\bn_mp_or.obj \ $(TMP_DIR)\bn_mp_radix_size.obj \ $(TMP_DIR)\bn_mp_radix_smap.obj \ $(TMP_DIR)\bn_mp_read_radix.obj \ $(TMP_DIR)\bn_mp_rshd.obj \ - $(TMP_DIR)\bn_mp_set.obj \ - $(TMP_DIR)\bn_mp_set_int.obj \ - $(TMP_DIR)\bn_mp_set_long.obj \ - $(TMP_DIR)\bn_mp_set_long_long.obj \ + $(TMP_DIR)\bn_mp_set_i64.obj \ + $(TMP_DIR)\bn_mp_set_u64.obj \ $(TMP_DIR)\bn_mp_shrink.obj \ $(TMP_DIR)\bn_mp_sqr.obj \ $(TMP_DIR)\bn_mp_sqrt.obj \ $(TMP_DIR)\bn_mp_sub.obj \ $(TMP_DIR)\bn_mp_sub_d.obj \ $(TMP_DIR)\bn_mp_signed_rsh.obj \ - $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \ - $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \ - $(TMP_DIR)\bn_mp_toom_mul.obj \ - $(TMP_DIR)\bn_mp_toom_sqr.obj \ - $(TMP_DIR)\bn_mp_toradix_n.obj \ - $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \ + $(TMP_DIR)\bn_mp_to_ubin.obj \ + $(TMP_DIR)\bn_mp_to_radix.obj \ + $(TMP_DIR)\bn_mp_ubin_size.obj \ $(TMP_DIR)\bn_mp_xor.obj \ $(TMP_DIR)\bn_mp_zero.obj \ $(TMP_DIR)\bn_s_mp_add.obj \ + $(TMP_DIR)\bn_s_mp_balance_mul.obj \ + $(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \ + $(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \ $(TMP_DIR)\bn_s_mp_mul_digs.obj \ + $(TMP_DIR)\bn_s_mp_mul_digs_fast.obj \ + $(TMP_DIR)\bn_s_mp_reverse.obj \ $(TMP_DIR)\bn_s_mp_sqr.obj \ - $(TMP_DIR)\bn_s_mp_sub.obj + $(TMP_DIR)\bn_s_mp_sqr_fast.obj \ + $(TMP_DIR)\bn_s_mp_sub.obj \ + $(TMP_DIR)\bn_s_mp_toom_sqr.obj \ + $(TMP_DIR)\bn_s_mp_toom_mul.obj +!else +TOMMATHOBJS = $(OUT_DIR)\tommath.lib +!endif PLATFORMOBJS = \ $(TMP_DIR)\tclWin32Dll.obj \ $(TMP_DIR)\tclWinChan.obj \ $(TMP_DIR)\tclWinConsole.obj \ @@ -360,11 +437,11 @@ PKGSDIR = $(ROOT)\pkgs # 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 +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 # Additional Link libraries needed beyond those in rules.vc PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib #--------------------------------------------------------------------- @@ -381,11 +458,11 @@ #--------------------------------------------------------------------- release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs core: setup $(TCLLIB) $(TCLSTUBLIB) shell: setup $(TCLSH) -dlls: setup $(TCLREGLIB) $(TCLDDELIB) +dlls: setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll all: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs tcltest: setup $(TCLTEST) dlls install: install-binaries install-libraries install-docs install-pkgs !if $(SYMBOLS) install: install-pdbs @@ -394,12 +471,12 @@ test: test-core test-pkgs test-core: setup $(TCLTEST) dlls set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << - package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde] - package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry] + package ifneeded dde 1.4.3 [list load "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" registry] << runtest: setup $(TCLTEST) dlls set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) $(SCRIPT) @@ -453,10 +530,31 @@ !else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB) $(DLLCMD) $** $(_VC_MANIFEST_EMBED_DLL) !endif + +!if "$(MACHINE)" == "AMD64" +$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64\zlib1.dll + $(COPY) $(COMPATDIR)\zlib\win64\zlib1.dll $(OUT_DIR)\zlib1.dll +$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64\zdll.lib + $(COPY) $(COMPATDIR)\zlib\win64\zdll.lib $(OUT_DIR)\zdll.lib +$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win64\libtommath.dll + $(COPY) $(TOMMATHDIR)\win64\libtommath.dll $(OUT_DIR)\libtommath.dll +$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win64\tommath.lib + $(COPY) $(TOMMATHDIR)\win64\tommath.lib $(OUT_DIR)\tommath.lib +!else +$(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win32\zlib1.dll + $(COPY) $(COMPATDIR)\zlib\win32\zlib1.dll $(OUT_DIR)\zlib1.dll +$(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win32\zdll.lib + $(COPY) $(COMPATDIR)\zlib\win32\zdll.lib $(OUT_DIR)\zdll.lib +$(OUT_DIR)\libtommath.dll: $(TOMMATHDIR)\win32\libtommath.dll + $(COPY) $(TOMMATHDIR)\win32\libtommath.dll $(OUT_DIR)\libtommath.dll +$(OUT_DIR)\tommath.lib: $(TOMMATHDIR)\win32\tommath.lib + $(COPY) $(TOMMATHDIR)\win32\tommath.lib $(OUT_DIR)\tommath.lib +!endif + pkgs: @for /d %d in ($(PKGSDIR)\*) do \ @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ @@ -502,25 +600,10 @@ $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \ $(GENERICDIR:\=/)/tclOO.decls !endif -#---------------------------------------------------------------------- -# The following target generates the file generic/tclTomMath.h. -# It needs to be run (and the results checked) after updating -# to a new release of libtommath. -#---------------------------------------------------------------------- - -gentommath_h: -!if !exist($(TCLSH)) - @echo Build tclsh first! -!else - $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \ - "$(TOMMATHDIR:\=/)/tommath.h" \ - > "$(GENERICDIR)\tclTomMath.h" -!endif - #--------------------------------------------------------------------- # Build the Windows HTML help file. #--------------------------------------------------------------------- # NOTE: you can define HHC on the command-line to override this. @@ -580,21 +663,20 @@ $(OUT_DIR)\tcl.nmake: @type << >$@ CORE_MACHINE = $(MACHINE) CORE_DEBUG = $(DEBUG) CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC) -CORE_USE_WIDECHAR_API = $(USE_WIDECHAR_API) << #--------------------------------------------------------------------- # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- tclConfig: $(OUT_DIR)\tclConfig.sh # TBD - is this tclConfig.sh file ever used? The values are incorrect! -$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in +$(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in @echo Creating tclConfig.sh @nmakehlp -s << $** >$@ @TCL_DLL_FILE@ $(TCLLIBNAME) @TCL_VERSION@ $(DOTVERSION) @TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION) @@ -665,26 +747,26 @@ #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- -$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c - $(cc32) $(appcflags) -DTCL_TEST \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ +$(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c + $(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \ + /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? -$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c - $(cc32) $(pkgcflags) -DTCL_ASCII_MAIN \ +$(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c + $(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \ -Fo$@ $? $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? -$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c +$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? $(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $? @@ -691,45 +773,37 @@ $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $? $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c $(cc32) $(pkgcflags) \ - -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ - -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ - -DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\"" \ - -DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\"" \ + /DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ + /DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \ + /DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\"" \ + /DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\"" \ -Fo$@ $? -$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c - $(cc32) $(appcflags) \ - -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ +$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c + $(cc32) $(appcflags) /DUNICODE /D_UNICODE \ + /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \ -Fo$@ $? ### The following objects should be built using the stub interfaces -$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c -!if $(STATIC_BUILD) - $(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $? -!else - $(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $? -!endif +$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c + $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $? -$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c -!if $(STATIC_BUILD) - $(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $? -!else - $(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $? -!endif +$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c + $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $? ### The following objects are part of the stub library and should not ### be built as DLL objects. -Zl is used to avoid a dependency on any ### specific C run-time. @@ -741,14 +815,14 @@ $(cc32) $(stubscflags) -Fo$@ $? $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(stubscflags) -Fo$@ $? -$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c +$(TMP_DIR)\tclWinPanic.obj: $(WIN_DIR)\tclWinPanic.c $(cc32) $(stubscflags) -Fo$@ $? -$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in +$(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @nmakehlp -s << $** >$@ @MACHINE@ $(MACHINE:IX86=X86) @TCL_WIN_VERSION@ $(DOTVERSION).0.0 << @@ -763,12 +837,12 @@ depend: !if !exist($(TCLSH)) @echo Build tclsh first! !else $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \ - -passthru:"-DBUILD_tcl $(TCL_INCLUDES) $(PRJ_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ - $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<< + -passthru:"/DBUILD_tcl $(TCL_INCLUDES) $(PRJ_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \ + $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<< $(TCLOBJS) << !endif #--------------------------------------------------------------------- @@ -801,11 +875,11 @@ {$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj:: $(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<< $< << -$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WINDIR)\tclsh.rc +$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc #--------------------------------------------------------------------- # Installation. #--------------------------------------------------------------------- @@ -815,10 +889,12 @@ @echo Installing $(TCLLIBNAME) !if "$(TCLLIB)" != "$(TCLIMPLIB)" @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\" !endif @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\" + @$(CPY) "$(OUT_DIR)\zlib1.dll" "$(BIN_INSTALL_DIR)\" + @$(CPY) "$(OUT_DIR)\libtommath.dll" "$(BIN_INSTALL_DIR)\" !if exist($(TCLSH)) @echo Installing $(TCLSHNAME) @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\" !endif @echo Installing $(TCLSTUBLIBNAME) @@ -825,26 +901,37 @@ @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @if not exist "$(SCRIPT_INSTALL_DIR)" \ $(MKDIR) "$(SCRIPT_INSTALL_DIR)" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0" - @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform$(NULL)" \ - $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform" + @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" + @if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" \ + $(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" + @if not exist "$(MODULE_INSTALL_DIR)" \ + $(MKDIR) "$(MODULE_INSTALL_DIR)" + @if not exist "$(MODULE_INSTALL_DIR)\8.4" \ + $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4" + @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \ + $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform" + @if not exist "$(MODULE_INSTALL_DIR)\8.5" \ + $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5" + @if not exist "$(MODULE_INSTALL_DIR)\8.6" \ + $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6" + @if not exist "$(MODULE_INSTALL_DIR)\8.7" \ + $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7" + @if not exist "$(LIB_INSTALL_DIR)\nmake" \ + $(MKDIR) "$(LIB_INSTALL_DIR)\nmake" @echo Installing header files @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\" + @$(CPY) "$(TOMMATHDIR)\tommath.h" "$(INCLUDE_INSTALL_DIR)\" @echo Installing library files to $(SCRIPT_INSTALL_DIR) @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\" @@ -853,33 +940,38 @@ @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" - @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" - @$(CPY) "$(WINDIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\" - @$(CPY) "$(WINDIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" - @$(CPY) "$(WINDIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\" + @$(CPY) "$(WIN_DIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" + @$(CPY) "$(WIN_DIR)\rules.vc" "$(LIB_INSTALL_DIR)\nmake\" + @$(CPY) "$(WIN_DIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\" + @$(CPY) "$(WIN_DIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\" @$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\" - @echo Installing library opt0.4 directory + @echo Installing package cookiejar $(PKG_COOKIEJAR_VER) + @$(CPY) "$(ROOT)\library\cookiejar\*.tcl" \ + "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\" + @$(CPY) "$(ROOT)\library\cookiejar\*.gz" \ + "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\" + @echo Installing package opt $(PKG_OPT_VER) @$(CPY) "$(ROOT)\library\opt\*.tcl" \ "$(SCRIPT_INSTALL_DIR)\opt0.4\" @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\http\http.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\http-$(PKG_HTTP_VER).tm" + "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm" @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\msgcat-$(PKG_MSGCAT_VER).tm" + "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm" @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\tcltest-$(PKG_TCLTEST_VER).tm" + "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm" @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\platform.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform-$(PKG_PLATFORM_VER).tm" + "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm" @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module @$(COPY) "$(ROOT)\library\platform\shell.tcl" \ - "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform\shell-$(PKG_SHELL_VER).tm" + "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm" @echo Installing $(TCLDDELIBNAME) !if $(STATIC_BUILD) !if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\" !endif Index: win/nmakehlp.c ================================================================== --- win/nmakehlp.c +++ win/nmakehlp.c @@ -641,11 +641,11 @@ } fclose(sp); } /* debug: dump the list */ -#ifdef _DEBUG +#ifndef NDEBUG { int n = 0; list_item_t *p = NULL; for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); Index: win/rules.vc ================================================================== --- win/rules.vc +++ win/rules.vc @@ -4,11 +4,11 @@ # Part of the nmake based build system for Tcl and its extensions. # This file does all the hard work in terms of parsing build options, # compiler switches, defining common targets and macros. The Tcl makefile # directly includes this. Extensions include it via "rules-ext.vc". # -# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for +# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for # detailed documentation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # @@ -22,11 +22,11 @@ # The following macros define the version of the rules.vc nmake build system # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 -RULES_VERSION_MINOR = 3 +RULES_VERSION_MINOR = 6 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" !error *** Error: Macro PROJECT not defined! Please define it before including rules.vc !endif @@ -160,11 +160,11 @@ # The fragment will set the following macros: # ROOT - root of this module sources # COMPATDIR - source directory that holds compatibility sources # DOCDIR - source directory containing documentation files # GENERICDIR - platform-independent source directory -# WINDIR - Windows-specific source directory +# WIN_DIR - Windows-specific source directory # TESTDIR - directory containing test files # TOOLSDIR - directory containing build tools # _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set # when building Tcl itself. # _INSTALLDIR - native form of the installation path. For Tcl @@ -213,21 +213,19 @@ DEMODIR = $(LIBDIR)\demos !else DEMODIR = $(ROOT)\demos !endif !endif # ifndef DEMODIR -# Do NOT enclose WINDIR in a !ifndef because Windows always defines -# WINDIR env var to point to c:\windows! -# TBD - This is a potentially dangerous conflict, rename WINDIR to -# something else -WINDIR = $(ROOT)\win +# Do NOT use WINDIR because it is Windows internal environment +# variable to point to c:\windows! +WIN_DIR = $(ROOT)\win !ifndef RCDIR -!if exist("$(WINDIR)\rc") -RCDIR = $(WINDIR)\rc +!if exist("$(WIN_DIR)\rc") +RCDIR = $(WIN_DIR)\rc !else -RCDIR = $(WINDIR) +RCDIR = $(WIN_DIR) !endif !endif RCDIR = $(RCDIR:/=\) # The target directory where the built packages and binaries will be installed. @@ -302,11 +300,11 @@ # NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions # later so the \.. accounts for the /lib _TCLDIR = $(_INSTALLDIR)\.. _TCL_H = $(_TCLDIR)\include\tcl.h -!else # exist(...) && ! $(NEED_TCL_SOURCE) +!else # exist(...) && !$(NEED_TCL_SOURCE) !if [echo _TCLDIR = \> nmakehlp.out] \ || [nmakehlp -L generic\tcl.h >> nmakehlp.out] !error *** Could not locate Tcl source directory. !endif @@ -313,11 +311,11 @@ !include nmakehlp.out TCLINSTALL = 0 TCLDIR = $(_TCLDIR) _TCL_H = $(_TCLDIR)\generic\tcl.h -!endif # exist(...) && ! $(NEED_TCL_SOURCE) +!endif # exist(...) && !$(NEED_TCL_SOURCE) !endif # TCLDIR !ifndef _TCL_H MSG =^ @@ -537,11 +535,11 @@ !if !$(DOING_TCL) !if $(TCLINSTALL) !if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c") NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c !endif -!else # ! $(TCLINSTALL) +!else # !$(TCLINSTALL) !if exist("$(_TCLDIR)\win\nmakehlp.c") NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c !endif !endif # $(TCLINSTALL) !endif # !$(DOING_TCL) @@ -684,10 +682,14 @@ # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) +# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build +# (CRT library should support this, not needed for Tcl 9.x) +# TCL_UTF_MAX=4 - forces a build allowing 4-byte UTF-8 sequences internally. +# (Not needed for Tcl 9.x) # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 @@ -726,25 +728,38 @@ !message *** Doing nomsvcrt MSVCRT = 0 !else !if [nmakehlp -f $(OPTS) "msvcrt"] !message *** Doing msvcrt -MSVCRT = 1 !else -!if !$(STATIC_BUILD) -MSVCRT = 1 -!else +!if $(STATIC_BUILD) MSVCRT = 0 !endif !endif !endif # [nmakehlp -f $(OPTS) "nomsvcrt"] !if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) !message *** Doing staticpkg TCL_USE_STATIC_PACKAGES = 1 -!else -TCL_USE_STATIC_PACKAGES = 0 +!endif + +!if [nmakehlp -f $(OPTS) "nothreads"] +!message *** Compile explicitly for non-threaded tcl +TCL_THREADS = 0 +USE_THREAD_ALLOC= 0 +!endif + +!if "$(TCL_MAJOR_VERSION)" == "8" +!if [nmakehlp -f $(OPTS) "time64bit"] +!message *** Force 64-bit time_t +_USE_64BIT_TIME_T = 1 +!endif + +!if [nmakehlp -f $(OPTS) "utfmax"] +!message *** Force allowing 4-byte UTF-8 sequences internally +TCL_UTF_MAX = 4 +!endif !endif # Yes, it's weird that the "symbols" option controls DEBUG and # the "pdbs" option controls SYMBOLS. That's historical. !if [nmakehlp -f $(OPTS) "symbols"] @@ -779,10 +794,16 @@ !endif !if [nmakehlp -f $(OPTS) "loimpact"] !message *** Warning: ignoring option "loimpact" - deprecated on modern Windows. !endif + +# TBD - should get rid of this option +!if [nmakehlp -f $(OPTS) "thrdalloc"] +!message *** Doing thrdalloc +USE_THREAD_ALLOC = 1 +!endif !if [nmakehlp -f $(OPTS) "tclalloc"] USE_THREAD_ALLOC = 0 !endif @@ -962,10 +983,23 @@ !include versions.vc !endif # DOTVERSION VERSION = $(DOTVERSION:.=) !endif # $(DOING_TCL) ... etc. + +# Windows RC files have 3 version components. Ensure this irrespective +# of how many components the package has specified. Basically, ensure +# minimum 4 components by appending 4 0's and then pick out the first 4. +# Also take care of the fact that DOTVERSION may have "a" or "b" instead +# of "." separating the version components. +DOTSEPARATED=$(DOTVERSION:a=.) +DOTSEPARATED=$(DOTSEPARATED:b=.) +!if [echo RCCOMMAVERSION = \> versions.vc] \ + || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc] +!error *** Could not generate RCCOMMAVERSION *** +!endif +!include versions.vc ################################################################ # 10. Construct output directory and file paths # Figure-out how to name our intermediate and output directories. # In order to avoid inadvertent mixing of object files built using @@ -1069,13 +1103,13 @@ TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) -TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" +TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" -!else # ! $(DOING_TCL) +!else # !$(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl # When building extensions, we need to locate tclsh. Depending on version # of Tcl we are building against, this may or may not have a "t" suffix. @@ -1144,11 +1178,11 @@ !if $(DOING_TK) WISH = $(OUT_DIR)\$(WISHNAME) TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME) TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME) TKLIB = $(OUT_DIR)\$(TKLIBNAME) -TK_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" +TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" !else # effectively NEED_TK !if $(TKINSTALL) # Building against installed Tk WISH = $(_TKDIR)\bin\$(WISHNAME) @@ -1177,12 +1211,12 @@ !endif # $(DOING_TK) !endif # $(DOING_TK) || $(NEED_TK) # Various output paths -PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib -PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT) +PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib +PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) @@ -1211,10 +1245,11 @@ LIB_INSTALL_DIR = $(_INSTALLDIR)\lib BIN_INSTALL_DIR = $(_INSTALLDIR)\bin DOC_INSTALL_DIR = $(_INSTALLDIR)\doc !if $(DOING_TCL) SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) +MODULE_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(TCL_MAJOR_VERSION) !else # DOING_TK SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) !endif DEMO_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)\demos INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include @@ -1255,86 +1290,91 @@ # conlflags - complete linker switches for console program (subsumes lflags) # guilflags - complete linker switches for GUI program (subsumes lflags) # baselibs - minimum Windows libraries required. Parent makefile can # define PRJ_LIBS before including rules.rc if additional libs are needed -OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS +OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS +!if $(VCVERSION) >= 1600 +OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 +!else +OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 +!endif +!if $(VCVERSION) >= 1800 +OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1 +!endif !if $(TCL_MEM_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG +OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG !endif !if $(TCL_COMPILE_DEBUG) -OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS !endif -!if $(TCL_THREADS) && $(TCL_VERSION) < 86 -OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 -!if $(USE_THREAD_ALLOC) -OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 +!if $(TCL_THREADS) && $(TCL_VERSION) < 87 +OPTDEFINES = $(OPTDEFINES) /DTCL_THREADS=1 +!if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87 +OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1 !endif !endif !if $(STATIC_BUILD) -OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD +OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD +!elseif $(TCL_VERSION) > 86 +OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH +!if "$(MACHINE)" == "AMD64" +OPTDEFINES = $(OPTDEFINES) /DMP_64BIT +!endif !endif !if $(TCL_NO_DEPRECATED) -OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED +OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED !endif !if $(USE_STUBS) # Note we do not define USE_TCL_STUBS even when building tk since some # test targets in tk do not use stubs -!if ! $(DOING_TCL) -USE_STUBS_DEFS = -DUSE_TCL_STUBS -DUSE_TCLOO_STUBS +!if !$(DOING_TCL) +USE_STUBS_DEFS = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS !if $(NEED_TK) -USE_STUBS_DEFS = $(USE_STUBS_DEFS) -DUSE_TK_STUBS +USE_STUBS_DEFS = $(USE_STUBS_DEFS) /DUSE_TK_STUBS !endif !endif !endif # USE_STUBS !if !$(DEBUG) -OPTDEFINES = $(OPTDEFINES) -DNDEBUG +OPTDEFINES = $(OPTDEFINES) /DNDEBUG !if $(OPTIMIZING) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED !endif !endif !if $(PROFILE) -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED !endif !if "$(MACHINE)" == "AMD64" -OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT !endif !if $(VCVERSION) < 1300 -OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 +OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 +!endif + +!if "$(TCL_MAJOR_VERSION)" == "8" +!if "$(_USE_64BIT_TIME_T)" == "1" +OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 +!endif +!if "$(TCL_UTF_MAX)" == "4" +OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=4 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING - -# Following is primarily for the benefit of extensions. Tcl 8.5 builds -# Tcl without /DUNICODE, while 8.6 builds with it defined. When building -# an extension, it is advisable (but not mandated) to use the same Windows -# API as the Tcl build. This is accordingly defaulted below. A particular -# extension can override this by pre-definining USE_WIDECHAR_API. -!ifndef USE_WIDECHAR_API -!if $(TCL_VERSION) > 85 -USE_WIDECHAR_API = 1 -!else -USE_WIDECHAR_API = 0 -!endif -!endif - -!if $(USE_WIDECHAR_API) -COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE !endif # Like the TEA system only set this non empty for non-Tk extensions # Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME # so we pass both !if !$(DOING_TCL) && !$(DOING_TK) -PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ - -DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ - -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \ - -DMODULE_SCOPE=extern +PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ + /DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ + /DPACKAGE_VERSION="\"$(DOTVERSION)\"" \ + /DMODULE_SCOPE=extern !endif # crt picks the C run time based on selected OPTS !if $(MSVCRT) !if $(DEBUG) && !$(UNCHECKED) @@ -1377,11 +1417,11 @@ cwarn = $(cwarn) -wd4311 -wd4312 !endif ### Common compiler options that are architecture specific !if "$(MACHINE)" == "ARM" -carch = -D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE +carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE !else carch = !endif !if $(DEBUG) @@ -1389,11 +1429,11 @@ cwarn = $(cwarn) -WX !endif INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES) !if !$(DOING_TCL) && !$(DOING_TK) -INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WINDIR)" -I"$(COMPATDIR)" +INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)" !endif # These flags are defined roughly in the order of the pre-reform # rules.vc/makefile.vc to help visually compare that the pre- and # post-reform build logs @@ -1405,27 +1445,27 @@ # object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus # flags used for building shared object files The two differ in the # BUILD_$(PROJECT) macro which should be defined only for the shared # library *implementation* and not for its caller interface -appcflags = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) $(USE_STUBS_DEFS) appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) -pkgcflags = $(appcflags) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) -pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT) +appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS) +pkgcflags = $(appcflags) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT) +pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT) # stubscflags contains $(cflags) plus flags used for building a stubs -# library for the package. Note: -DSTATIC_BUILD is defined in +# library for the package. Note: /DSTATIC_BUILD is defined in # $(OPTDEFINES) only if the OPTS configuration indicates a static # library. However the stubs library is ALWAYS static hence included # here irrespective of the OPTS setting. # # TBD - tclvfs has a comment that stubs libs should not be compiled with -GL # without stating why. Tcl itself compiled stubs libs with this flag. # so we do not remove it from cflags. -GL may prevent extensions # compiled with one VC version to fail to link against stubs library # compiled with another VC version. Check for this and fix accordingly. -stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES) +stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS) # Link flags !if $(DEBUG) ldebug = -debug -debugtype:cv @@ -1445,10 +1485,22 @@ lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) !if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 lflags = $(lflags) -nodefaultlib:libucrt.lib !endif + +# Old linkers (Visual C++ 6 in particular) will link for fast loading +# on Win98. Since we do not support Win98 any more, we specify nowin98 +# as recommended for NT and later. However, this is only required by +# IX86 on older compilers and only needed if we are not doing a static build. + +!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD) +!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)] +# Align sections for PE size savings. +lflags = $(lflags) -opt:nowin98 +!endif +!endif dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console guilflags = $(lflags) -subsystem:windows @@ -1486,17 +1538,17 @@ CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ $(TCL_INCLUDES) \ - -DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ - -DCOMMAVERSION=$(DOTVERSION:.=,),0 \ - -DDOTVERSION=\"$(DOTVERSION)\" \ - -DVERSION=\"$(VERSION)\" \ - -DSUFX=\"$(SUFX:t=)\" \ - -DPROJECT=\"$(PROJECT)\" \ - -DPRJLIBNAME=\"$(PRJLIBNAME)\" + /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ + /DCOMMAVERSION=$(RCCOMMAVERSION) \ + /DDOTVERSION=\"$(DOTVERSION)\" \ + /DVERSION=\"$(VERSION)\" \ + /DSUFX=\"$(SUFX)\" \ + /DPROJECT=\"$(PROJECT)\" \ + /DPRJLIBNAME=\"$(PRJLIBNAME)\" !ifndef DEFAULT_BUILD_TARGET DEFAULT_BUILD_TARGET = $(PROJECT) !endif @@ -1571,24 +1623,24 @@ @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)" default-clean: @echo Cleaning $(TMP_DIR)\* ... @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) - @echo Cleaning $(WINDIR)\nmakehlp.obj, nmakehlp.exe ... - @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj - @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe - @if exist $(WINDIR)\nmakehlp.out del $(WINDIR)\nmakehlp.out - @echo Cleaning $(WINDIR)\nmhlp-out.txt ... - @if exist $(WINDIR)\nmhlp-out.txt del $(WINDIR)\nmhlp-out.txt - @echo Cleaning $(WINDIR)\_junk.pch ... - @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch - @echo Cleaning $(WINDIR)\vercl.x, vercl.i ... - @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x - @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i - @echo Cleaning $(WINDIR)\versions.vc, version.vc ... - @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc - @if exist $(WINDIR)\version.vc del $(WINDIR)\version.vc + @echo Cleaning $(WIN_DIR)\nmakehlp.obj, nmakehlp.exe ... + @if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj + @if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe + @if exist $(WIN_DIR)\nmakehlp.out del $(WIN_DIR)\nmakehlp.out + @echo Cleaning $(WIN_DIR)\nmhlp-out.txt ... + @if exist $(WIN_DIR)\nmhlp-out.txt del $(WIN_DIR)\nmhlp-out.txt + @echo Cleaning $(WIN_DIR)\_junk.pch ... + @if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch + @echo Cleaning $(WIN_DIR)\vercl.x, vercl.i ... + @if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x + @if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i + @echo Cleaning $(WIN_DIR)\versions.vc, version.vc ... + @if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc + @if exist $(WIN_DIR)\version.vc del $(WIN_DIR)\version.vc default-hose: default-clean @echo Hosing $(OUT_DIR)\* ... @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) @@ -1676,11 +1728,11 @@ {$(ROOT)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << -{$(WINDIR)}.c{$(TMP_DIR)}.obj:: +{$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: $(CCPKGCMD) @<< $< << {$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: @@ -1694,11 +1746,11 @@ << {$(RCDIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< -{$(WINDIR)}.rc{$(TMP_DIR)}.res: +{$(WIN_DIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< {$(TMP_DIR)}.rc{$(TMP_DIR)}.res: $(RESCMD) $< @@ -1710,17 +1762,17 @@ ################################################################ # 14. Sanity check selected options against Tcl build options # When building an extension, certain configuration options should # match the ones used when Tcl was built. Here we check and # warn on a mismatch. -!if ! $(DOING_TCL) +!if !$(DOING_TCL) !if $(TCLINSTALL) # Building against an installed Tcl !if exist("$(_TCLDIR)\lib\nmake\tcl.nmake") TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake" !endif -!else # ! $(TCLINSTALL) - building against Tcl source +!else # !$(TCLINSTALL) - building against Tcl source !if exist("$(OUT_DIR)\tcl.nmake") TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake" !endif !endif # TCLINSTALL @@ -1729,18 +1781,21 @@ !include $(TCLNMAKECONFIG) !if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" !error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). !endif +!if $(TCL_VERSION) < 87 && defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) +!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)). +!endif !if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) !message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)). !endif !endif !endif # TCLNMAKECONFIG -!endif # ! $(DOING_TCL) +!endif # !$(DOING_TCL) #---------------------------------------------------------- # Display stats being used. #---------------------------------------------------------- Index: win/targets.vc ================================================================== --- win/targets.vc +++ win/targets.vc @@ -2,11 +2,11 @@ # targets.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file defines some standard targets for the convenience of extensions # and can be optionally included by the extension makefile. -# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs. +# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for docs. $(PROJECT): setup pkgindex $(PRJLIB) !ifdef PRJ_STUBOBJS $(PROJECT): $(PRJSTUBLIB) Index: win/tcl.dsp ================================================================== --- win/tcl.dsp +++ win/tcl.dsp @@ -34,20 +34,20 @@ # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh90.exe" +# PROP BASE Target_File "Release\tclsh87.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" -# PROP Target_File "Release\tclsh90t.exe" +# PROP Target_File "Release\tclsh87t.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Debug" @@ -55,20 +55,20 @@ # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh90g.exe" +# PROP BASE Target_File "Debug\tclsh87g.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "Debug" # PROP Intermediate_Dir "Debug\tcl_Dynamic" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE" # PROP Rebuild_Opt "clean release" -# PROP Target_File "Debug\tclsh90tg.exe" +# PROP Target_File "Debug\tclsh87tg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Debug Static" @@ -76,20 +76,20 @@ # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "Debug\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Debug\tclsh90sg.exe" +# PROP BASE Target_File "Debug\tclsh87sg.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "Debug" # PROP Intermediate_Dir "Debug\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" -# PROP Target_File "Debug\tclsh90sg.exe" +# PROP Target_File "Debug\tclsh87sg.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "tcl - Win32 Release Static" @@ -97,20 +97,20 @@ # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "Release" # PROP BASE Intermediate_Dir "Release\tcl_Static" # PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP BASE Rebuild_Opt "-a" -# PROP BASE Target_File "Release\tclsh90s.exe" +# PROP BASE Target_File "Release\tclsh87s.exe" # PROP BASE Bsc_Name "" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "Release" # PROP Intermediate_Dir "Release\tcl_Static" # PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE" # PROP Rebuild_Opt "-a" -# PROP Target_File "Release\tclsh90s.exe" +# PROP Target_File "Release\tclsh87s.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ENDIF @@ -146,14 +146,10 @@ SOURCE=..\compat\dlfcn.h # End Source File # Begin Source File -SOURCE=..\compat\fixstrtod.c -# End Source File -# Begin Source File - SOURCE=..\compat\gettod.c # End Source File # Begin Source File SOURCE=..\compat\limits.h @@ -184,14 +180,10 @@ # End Source File # Begin Source File SOURCE=..\compat\strstr.c # End Source File -# Begin Source File - -SOURCE=..\compat\strtod.c -# End Source File # Begin Source File SOURCE=..\compat\strtol.c # End Source File # Begin Source File Index: win/tcl.hpj.in ================================================================== --- win/tcl.hpj.in +++ win/tcl.hpj.in @@ -3,13 +3,13 @@ [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl90.cnt +CNT=tcl87.cnt COPYRIGHT=Copyright � 2000 Ajuba Solutions -HLP=tcl90.hlp +HLP=tcl87.hlp [FILES] tcl.rtf [WINDOWS] Index: win/tcl.m4 ================================================================== --- win/tcl.m4 +++ win/tcl.m4 @@ -539,18 +539,18 @@ ) if test "$ac_cv_cross" = "yes"; then case "$do64bit" in amd64|x64|yes) - CC="x86_64-w64-mingw32-gcc" + CC="x86_64-w64-mingw32-${CC}" LD="x86_64-w64-mingw32-ld" AR="x86_64-w64-mingw32-ar" RANLIB="x86_64-w64-mingw32-ranlib" RC="x86_64-w64-mingw32-windres" ;; *) - CC="i686-w64-mingw32-gcc" + CC="i686-w64-mingw32-${CC}" LD="i686-w64-mingw32-ld" AR="i686-w64-mingw32-ar" RANLIB="i686-w64-mingw32-ranlib" RC="i686-w64-mingw32-windres" ;; @@ -683,13 +683,22 @@ EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith" + CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= + + case "${CC}" in + *++) + CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format" + ;; + *) + CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement" + ;; + esac # Specify the CC output file names based on the target name CC_OBJNAME="-o \[$]@" CC_EXENAME="-o \[$]@" @@ -762,32 +771,19 @@ # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" - # This is a 2-stage check to make sure we have the 64-bit SDK - # We have to know where the SDK is installed. - # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs if test "$do64bit" != "no" ; then - if test "x${MSSDK}x" = "xx" ; then - MSSDK="C:/Progra~1/Microsoft Platform SDK" - fi - MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` - PATH64="" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" - PATH64="${MSSDK}/Bin/Win64" ;; esac - if test ! -d "${PATH64}" ; then - AC_MSG_WARN([Could not find 64-bit $MACHINE SDK]) - fi AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" @@ -798,25 +794,16 @@ *) ;; esac if test "$do64bit" != "no" ; then - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. TEA has the - # TEA_PATH_NOSPACE to avoid this issue. - # Check if _WIN64 is already recognized, and if so we don't - # need to modify CC. - AC_CHECK_DECL([_WIN64], [], - [CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ - -I\"${MSSDK}/Include/crt\" \ - -I\"${MSSDK}/Include/crt/sys\""]) - RC="\"${MSSDK}/bin/rc.exe\"" + RC="rc" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" - LINKBIN="\"${PATH64}/link.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE}" + LINKBIN="link" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="$LIBS bufferoverflowU.lib" else RC="rc" @@ -946,10 +933,12 @@ if test "$tcl_cv_winnt_ignore_void" = "yes" ; then AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, [Defined when cygwin/mingw ignores VOID define in winnt.h]) fi + AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have ?])],) + # See if the compiler supports casting to a union type. # This is used to stop gcc from printing a compiler # warning when initializing a union member. AC_CACHE_CHECK(for cast to union support, @@ -991,17 +980,17 @@ # Defines the following vars: # TCL_BIN_DIR Full path to the tcl build dir. #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl9.0$1/win; then - TCL_BIN_DEFAULT=../../tcl9.0$1/win + if test -d ../../tcl8.7$1/win; then + TCL_BIN_DEFAULT=../../tcl8.7$1/win else - TCL_BIN_DEFAULT=../../tcl9.0/win + TCL_BIN_DEFAULT=../../tcl8.7/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) fi if test ! -f $TCL_BIN_DIR/Makefile; then Index: win/tclAppInit.c ================================================================== --- win/tclAppInit.c +++ win/tclAppInit.c @@ -85,21 +85,22 @@ #ifdef TCL_BROKEN_MAINARGS int main( int argc, /* Number of command-line arguments. */ - char *dummy[]) /* Not used. */ + char **argv1) { TCHAR **argv; + TCHAR *p; #else int _tmain( int argc, /* Number of command-line arguments. */ TCHAR *argv[]) /* Values of command-line arguments. */ { -#endif TCHAR *p; +#endif /* * Set up the default locale to be standard "C" locale so parsing is * performed correctly. */ @@ -109,10 +110,11 @@ #ifdef TCL_BROKEN_MAINARGS /* * Get our args from the c-runtime. Ignore command line. */ + (void)argv1; setargv(&argc, &argv); #endif /* * Forward slashes substituted for backslashes. @@ -265,14 +267,15 @@ break; } } } - /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */ + /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ # undef Tcl_Alloc +# undef Tcl_DbCkalloc - argSpace = Tcl_Alloc(size * sizeof(char *) + argSpace = (TCHAR *)ckalloc(size * sizeof(char *) + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); argv = (TCHAR **) argSpace; argSpace += size * (sizeof(char *)/sizeof(TCHAR)); size--; Index: win/tclWin32Dll.c ================================================================== --- win/tclWin32Dll.c +++ win/tclWin32Dll.c @@ -88,11 +88,11 @@ BOOL APIENTRY DllEntryPoint( HINSTANCE hInst, /* Library instance handle. */ DWORD reason, /* Reason this function is being called. */ - LPVOID reserved) /* Not used. */ + LPVOID reserved) { return DllMain(hInst, reason, reserved); } /* @@ -115,11 +115,11 @@ BOOL APIENTRY DllMain( HINSTANCE hInst, /* Library instance handle. */ DWORD reason, /* Reason this function is being called. */ - LPVOID reserved) /* Not used. */ + TCL_UNUSED(LPVOID)) { switch (reason) { case DLL_PROCESS_ATTACH: DisableThreadLibraryCalls(hInst); TclWinInit(hInst); @@ -253,12 +253,12 @@ Tcl_MutexLock(&mountPointMap); dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; - Tcl_Free(dlIter->volumeName); - Tcl_Free(dlIter); + ckfree(dlIter->volumeName); + ckfree(dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); } @@ -288,11 +288,11 @@ TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint) { MountPointMap *dlIter, *dlPtr2; WCHAR Target[55]; /* Target of mount at mount point */ - WCHAR drive[4] = TEXT("A:\\"); + WCHAR drive[4] = L"A:\\"; /* * Detect the volume mounted there. Unfortunately, there is no simple way * to map a unique volume name to a DOS drive letter. So, we have to build * an associative array. @@ -312,11 +312,11 @@ /* * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPoint(drive, + if (GetVolumeNameForVolumeMountPointW(drive, Target, 55) != 0) { if (wcscmp(dlIter->volumeName, Target) == 0) { /* * Nothing has changed. */ @@ -347,12 +347,12 @@ /* * Now dlPtr2 points to the structure to free. */ - Tcl_Free(dlPtr2->volumeName); - Tcl_Free(dlPtr2); + ckfree(dlPtr2->volumeName); + ckfree(dlPtr2); /* * Restart the loop - we could try to be clever and continue half * way through, but the logic is a bit messy, so it's cleanest * just to restart. @@ -366,16 +366,16 @@ /* * We couldn't find it, so we must iterate over the letters. */ - for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) { + for (drive[0] = 'A'; drive[0] <= 'Z'; drive[0]++) { /* * Try to read the volume mount point and see where it points. */ - if (GetVolumeNameForVolumeMountPoint(drive, + if (GetVolumeNameForVolumeMountPointW(drive, Target, 55) != 0) { int alreadyStored = 0; for (dlIter = driveLetterLookup; dlIter != NULL; dlIter = dlIter->nextPtr) { @@ -383,12 +383,12 @@ alreadyStored = 1; break; } } if (!alreadyStored) { - dlPtr2 = Tcl_Alloc(sizeof(MountPointMap)); - dlPtr2->volumeName = TclNativeDupInternalRep(Target); + dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target); dlPtr2->driveLetter = (char) drive[0]; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; } } @@ -409,12 +409,12 @@ /* * The volume doesn't appear to correspond to a drive letter - we remember * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = Tcl_Alloc(sizeof(MountPointMap)); - dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint); + dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint); dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; driveLetterLookup = dlPtr2; Tcl_MutexUnlock(&mountPointMap); return -1; @@ -461,44 +461,36 @@ * None. * *--------------------------------------------------------------------------- */ -WCHAR * -Tcl_WinUtfToTChar( - const char *string, /* Source string in UTF-8. */ - size_t len, /* Source string length in bytes, or -1 - * for strlen(). */ - Tcl_DString *dsPtr) /* Uninitialized or free DString in which the - * converted string is stored. */ -{ - Tcl_DStringInit(dsPtr); - if (!string) { - return NULL; - } - return TclUtfToWCharDString(string, len, dsPtr); -} - -char * -Tcl_WinTCharToUtf( - const WCHAR *string, /* Source string in Unicode. */ - size_t len, /* Source string length in bytes, or -1 - * for platform-specific string length. */ - Tcl_DString *dsPtr) /* Uninitialized or free DString in which the - * converted string is stored. */ -{ - Tcl_DStringInit(dsPtr); - if (!string) { - return NULL; - } - if (len == TCL_AUTO_LENGTH) { - len = wcslen((WCHAR *)string); - } else { - len /= 2; - } - return TclWCharToUtfDString((unsigned short *)string, len, dsPtr); -} +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#undef Tcl_WinUtfToTChar +TCHAR * +Tcl_WinUtfToTChar( + const char *string, /* Source string in UTF-8. */ + int len, /* Source string length in bytes, or -1 for + * strlen(). */ + Tcl_DString *dsPtr) /* Uninitialized or free DString in which the + * converted string is stored. */ +{ + Tcl_DStringInit(dsPtr); + return (TCHAR *)Tcl_UtfToWCharDString(string, len, dsPtr); +} +#undef Tcl_WinTCharToUtf +char * +Tcl_WinTCharToUtf( + const TCHAR *string, /* Source string in Unicode. */ + int len, /* Source string length in bytes, or -1 for + * platform-specific string length. */ + Tcl_DString *dsPtr) /* Uninitialized or free DString in which the + * converted string is stored. */ +{ + Tcl_DStringInit(dsPtr); + return Tcl_WCharToUtfDString((WCHAR *)string, len >> 1, dsPtr); +} +#endif /* !defined(TCL_NO_DEPRECATED) */ /* *------------------------------------------------------------------------ * * TclWinCPUID -- @@ -545,11 +537,11 @@ "movl %[index], %%eax" "\n\t" "cpuid" "\n\t" "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" - "movl %%edx, 0xc(%%edi)" "\n\t" + "movl %%edx, 0xC(%%edi)" "\n\t" : /* No outputs */ : [index] "m" (index), @@ -577,11 +569,11 @@ "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain */ @@ -597,11 +589,11 @@ "movl %[index], %%eax" "\n\t" "cpuid" "\n\t" "movl %%eax, 0x0(%%edi)" "\n\t" "movl %%ebx, 0x4(%%edi)" "\n\t" "movl %%ecx, 0x8(%%edi)" "\n\t" - "movl %%edx, 0xc(%%edi)" "\n\t" + "movl %%edx, 0xC(%%edi)" "\n\t" /* * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and * store a TCL_OK status. */ @@ -624,11 +616,11 @@ * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : Index: win/tclWinChan.c ================================================================== --- win/tclWinChan.c +++ win/tclWinChan.c @@ -74,21 +74,23 @@ static int FileBlockProc(ClientData instanceData, int mode); static void FileChannelExitHandler(ClientData clientData); static void FileCheckProc(ClientData clientData, int flags); static int FileCloseProc(ClientData instanceData, - Tcl_Interp *interp); + Tcl_Interp *interp, int flags); static int FileEventProc(Tcl_Event *evPtr, int flags); static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *FileInit(void); static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); +#ifndef TCL_NO_DEPRECATED static int FileSeekProc(ClientData instanceData, long offset, int mode, int *errorCode); +#endif static Tcl_WideInt FileWideSeekProc(ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode); static void FileSetupProc(ClientData clientData, int flags); static void FileWatchProc(ClientData instanceData, int mask); static void FileThreadActionProc(ClientData instanceData, @@ -103,19 +105,23 @@ */ static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - FileCloseProc, /* Close proc. */ + TCL_CLOSE2PROC, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ +#ifndef TCL_NO_DEPRECATED FileSeekProc, /* Seek proc. */ +#else + NULL, +#endif NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ FileGetHandleProc, /* Get an OS handle from channel. */ - NULL, /* close2proc. */ + FileCloseProc, /* close2proc. */ FileBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ FileWideSeekProc, /* Wide seek proc. */ FileThreadActionProc, /* Thread action proc. */ @@ -178,11 +184,11 @@ *---------------------------------------------------------------------- */ static void FileChannelExitHandler( - ClientData clientData) /* Old window proc */ + TCL_UNUSED(ClientData)) { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } /* @@ -202,11 +208,11 @@ *---------------------------------------------------------------------- */ void FileSetupProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -245,11 +251,11 @@ *---------------------------------------------------------------------- */ static void FileCheckProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; FileInfo *infoPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -265,11 +271,11 @@ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) { SET_FLAG(infoPtr->flags, FILE_PENDING); - evPtr = Tcl_Alloc(sizeof(FileEvent)); + evPtr = (FileEvent *)ckalloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } @@ -348,11 +354,11 @@ FileBlockProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; /* * Files on Windows can not be switched between blocking and nonblocking, * hence we have to emulate the behavior. This is done in the input * function by checking against a bit in the state. We set or unset the @@ -384,16 +390,21 @@ */ static int FileCloseProc( ClientData instanceData, /* Pointer to FileInfo structure. */ - Tcl_Interp *interp) /* Not used. */ + TCL_UNUSED(Tcl_Interp *), + int flags) { - FileInfo *fileInfoPtr = instanceData; + FileInfo *fileInfoPtr = (FileInfo *)instanceData; FileInfo *infoPtr; ThreadSpecificData *tsdPtr; int errorCode = 0; + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } /* * Remove the file from the watch list. */ @@ -432,11 +443,11 @@ FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); break; } } - Tcl_Free(fileInfoPtr); + ckfree(fileInfoPtr); return errorCode; } /* *---------------------------------------------------------------------- @@ -453,19 +464,19 @@ * Moves the location at which the channel will be accessed in future * operations. * *---------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED static int FileSeekProc( ClientData instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; DWORD moveMethod; *errorCodePtr = 0; if (mode == SEEK_SET) { @@ -513,10 +524,11 @@ SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); return -1; } return (int) newPos; } +#endif /* *---------------------------------------------------------------------- * * FileWideSeekProc -- @@ -539,11 +551,11 @@ ClientData instanceData, /* File state. */ Tcl_WideInt offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; DWORD moveMethod; LONG newPos, newPosHigh; *errorCodePtr = 0; if (mode == SEEK_SET) { @@ -589,11 +601,11 @@ static int FileTruncateProc( ClientData instanceData, /* File state. */ Tcl_WideInt length) /* Length to truncate at. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; LONG newPos, newPosHigh, oldPos, oldPosHigh; /* * Save where we were... */ @@ -667,11 +679,11 @@ ClientData instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; DWORD bytesRead; *errorCode = 0; /* @@ -722,11 +734,11 @@ ClientData instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; DWORD bytesWritten; *errorCode = 0; /* @@ -769,11 +781,11 @@ ClientData instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; Tcl_Time blockTime = { 0, 0 }; /* * Since the file is always ready for events, we set the block time to * zero so we will poll. @@ -807,11 +819,11 @@ FileGetHandleProc( ClientData instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ ClientData *handlePtr) /* Where to store the handle. */ { - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; if (!TEST_FLAG(direction, infoPtr->validMask)) { return TCL_ERROR; } @@ -852,11 +864,11 @@ const WCHAR *nativeName; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; TclFile readFile = NULL, writeFile = NULL; - nativeName = Tcl_FSGetNativePath(pathPtr); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": filename is invalid on this platform", TclGetString(pathPtr))); @@ -944,11 +956,11 @@ flags = FILE_ATTRIBUTE_NORMAL; } else { flags = FILE_ATTRIBUTE_READONLY; } } else { - flags = GetFileAttributes(nativeName); + flags = GetFileAttributesW(nativeName); if (flags == 0xFFFFFFFF) { flags = 0; } } @@ -960,17 +972,17 @@ /* * Now we get to create the file. */ - handle = CreateFile(nativeName, accessMode, shareMode, + handle = CreateFileW(nativeName, accessMode, shareMode, NULL, createMode, flags, (HANDLE) NULL); if (handle == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); - if ((err & 0xffffL) == ERROR_OPEN_FAILED) { + if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } TclWinConvertError(err); if (interp) { @@ -1066,11 +1078,11 @@ Tcl_MakeFileChannel( ClientData rawHandle, /* OS level handle */ int mode) /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { -#if defined(HAVE_NO_SEH) && !defined(_WIN64) +#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; HANDLE handle = (HANDLE) rawHandle; @@ -1119,11 +1131,11 @@ GetCurrentProcess(), &dupedHandle, 0, FALSE, DUPLICATE_SAME_ACCESS); if (result == 0) { /* - * Unable to make a duplicate. It's definately invalid at this + * Unable to make a duplicate. It's definitely invalid at this * point. */ return NULL; } @@ -1132,11 +1144,11 @@ * Use structured exception handling (Win32 SEH) to protect the close * of this duped handle which might throw EXCEPTION_INVALID_HANDLE. */ result = 0; -#if defined(HAVE_NO_SEH) && !defined(_WIN64) +#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__) /* * Don't have SEH available, do things the hard way. Note that this * needs to be one block of asm, to avoid stack imbalance; also, it is * illegal for one asm block to contain a jump to another. */ @@ -1158,11 +1170,11 @@ "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain. */ @@ -1198,11 +1210,11 @@ * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : @@ -1363,11 +1375,11 @@ if (infoPtr->handle == (HANDLE) handle) { return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; } } - infoPtr = Tcl_Alloc(sizeof(FileInfo)); + infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global * list. This is now handled in the thread action callbacks, and only * there. @@ -1454,11 +1466,11 @@ FileThreadActionProc( ClientData instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - FileInfo *infoPtr = instanceData; + FileInfo *infoPtr = (FileInfo *)instanceData; if (action == TCL_CHANNEL_THREAD_INSERT) { infoPtr->nextPtr = tsdPtr->firstFilePtr; tsdPtr->firstFilePtr = infoPtr; } else { @@ -1569,11 +1581,11 @@ if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) { /* * The 4th character must be a digit 1..9 */ - if ((p[3] < L'1') || (p[3] > L'9')) { + if ((p[3] < '1') || (p[3] > '9')) { return 0; } return 1; } Index: win/tclWinConsole.c ================================================================== --- win/tclWinConsole.c +++ win/tclWinConsole.c @@ -140,11 +140,11 @@ static int ConsoleBlockModeProc(ClientData instanceData, int mode); static void ConsoleCheckProc(ClientData clientData, int flags); static int ConsoleCloseProc(ClientData instanceData, - Tcl_Interp *interp); + Tcl_Interp *interp, int flags); static int ConsoleEventProc(Tcl_Event *evPtr, int flags); static void ConsoleExitHandler(ClientData clientData); static int ConsoleGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static int ConsoleGetOptionProc(ClientData instanceData, @@ -178,19 +178,19 @@ */ static const Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - ConsoleCloseProc, /* Close proc. */ + TCL_CLOSE2PROC, /* Close proc. */ ConsoleInputProc, /* Input proc. */ ConsoleOutputProc, /* Output proc. */ NULL, /* Seek proc. */ ConsoleSetOptionProc, /* Set option proc. */ ConsoleGetOptionProc, /* Get option proc. */ ConsoleWatchProc, /* Set up notifier to watch the channel. */ ConsoleGetHandleProc, /* Get an OS handle from channel. */ - NULL, /* close2proc. */ + ConsoleCloseProc, /* close2proc. */ ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ NULL, /* Flush proc. */ NULL, /* Handler proc. */ NULL, /* Wide seek proc. */ ConsoleThreadActionProc, /* Thread action proc. */ @@ -200,12 +200,12 @@ /* *---------------------------------------------------------------------- * * ReadConsoleBytes, WriteConsoleBytes -- * - * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes - * instead of number of TCHARS. + * Wrapper for ReadConsoleW, that takes and returns number of bytes + * instead of number of WCHARS. * *---------------------------------------------------------------------- */ static BOOL @@ -215,11 +215,10 @@ DWORD nbytes, LPDWORD nbytesread) { DWORD ntchars; BOOL result; - int tcharsize = sizeof(TCHAR); /* * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return * success with ntchars == 0 and GetLastError() will be * ERROR_OPERATION_ABORTED. We do not want to treat this case @@ -228,15 +227,15 @@ * thread will terminate the program. If a Ctrl signal handler * has been established (through an extension for example), it * will run and take whatever action it deems appropriate. */ do { - result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + result = ReadConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); if (nbytesread != NULL) { - *nbytesread = ntchars * tcharsize; + *nbytesread = ntchars * sizeof(WCHAR); } return result; } static BOOL @@ -246,16 +245,15 @@ DWORD nbytes, LPDWORD nbyteswritten) { DWORD ntchars; BOOL result; - int tcharsize = sizeof(TCHAR); - result = WriteConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + result = WriteConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars, NULL); if (nbyteswritten != NULL) { - *nbyteswritten = ntchars * tcharsize; + *nbyteswritten = ntchars * sizeof(WCHAR); } return result; } /* @@ -317,11 +315,11 @@ *---------------------------------------------------------------------- */ static void ConsoleExitHandler( - ClientData clientData) /* Old window proc. */ + TCL_UNUSED(ClientData)) { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } /* @@ -341,11 +339,11 @@ *---------------------------------------------------------------------- */ static void ProcExitHandler( - ClientData clientData) /* Old window proc. */ + TCL_UNUSED(ClientData)) { Tcl_MutexLock(&consoleMutex); initialized = 0; Tcl_MutexUnlock(&consoleMutex); } @@ -367,11 +365,11 @@ *---------------------------------------------------------------------- */ void ConsoleSetupProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; @@ -421,11 +419,11 @@ *---------------------------------------------------------------------- */ static void ConsoleCheckProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleInfo *infoPtr; int needEvent; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -462,11 +460,11 @@ needEvent = 1; } } if (needEvent) { - ConsoleEvent *evPtr = Tcl_Alloc(sizeof(ConsoleEvent)); + ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); infoPtr->flags |= CONSOLE_PENDING; evPtr->header.proc = ConsoleEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -494,11 +492,11 @@ ConsoleBlockModeProc( ClientData instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; /* * Consoles on Windows can not be switched between blocking and * nonblocking, hence we have to emulate the behavior. This is done in the * input function by checking against a bit in the state. We set or unset @@ -531,16 +529,21 @@ */ static int ConsoleCloseProc( ClientData instanceData, /* Pointer to ConsoleInfo structure. */ - Tcl_Interp *interp) /* For error reporting. */ + TCL_UNUSED(Tcl_Interp *), + int flags) { - ConsoleInfo *consolePtr = instanceData; + ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData; int errorCode = 0; ConsoleInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } /* * Clean up the background thread if necessary. Note that this must be * done before we can close the file, since the thread may be blocking * trying to read from the console. @@ -617,14 +620,14 @@ *nextPtrPtr = infoPtr->nextPtr; break; } } if (consolePtr->writeBuf != NULL) { - Tcl_Free(consolePtr->writeBuf); + ckfree(consolePtr->writeBuf); consolePtr->writeBuf = 0; } - Tcl_Free(consolePtr); + ckfree(consolePtr); return errorCode; } /* @@ -651,11 +654,11 @@ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; DWORD count, bytesRead = 0; int result; *errorCode = 0; @@ -743,11 +746,11 @@ ClientData instanceData, /* Console state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; ConsoleThreadInfo *threadInfo = &infoPtr->writer; DWORD bytesWritten, timeout; *errorCode = 0; @@ -784,14 +787,14 @@ /* * Reallocate the buffer to be large enough to hold the data. */ if (infoPtr->writeBuf) { - Tcl_Free(infoPtr->writeBuf); + ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = Tcl_Alloc(toWrite); + infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(threadInfo->readyEvent); TclPipeThreadSignal(&threadInfo->TI); @@ -928,11 +931,11 @@ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { ConsoleInfo **nextPtrPtr, *ptr; - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int oldMask = infoPtr->watchMask; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Since most of the work is handled by the background threads, we just @@ -983,14 +986,14 @@ */ static int ConsoleGetHandleProc( ClientData instanceData, /* The console state. */ - int direction, /* TCL_READABLE or TCL_WRITABLE. */ + TCL_UNUSED(int) /*direction*/, ClientData *handlePtr) /* Where to store the handle. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; *handlePtr = infoPtr->handle; return TCL_OK; } @@ -1020,11 +1023,11 @@ ConsoleInfo *infoPtr, /* Console state. */ int blocking) /* Indicates whether call should be blocking * or not. */ { DWORD timeout, count; - HANDLE *handle = infoPtr->handle; + HANDLE *handle = (HANDLE *)infoPtr->handle; ConsoleThreadInfo *threadInfo = &infoPtr->reader; INPUT_RECORD input; while (1) { /* @@ -1055,11 +1058,11 @@ if (infoPtr->readFlags & CONSOLE_EOF) { return 1; } - if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) { + if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) { /* * Check to see if the peek failed because of EOF. */ TclWinConvertError(GetLastError()); @@ -1136,11 +1139,11 @@ /* exit */ break; } if (!infoPtr) { infoPtr = (ConsoleInfo *)pipeTI->clientData; - handle = infoPtr->handle; + handle = (HANDLE *)infoPtr->handle; threadInfo = &infoPtr->reader; } /* @@ -1234,11 +1237,11 @@ /* exit */ break; } if (!infoPtr) { infoPtr = (ConsoleInfo *)pipeTI->clientData; - handle = infoPtr->handle; + handle = (HANDLE *)infoPtr->handle; threadInfo = &infoPtr->writer; } buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; @@ -1321,11 +1324,11 @@ /* * See if a channel with this handle already exists. */ - infoPtr = Tcl_Alloc(sizeof(ConsoleInfo)); + infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; @@ -1357,20 +1360,20 @@ modes = infoPtr->initMode; modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); modes |= ENABLE_LINE_INPUT; SetConsoleMode(infoPtr->handle, modes); - infoPtr->reader.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->reader.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread, TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr, infoPtr->reader.readyEvent), 0, NULL); SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST); } if (permissions & TCL_WRITABLE) { - infoPtr->writer.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->writer.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread, TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr, infoPtr->writer.readyEvent), 0, NULL); SetThreadPriority(infoPtr->writer.thread, THREAD_PRIORITY_HIGHEST); } @@ -1380,11 +1383,11 @@ * that a ^Z will be accepted as EOF when reading. */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode"); + Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "utf-16"); return infoPtr->channel; } /* *---------------------------------------------------------------------- @@ -1405,11 +1408,11 @@ static void ConsoleThreadActionProc( ClientData instanceData, int action) { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; /* * We do not access firstConsolePtr in the thread structures. This is not * for all serials managed by the thread, but only those we are watching. * Removal of the filevent handlers before transfer thus takes care of @@ -1459,11 +1462,11 @@ ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int len = strlen(optionName); int vlen = strlen(value); /* * Option -inputmode normal|password|raw @@ -1557,11 +1560,11 @@ ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { - ConsoleInfo *infoPtr = instanceData; + ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData; int valid = 0; /* Flag if valid option parsed. */ unsigned int len; char buf[TCL_INTEGER_SPACE]; if (optionName == NULL) { Index: win/tclWinDde.c ================================================================== --- win/tclWinDde.c +++ win/tclWinDde.c @@ -32,11 +32,11 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - TCHAR *name; /* Interpreter's name (malloc-ed). */ + WCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; /* @@ -77,14 +77,14 @@ static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.4.1" +#define TCL_DDE_VERSION "1.4.3" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME TEXT("TclEval") -#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") +#define TCL_DDE_SERVICE_NAME L"TclEval" +#define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" #define DDE_FLAG_ASYNC 1 #define DDE_FLAG_BINARY 2 #define DDE_FLAG_FORCE 4 @@ -97,27 +97,37 @@ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); -static void DdeExitProc(ClientData clientData); +static void DdeExitProc(void *clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const TCHAR *serviceName, const TCHAR *topicName); + const WCHAR *serviceName, const WCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); -static void DeleteProc(ClientData clientData); +static void DeleteProc(void *clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const TCHAR *name, HCONV *ddeConvPtr); + const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); -static int DdeObjCmd(ClientData clientData, +static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); + +#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#endif static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, size_t *lengthPtr @@ -134,12 +144,18 @@ /* 32-bit or without TIP #494 */ *lengthPtr = (size_t) (unsigned) length; return result; } +#ifdef __cplusplus +extern "C" { +#endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); +#ifdef __cplusplus +} +#endif /* *---------------------------------------------------------------------- * * Dde_Init -- @@ -157,17 +173,17 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.1", 0)) { + if (!Tcl_InitStubs(interp, "8.5", 0)) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); + return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* *---------------------------------------------------------------------- * @@ -233,11 +249,11 @@ */ if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, + if (DdeInitializeW(&ddeInstance, (PFNCALLBACK)(void *)DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; } } @@ -246,11 +262,11 @@ if ((ddeServiceGlobal == 0) && (nameFound != 0)) { Tcl_MutexLock(&ddeMutex); if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, + ddeServiceGlobal = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; } @@ -281,24 +297,24 @@ * deleted or the "send" command is removed. * *---------------------------------------------------------------------- */ -static const TCHAR * +static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const TCHAR *name, /* The name that will be used to refer to the + const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const TCHAR *actualName; + const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* @@ -332,11 +348,11 @@ /* * The name was NULL, so the caller is asking for the name of the * current interp, but it doesn't have a name. */ - return TEXT(""); + return L""; } /* * Get the list of currently registered Tcl interpreters by calling the * internal implementation of the 'dde services' command. @@ -353,12 +369,12 @@ if (r == TCL_OK) { r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, &srvPtrPtr); } if (r != TCL_OK) { - Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); - OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringInit(&dString); + OutputDebugStringW(Tcl_UtfToWCharDString(Tcl_GetString(Tcl_GetObjResult(interp)), -1, &dString)); Tcl_DStringFree(&dString); return NULL; } /* @@ -372,18 +388,18 @@ while (suffix != lastSuffix) { lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); - Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)name, wcslen(name) * sizeof(WCHAR)); + Tcl_DStringAppend(&dString, (char *)L" #", 2 * sizeof(WCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); - actualName = (TCHAR *) Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(WCHAR) * TCL_INTEGER_SPACE); + actualName = (WCHAR *) Tcl_DStringValue(&dString); } - _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), - TCL_INTEGER_SPACE, TEXT("%d"), suffix); + _snwprintf((WCHAR *) (Tcl_DStringValue(&dString) + offset), + TCL_INTEGER_SPACE, L"%d", suffix); } /* * See if the name is already in use, if so increment suffix. */ @@ -391,12 +407,13 @@ for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); - if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { + Tcl_DStringInit(&ds); + Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds); + if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); break; } Tcl_DStringFree(&ds); @@ -408,18 +425,18 @@ * We have found a unique name. Now add it to the registry. */ riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); + riPtr->name = (WCHAR *) Tcl_Alloc((wcslen(actualName) + 1) * sizeof(WCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - _tcscpy(riPtr->name, actualName); + wcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } @@ -487,12 +504,11 @@ *---------------------------------------------------------------------- */ static void DeleteProc( - ClientData clientData) /* The interp we are deleting passed as - * ClientData. */ + void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -625,40 +641,42 @@ HCONV hConv, /* The conversation associated with the * current transaction. */ HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ - DWORD dwData1, DWORD dwData2) + DWORD unused1, DWORD unused2) /* Transaction-dependent data. */ { Tcl_DString dString; size_t len; DWORD dlen; - TCHAR *utilString; + WCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; Conversation *convPtr, *prevConvPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + (void)unused1; + (void)unused2; switch(uType) { case XTYP_CONNECT: /* * Dde is trying to initialize a conversation with us. Check and make * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(utilString, riPtr->name) == 0) { + if (_wcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } } @@ -670,19 +688,19 @@ * Dde has decided that we can connect, so it gives us a conversation * handle. We need to keep track of it so we know which execution * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); + len = DdeQueryStringW(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(riPtr->name, utilString) == 0) { + if (_wcsicmp(riPtr->name, utilString) == 0) { convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; convPtr->riPtr = riPtr; @@ -738,25 +756,26 @@ if (convPtr != NULL) { Tcl_DString dsBuf; char *returnString; - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); Tcl_DStringInit(&dsBuf); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); - if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = Tcl_GetString(convPtr->returnPackagePtr); len = convPtr->returnPackagePtr->length; if (uFmt != CF_TEXT) { - Tcl_WinUtfToTChar(returnString, len, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; + len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { @@ -763,21 +782,23 @@ ddeReturn = NULL; } else { Tcl_DString ds; Tcl_Obj *variableObjPtr; - Tcl_WinTCharToUtf(utilString, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); variableObjPtr = Tcl_GetVar2Ex( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { returnString = Tcl_GetString(variableObjPtr); len = variableObjPtr->length; if (uFmt != CF_TEXT) { - Tcl_WinUtfToTChar(returnString, len, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToWCharDString(returnString, len, &dsBuf); returnString = Tcl_DStringValue(&dsBuf); - len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; + len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { @@ -815,21 +836,23 @@ Tcl_Obj *variableObjPtr; DWORD len2; Tcl_DStringInit(&dString); Tcl_DStringInit(&ds2); - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); - Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); - utilString = (TCHAR *) Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + len = DdeQueryStringW(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1); + utilString = (WCHAR *) Tcl_DStringValue(&dString); + DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINUNICODE); - Tcl_WinTCharToUtf(utilString, -1, &ds); - utilString = (TCHAR *) DdeAccessData(hData, &len2); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds); + utilString = (WCHAR *) DdeAccessData(hData, &len2); len = len2; if (uFmt != CF_TEXT) { - Tcl_WinTCharToUtf(utilString, -1, &ds2); - utilString = (TCHAR *) Tcl_DStringValue(&ds2); + Tcl_DStringInit(&ds2); + Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2); + utilString = (WCHAR *) Tcl_DStringValue(&ds2); } variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, variableObjPtr, TCL_GLOBAL_ONLY); @@ -860,11 +883,11 @@ if (convPtr == NULL) { return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (TCHAR *) DdeAccessData(hData, &dlen); + utilString = (WCHAR *) DdeAccessData(hData, &dlen); string = (char *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { @@ -875,11 +898,12 @@ ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { /* unicode */ Tcl_DString dsBuf; - Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &dsBuf); ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } Tcl_IncrRefCount(ddeObjectPtr); @@ -930,13 +954,13 @@ (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); len = dlen; for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { - returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, + returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); - returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + returnPtr[i].hszTopic = DdeCreateStringHandleW(ddeInstance, riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; DdeUnaccessData(ddeReturn); @@ -964,12 +988,13 @@ *---------------------------------------------------------------------- */ static void DdeExitProc( - ClientData clientData) /* Not used in this handler. */ + void *dummy) /* Not used. */ { + (void)dummy; DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); ddeInstance = 0; } @@ -991,28 +1016,29 @@ */ static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const TCHAR *name, /* The connection to use. */ + const WCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); + ddeService = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandleW(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); if (ddeConv == (HCONV) NULL) { if (interp != NULL) { Tcl_DString dString; - Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_DStringInit(&dString); + Tcl_WCharToUtfDString(name, wcslen(name), &dString); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } @@ -1045,13 +1071,13 @@ static int DdeCreateClient( DdeEnumServices *es) { - WNDCLASSEX wc; - static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); - static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); + WNDCLASSEXW wc; + static const WCHAR *szDdeClientClassName = L"TclEval client class"; + static const WCHAR *szDdeClientWindowName = L"TclEval client window"; memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; @@ -1059,12 +1085,12 @@ /* * Register and create the callback window. */ - RegisterClassEx(&wc); - es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, + RegisterClassExW(&wc); + es->hwnd = CreateWindowExW(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } static LRESULT CALLBACK @@ -1079,20 +1105,20 @@ LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; DdeEnumServices *es = (DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); + SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLong(hwnd, GWL_USERDATA, (LONG) es); + SetWindowLongW(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); default: - return DefWindowProc(hwnd, uMsg, wParam, lParam); + return DefWindowProcW(hwnd, uMsg, wParam, lParam); } } static LRESULT DdeServicesOnAck( @@ -1102,30 +1128,32 @@ { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); DdeEnumServices *es; - TCHAR sz[255]; + WCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 - es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (DdeEnumServices *) GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else - es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); + es = (DdeEnumServices *) GetWindowLongW(hwnd, GWL_USERDATA); #endif if (((es->service == (ATOM)0) || (es->service == service)) && ((es->topic == (ATOM)0) || (es->topic == topic))) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); - GlobalGetAtomName(service, sz, 255); - Tcl_WinTCharToUtf(sz, -1, &dString); + GlobalGetAtomNameW(service, sz, 255); + Tcl_DStringInit(&dString); + Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); - GlobalGetAtomName(topic, sz, 255); - Tcl_WinTCharToUtf(sz, -1, &dString); + GlobalGetAtomNameW(topic, sz, 255); + Tcl_DStringInit(&dString); + Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique @@ -1149,11 +1177,11 @@ /* * Tell the server we are no longer interested. */ - PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); + PostMessageW(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } static BOOL CALLBACK DdeEnumWindowsCallback( @@ -1161,29 +1189,29 @@ LPARAM lParam) { DWORD_PTR dwResult = 0; DdeEnumServices *es = (DdeEnumServices *) lParam; - SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + SendMessageTimeoutW(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; } static int DdeGetServicesList( Tcl_Interp *interp, - const TCHAR *serviceName, - const TCHAR *topicName) + const WCHAR *serviceName, + const WCHAR *topicName) { DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)0 : GlobalAddAtom(serviceName); - es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); + ? (ATOM)0 : GlobalAddAtomW(serviceName); + es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomW(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); @@ -1263,11 +1291,11 @@ *---------------------------------------------------------------------- */ static int DdeObjCmd( - ClientData clientData, /* Used only for deletion */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { @@ -1300,15 +1328,16 @@ size_t length; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const TCHAR *serviceName = NULL, *topicName = NULL; + const WCHAR *serviceName = NULL, *topicName = NULL; const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; Tcl_DString serviceBuf, topicBuf, itemBuf; + (void)dummy; /* * Initialize DDE server/client */ @@ -1460,34 +1489,36 @@ if (firstArg != 1) { const char *src = Tcl_GetString(objv[firstArg]); length = objv[firstArg]->length; - Tcl_WinUtfToTChar(src, length, &serviceBuf); - serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf); - length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR); + Tcl_DStringInit(&serviceBuf); + Tcl_UtfToWCharDString(src, length, &serviceBuf); + serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); + length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR); } else { length = 0; } if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + ddeService = DdeCreateStringHandleW(ddeInstance, serviceName, CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { const char *src = Tcl_GetString(objv[firstArg + 1]); length = objv[firstArg + 1]->length; - topicName = Tcl_WinUtfToTChar(src, length, &topicBuf); - length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR); + Tcl_DStringInit(&topicBuf); + topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); + length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName, CP_WINUNICODE); } } switch ((enum DdeSubcommands) index) { @@ -1495,11 +1526,12 @@ serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { Tcl_DString dsBuf; - Tcl_WinTCharToUtf(serviceName, -1, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(serviceName, wcslen(serviceName), &dsBuf); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf))); Tcl_DStringFree(&dsBuf); } else { Tcl_ResetResult(interp); @@ -1518,13 +1550,14 @@ } else { const char *src; src = Tcl_GetString(objv[firstArg + 2]); dataLength = objv[firstArg + 2]->length; - dataString = (const TCHAR *) - Tcl_WinUtfToTChar(src, dataLength, &dsBuf); - dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + Tcl_DStringInit(&dsBuf); + dataString = + Tcl_UtfToWCharDString(src, dataLength, &dsBuf); + dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } if (dataLength + 1 < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); @@ -1566,17 +1599,18 @@ } Tcl_DStringFree(&dsBuf); break; } case DDE_REQUEST: { - const TCHAR *itemString; + const WCHAR *itemString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; - itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); + Tcl_DStringInit(&itemBuf); + itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); @@ -1590,33 +1624,34 @@ if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp); + WCHAR *dataString = (WCHAR *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString, tmp); } else { Tcl_DString dsBuf; - if ((tmp >= sizeof(TCHAR)) - && !dataString[tmp / sizeof(TCHAR) - 1]) { - tmp -= sizeof(TCHAR); + if ((tmp >= sizeof(WCHAR)) + && !dataString[tmp / sizeof(WCHAR) - 1]) { + tmp -= sizeof(WCHAR); } - Tcl_WinTCharToUtf(dataString, tmp, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); returnObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); } @@ -1631,18 +1666,19 @@ } break; } case DDE_POKE: { Tcl_DString dsBuf; - const TCHAR *itemString; + const WCHAR *itemString; BYTE *dataString; const char *src; src = Tcl_GetString(objv[firstArg + 2]); length = objv[firstArg + 2]->length; - itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); - length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); + Tcl_DStringInit(&itemBuf); + itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; @@ -1654,13 +1690,14 @@ getByteArrayFromObj(objv[firstArg + 3], &length); } else { const char *data = Tcl_GetString(objv[firstArg + 3]); length = objv[firstArg + 3]->length; + Tcl_DStringInit(&dsBuf); dataString = (BYTE *) - Tcl_WinUtfToTChar(data, length, &dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + Tcl_UtfToWCharDString(data, length, &dsBuf); + length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); @@ -1667,11 +1704,11 @@ if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + ddeItem = DdeCreateStringHandleW(ddeInstance, itemString, CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(dataString, (DWORD) length, hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { @@ -1715,11 +1752,11 @@ * bytecode structure would be referring to deallocated objects. */ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (_tcsicmp(serviceName, riPtr->name) == 0) { + if (_wcsicmp(serviceName, riPtr->name) == 0) { break; } } if (riPtr != NULL) { @@ -1818,13 +1855,14 @@ } objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetString(objPtr); length = objPtr->length; - Tcl_WinUtfToTChar(string, length, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_UtfToWCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); - length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR); ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, (DWORD) length, 0, 0, CF_UNICODETEXT, 0); Tcl_DStringFree(&dsBuf); if (flags & DDE_FLAG_ASYNC) { @@ -1835,11 +1873,11 @@ } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { - ddeCookie = DdeCreateStringHandle(ddeInstance, + ddeCookie = DdeCreateStringHandleW(ddeInstance, TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); } } @@ -1852,11 +1890,11 @@ goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; - TCHAR *ddeDataString; + WCHAR *ddeDataString; /* * The return handle has a two or four element list in it. The * first element is the return code (TCL_OK, TCL_ERROR, etc.). * The second is the result of the script. If the return code @@ -1864,16 +1902,17 @@ * variable "errorCode", and the fourth is the value of the * variable "errorInfo". */ length = DdeGetData(ddeData, NULL, 0, 0); - ddeDataString = (TCHAR *) Tcl_Alloc(length); + ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > sizeof(TCHAR)) { - length -= sizeof(TCHAR); + if (length > sizeof(WCHAR)) { + length -= sizeof(WCHAR); } - Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf); + Tcl_DStringInit(&dsBuf); + Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf); resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), Tcl_DStringLength(&dsBuf)); Tcl_DStringFree(&dsBuf); Tcl_Free((char *) ddeDataString); Index: win/tclWinError.c ================================================================== --- win/tclWinError.c +++ win/tclWinError.c @@ -379,11 +379,11 @@ * None. * *---------------------------------------------------------------------- */ -void +TCL_NORETURN void tclWinDebugPanic( const char *format, ...) { #define TCL_MAX_WARN_LEN 1024 va_list argList; @@ -392,18 +392,18 @@ if (IsDebuggerPresent()) { WCHAR msgString[TCL_MAX_WARN_LEN]; char buf[TCL_MAX_WARN_LEN * 3]; vsnprintf(buf, sizeof(buf), format, argList); - msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the buffer. */ - if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } OutputDebugStringW(msgString); } else { if (!isatty(fileno(stderr))) { @@ -411,10 +411,16 @@ } vfprintf(stderr, format, argList); fprintf(stderr, "\n"); fflush(stderr); } +# if defined(__GNUC__) + __builtin_trap(); +# else + DebugBreak(); +# endif + abort(); } #endif /* * Local Variables: * mode: c Index: win/tclWinFCmd.c ================================================================== --- win/tclWinFCmd.c +++ win/tclWinFCmd.c @@ -143,12 +143,12 @@ int TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr), + (const WCHAR *)Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( const WCHAR *nativeSrc, /* Pathname of file or dir to be renamed @@ -202,26 +202,26 @@ "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" /* - * Call MoveFile(nativeSrc, nativeDst) + * Call MoveFileW(nativeSrc, nativeDst) */ "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" - "movl %[moveFile], %%eax" "\n\t" + "movl %[moveFileW], %%eax" "\n\t" "call *%%eax" "\n\t" /* * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from MoveFile into it. @@ -243,11 +243,11 @@ * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : @@ -254,11 +254,11 @@ /* No outputs */ : [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [moveFile] "r" (MoveFile) + [moveFileW] "r" (MoveFileW) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; @@ -265,11 +265,11 @@ } #else #ifndef HAVE_NO_SEH __try { #endif - if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) { + if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif @@ -279,22 +279,22 @@ return retval; } TclWinConvertError(GetLastError()); - srcAttr = GetFileAttributes(nativeSrc); - dstAttr = GetFileAttributes(nativeDst); - if (srcAttr == 0xffffffff) { - if (GetFullPathName(nativeSrc, 0, NULL, + srcAttr = GetFileAttributesW(nativeSrc); + dstAttr = GetFileAttributesW(nativeDst); + if (srcAttr == 0xFFFFFFFF) { + if (GetFullPathNameW(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } srcAttr = 0; } - if (dstAttr == 0xffffffff) { - if (GetFullPathName(nativeDst, 0, NULL, + if (dstAttr == 0xFFFFFFFF) { + if (GetFullPathNameW(nativeDst, 0, NULL, NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } dstAttr = 0; @@ -313,25 +313,27 @@ WCHAR nativeSrcPath[MAX_PATH]; WCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; const char *src, *dst; - size = GetFullPathName(nativeSrc, MAX_PATH, + size = GetFullPathNameW(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = GetFullPathName(nativeDst, MAX_PATH, + size = GetFullPathNameW(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - CharLower(nativeSrcPath); - CharLower(nativeDstPath); + CharLowerW(nativeSrcPath); + CharLowerW(nativeDstPath); - src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString); - dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString); + Tcl_DStringInit(&srcString); + Tcl_DStringInit(&dstString); + src = Tcl_WCharToUtfDString(nativeSrcPath, -1, &srcString); + dst = Tcl_WCharToUtfDString(nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the * source path. This is true if the prefix matches, and the next * character is either end-of-string or a directory separator @@ -374,12 +376,12 @@ */ Tcl_SetErrno(EXDEV); } - Tcl_Free((void *)srcArgv); - Tcl_Free((void *)dstArgv); + ckfree(srcArgv); + ckfree(dstArgv); } /* * Other types of access failure is that dst is a read-only * filesystem, that an open file referred to src or dest, or that src @@ -406,11 +408,11 @@ * Now that that empty directory is gone, we can try * renaming again. If that fails, we'll put this empty * directory back, for completeness. */ - if (MoveFile(nativeSrc, + if (MoveFileW(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } /* @@ -417,12 +419,12 @@ * Some new error has occurred. Don't know what it could * be, but report this one. */ TclWinConvertError(GetLastError()); - CreateDirectory(nativeDst, NULL); - SetFileAttributes(nativeDst, dstAttr); + CreateDirectoryW(nativeDst, NULL); + SetFileAttributesW(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. */ @@ -447,39 +449,39 @@ WCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; WCHAR tempBuf[MAX_PATH]; - size = GetFullPathName(nativeDst, MAX_PATH, + size = GetFullPathNameW(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (WCHAR *) tempBuf; - nativeRest[0] = L'\0'; + nativeRest[0] = '\0'; result = TCL_ERROR; - nativePrefix = (WCHAR *) L"tclr"; - if (GetTempFileName(nativeTmp, nativePrefix, + nativePrefix = (WCHAR *)L"tclr"; + if (GetTempFileNameW(nativeTmp, nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFile to be joined as an atomic operation so no * other app comes along in the meantime and creates the * same temp file. */ nativeTmp = tempBuf; - DeleteFile(nativeTmp); - if (MoveFile(nativeDst, nativeTmp) != FALSE) { - if (MoveFile(nativeSrc, nativeDst) != FALSE) { - SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL); - DeleteFile(nativeTmp); + DeleteFileW(nativeTmp); + if (MoveFileW(nativeDst, nativeTmp) != FALSE) { + if (MoveFileW(nativeSrc, nativeDst) != FALSE) { + SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL); + DeleteFileW(nativeTmp); return TCL_OK; } else { - DeleteFile(nativeDst); - MoveFile(nativeTmp, nativeDst); + DeleteFileW(nativeDst); + MoveFileW(nativeTmp, nativeDst); } } /* * Can't backup dst file or move src file. Return that @@ -532,12 +534,12 @@ int TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoCopyFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr), + (const WCHAR *)Tcl_FSGetNativePath(destPathPtr)); } static int DoCopyFile( const WCHAR *nativeSrc, /* Pathname of file to be copied (native). */ @@ -589,24 +591,24 @@ "movl %%fs:0, %%eax" "\n\t" "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ "leal 1f, %%eax" "\n\t" "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ - "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */ "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" /* - * Call CopyFile(nativeSrc, nativeDst, 0) + * Call CopyFileW(nativeSrc, nativeDst, 0) */ - "movl %[copyFile], %%eax" "\n\t" + "movl %[copyFileW], %%eax" "\n\t" "pushl $0" "\n\t" "pushl %%ebx" "\n\t" "pushl %%ecx" "\n\t" "call *%%eax" "\n\t" @@ -631,11 +633,11 @@ * Come here however we exited. Restore context from the * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" - "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0xC(%%edx), %%esp" "\n\t" "movl 0x8(%%edx), %%ebp" "\n\t" "movl 0x0(%%edx), %%eax" "\n\t" "movl %%eax, %%fs:0" "\n\t" : @@ -642,11 +644,11 @@ /* No outputs */ : [registration] "m" (registration), [nativeDst] "m" (nativeDst), [nativeSrc] "m" (nativeSrc), - [copyFile] "r" (CopyFile) + [copyFileW] "r" (CopyFileW) : "%eax", "%ebx", "%ecx", "%edx", "memory" ); if (registration.status != FALSE) { retval = TCL_OK; @@ -653,11 +655,11 @@ } #else #ifndef HAVE_NO_SEH __try { #endif - if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) { + if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } #ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif @@ -673,14 +675,14 @@ return TCL_ERROR; } if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = GetFileAttributes(nativeSrc); - dstAttr = GetFileAttributes(nativeDst); - if (srcAttr != 0xffffffff) { - if (dstAttr == 0xffffffff) { + srcAttr = GetFileAttributesW(nativeSrc); + dstAttr = GetFileAttributesW(nativeDst); + if (srcAttr != 0xFFFFFFFF) { + if (dstAttr == 0xFFFFFFFF) { dstAttr = 0; } if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) { @@ -690,13 +692,13 @@ } } Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - SetFileAttributes(nativeDst, + SetFileAttributesW(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFile(nativeSrc, nativeDst, + if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } /* @@ -703,11 +705,11 @@ * Still can't copy onto dst. Return that error, and restore * attributes of dst. */ TclWinConvertError(GetLastError()); - SetFileAttributes(nativeDst, dstAttr); + SetFileAttributesW(nativeDst, dstAttr); } } } return TCL_ERROR; } @@ -747,11 +749,11 @@ int TclpDeleteFile( const void *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; - const WCHAR *path = nativePath; + const WCHAR *path = (const WCHAR *)nativePath; /* * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and * "". Avoid passing these values. */ @@ -759,18 +761,18 @@ if (path == NULL || path[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } - if (DeleteFile(path) != FALSE) { + if (DeleteFileW(path) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributes(path); - if (attr != 0xffffffff) { + attr = GetFileAttributesW(path); + if (attr != 0xFFFFFFFF) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ @@ -786,26 +788,26 @@ * of EISDIR. */ Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = SetFileAttributes(path, + int res = SetFileAttributesW(path, attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); if ((res != 0) && - (DeleteFile(path) != FALSE)) { + (DeleteFileW(path) != FALSE)) { return TCL_OK; } TclWinConvertError(GetLastError()); if (res != 0) { - SetFileAttributes(path, attr); + SetFileAttributesW(path, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { - attr = GetFileAttributes(path); - if (attr != 0xffffffff) { + attr = GetFileAttributesW(path); + if (attr != 0xFFFFFFFF) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Windows 95 reports removing a directory as ENOENT instead * of EISDIR. */ @@ -852,18 +854,18 @@ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); + return DoCreateDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( const WCHAR *nativePath) /* Pathname of directory to create (native). */ { - if (CreateDirectory(nativePath, NULL) == 0) { + if (CreateDirectoryW(nativePath, NULL) == 0) { DWORD error = GetLastError(); TclWinConvertError(error); return TCL_ERROR; } @@ -909,12 +911,14 @@ normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } - Tcl_WinUtfToTChar(TclGetString(normSrcPtr), -1, &srcString); - Tcl_WinUtfToTChar(TclGetString(normDestPtr), -1, &dstString); + Tcl_DStringInit(&srcString); + Tcl_DStringInit(&dstString); + Tcl_UtfToWCharDString(Tcl_GetString(normSrcPtr), -1, &srcString); + Tcl_UtfToWCharDString(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); @@ -982,15 +986,16 @@ Tcl_DString native; normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPtr == NULL) { return TCL_ERROR; } - Tcl_WinUtfToTChar(TclGetString(normPtr), -1, &native); + Tcl_DStringInit(&native); + Tcl_UtfToWCharDString(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { - ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); + ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds); } if (ret != TCL_OK) { if (Tcl_DStringLength(&ds) > 0) { if (normPtr != NULL && @@ -1028,11 +1033,11 @@ Tcl_SetErrno(ENOENT); Tcl_DStringInit(errorPtr); return TCL_ERROR; } - attr = GetFileAttributes(nativePath); + attr = GetFileAttributesW(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * It is a symbolic link - remove it. */ @@ -1042,20 +1047,20 @@ } else { /* * Ordinary directory. */ - if (RemoveDirectory(nativePath) != FALSE) { + if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = GetFileAttributes(nativePath); - if (attr != 0xffffffff) { + attr = GetFileAttributesW(nativePath); + if (attr != 0xFFFFFFFF) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Windows 95 reports calling RemoveDirectory on a file as an * EACCES, not an ENOTDIR. */ @@ -1074,19 +1079,19 @@ } } if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributes(nativePath, + if (SetFileAttributesW(nativePath, attr) == FALSE) { goto end; } - if (RemoveDirectory(nativePath) != FALSE) { + if (RemoveDirectoryW(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - SetFileAttributes(nativePath, + SetFileAttributesW(nativePath, attr | FILE_ATTRIBUTE_READONLY); } } } @@ -1107,11 +1112,14 @@ return TCL_ERROR; } end: if (errorPtr != NULL) { - char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + char *p; + + Tcl_DStringInit(errorPtr); + p = Tcl_WCharToUtfDString(nativePath, -1, errorPtr); for (; *p; ++p) { if (*p == '\\') *p = '/'; } } return TCL_ERROR; @@ -1181,23 +1189,23 @@ { DWORD sourceAttr; WCHAR *nativeSource, *nativeTarget, *nativeErrfile; int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAW data; nativeErrfile = NULL; result = TCL_OK; - oldTargetLen = 0; /* lint. */ + oldTargetLen = 0; nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); nativeTarget = (WCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = GetFileAttributes(nativeSource); - if (sourceAttr == 0xffffffff) { + sourceAttr = GetFileAttributesW(nativeSource); + if (sourceAttr == 0xFFFFFFFF) { nativeErrfile = nativeSource; goto end; } if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) { @@ -1219,11 +1227,11 @@ Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr); - handle = FindFirstFile(nativeSource, &data); + handle = FindFirstFileW(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory. */ @@ -1252,11 +1260,11 @@ Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); Tcl_DStringSetLength(targetPtr, targetLen); } found = 1; - for (; found; found = FindNextFile(handle, &data)) { + for (; found; found = FindNextFileW(handle, &data)) { WCHAR *nativeName; int len; WCHAR *wp = data.cFileName; if (*wp == '.') { @@ -1321,11 +1329,12 @@ end: if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); + Tcl_DStringInit(errorPtr); + Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } return result; @@ -1367,13 +1376,13 @@ return TCL_OK; } break; case DOTREE_PRED: if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = GetFileAttributes(nativeSrc); + DWORD attr = GetFileAttributesW(nativeSrc); - if (SetFileAttributes(nativeDst, + if (SetFileAttributesW(nativeDst, attr) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); } @@ -1386,11 +1395,12 @@ * There shouldn't be a problem with src, because we already checked it to * get here. */ if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); + Tcl_DStringInit(errorPtr); + Tcl_WCharToUtfDString(nativeDst, -1, errorPtr); } return TCL_ERROR; } /* @@ -1415,11 +1425,11 @@ */ static int TraversalDelete( const WCHAR *nativeSrc, /* Source pathname to delete. */ - const WCHAR *dstPtr, /* Not used. */ + TCL_UNUSED(const WCHAR *) /*dstPtr*/, int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ { switch (type) { @@ -1441,11 +1451,12 @@ } break; } if (errorPtr != NULL) { - Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); + Tcl_DStringInit(errorPtr); + Tcl_WCharToUtfDString(nativeSrc, -1, errorPtr); } return TCL_ERROR; } /* @@ -1504,14 +1515,14 @@ { DWORD result; const WCHAR *nativeName; int attr; - nativeName = Tcl_FSGetNativePath(fileName); - result = GetFileAttributes(nativeName); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName); + result = GetFileAttributesW(nativeName); - if (result == 0xffffffff) { + if (result == 0xFFFFFFFF) { StatError(interp, fileName); return TCL_ERROR; } attr = (int)(result & attributeArray[objIndex]); @@ -1522,11 +1533,11 @@ * they are not (and cannot be). * * We test for, and fix that case, here. */ - size_t len; + int len; const char *str = TclGetStringFromObj(fileName, &len); if (len < 4) { if (len == 0) { /* @@ -1577,26 +1588,25 @@ */ static int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ + TCL_UNUSED(int) /*objIndex*/, Tcl_Obj *fileName, /* The name of the file. */ int longShort, /* 0 to short name, 1 to long name. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { int pathc, i; Tcl_Obj *splitPath; - size_t length; splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", - TclGetString(fileName))); + Tcl_GetString(fileName))); errno = ENOENT; Tcl_PosixError(interp); } goto cleanup; } @@ -1609,10 +1619,11 @@ Tcl_IncrRefCount(splitPath); for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; + int length; Tcl_ListObjIndex(NULL, splitPath, i, &elt); pathv = TclGetStringFromObj(elt, &length); if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':')) @@ -1636,11 +1647,11 @@ Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; const WCHAR *nativeName; const char *tempString; - WIN32_FIND_DATA data; + WIN32_FIND_DATAW data; HANDLE handle; DWORD attr; tempPath = Tcl_FSJoinPath(splitPath, i+1); Tcl_IncrRefCount(tempPath); @@ -1649,22 +1660,23 @@ * We'd like to call Tcl_FSGetNativePath(tempPath) but that is * likely to lead to infinite loops. */ tempString = TclGetStringFromObj(tempPath, &length); - nativeName = Tcl_WinUtfToTChar(tempString, length, &ds); + Tcl_DStringInit(&ds); + nativeName = Tcl_UtfToWCharDString(tempString, length, &ds); Tcl_DecrRefCount(tempPath); - handle = FindFirstFile(nativeName, &data); + handle = FindFirstFileW(nativeName, &data); if (handle == INVALID_HANDLE_VALUE) { /* - * FindFirstFile() doesn't like root directories. We would + * FindFirstFileW() doesn't like root directories. We would * only get a root directory here if the caller specified "c:" * or "c:." and the current directory on the drive was the * root directory */ - attr = GetFileAttributes(nativeName); + attr = GetFileAttributesW(nativeName); if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; } } @@ -1686,11 +1698,11 @@ nativeName = (WCHAR *) data.cFileName; } } /* - * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying + * Purify reports a extraneous UMR in Tcl_WCharToUtfDString() trying * to dereference nativeName as a Unicode string. I have proven to * myself that purify is wrong by running the following example * when nativeName == data.w.cAlternateFileName and noting that * purify doesn't complain about the first line, but does complain * about the second. @@ -1698,11 +1710,11 @@ * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); */ Tcl_DStringInit(&dsTemp); - Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); + Tcl_WCharToUtfDString(nativeName, -1, &dsTemp); Tcl_DStringFree(&ds); /* * Deal with issues of tildes being absolute. */ @@ -1829,14 +1841,14 @@ { DWORD fileAttributes, old; int yesNo, result; const WCHAR *nativeName; - nativeName = Tcl_FSGetNativePath(fileName); - fileAttributes = old = GetFileAttributes(nativeName); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName); + fileAttributes = old = GetFileAttributesW(nativeName); - if (fileAttributes == 0xffffffff) { + if (fileAttributes == 0xFFFFFFFF) { StatError(interp, fileName); return TCL_ERROR; } result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo); @@ -1849,11 +1861,11 @@ } else { fileAttributes &= ~(attributeArray[objIndex]); } if ((fileAttributes != old) - && !SetFileAttributes(nativeName, fileAttributes)) { + && !SetFileAttributesW(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } return result; @@ -1878,15 +1890,15 @@ static int CannotSetAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ - Tcl_Obj *attributePtr) /* The new value of the attribute. */ + TCL_UNUSED(Tcl_Obj *) /*attributePtr*/) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", - tclpFileAttrStrings[objIndex], TclGetString(fileName))); + tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; } @@ -1922,14 +1934,14 @@ * GetLogicalDrives() returns incorrect information. */ if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { /* - * GetVolumeInformation() will detects all drives, but causes + * GetVolumeInformationW() will detects all drives, but causes * chattering on empty floppy drives. We only do this if * GetLogicalDriveStrings() didn't work. It has also been reported - * that on some laptops it takes a while for GetVolumeInformation() to + * that on some laptops it takes a while for GetVolumeInformationW() to * return when pinging an empty floppy drive, another reason to try to * avoid calling it. */ buf[1] = ':'; @@ -1993,13 +2005,14 @@ if (dirObj) { Tcl_GetString(dirObj); if (dirObj->length < 1) { goto useSystemTemp; } - Tcl_WinUtfToTChar(Tcl_GetString(dirObj), -1, &base); + Tcl_DStringInit(&base); + Tcl_UtfToWCharDString(Tcl_GetString(dirObj), -1, &base); if (dirObj->bytes[dirObj->length - 1] != '\\') { - TclUtfToWCharDString("\\", -1, &base); + Tcl_UtfToWCharDString("\\", -1, &base); } } else { useSystemTemp: Tcl_DStringInit(&base); Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR)); @@ -2011,17 +2024,15 @@ #define DEFAULT_TEMP_DIR_PREFIX "tcl" #define SUFFIX_LENGTH 8 if (basenameObj) { - Tcl_WinUtfToTChar(Tcl_GetString(basenameObj), -1, &name); - TclDStringAppendDString(&base, &name); - Tcl_DStringFree(&name); + Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), -1, &base); } else { - TclUtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base); + Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base); } - TclUtfToWCharDString("_", -1, &base); + Tcl_UtfToWCharDString("_", -1, &base); /* * Now we keep on trying random suffixes until we get one that works * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a @@ -2044,11 +2055,11 @@ tempbuf[SUFFIX_LENGTH] = '\0'; for (i = 0 ; i < SUFFIX_LENGTH; i++) { tempbuf[i] = randChars[(int) (rand() % numRandChars)]; } Tcl_DStringSetLength(&base, baseLen); - TclUtfToWCharDString(tempbuf, -1, &base); + Tcl_UtfToWCharDString(tempbuf, -1, &base); } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL) && (error = GetLastError()) == ERROR_ALREADY_EXISTS); /* * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and @@ -2064,11 +2075,12 @@ /* * We actually made the directory, so we're done! Report what we made back * as a (clean) Tcl_Obj. */ - Tcl_WinTCharToUtf((LPCWSTR) Tcl_DStringValue(&base), -1, &name); + Tcl_DStringInit(&name); + Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), -1, &name); Tcl_DStringFree(&base); return TclDStringToObj(&name); } /* Index: win/tclWinFile.c ================================================================== --- win/tclWinFile.c +++ win/tclWinFile.c @@ -175,11 +175,11 @@ static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory); static int WinLink(const WCHAR *LinkSource, const WCHAR *LinkTarget, int linkAction); static int WinSymLinkDirectory(const WCHAR *LinkDirectory, const WCHAR *LinkTarget); -MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); +MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); /* *-------------------------------------------------------------------- * * WinLink -- @@ -201,11 +201,11 @@ /* * Get the full path referenced by the target. */ - if (!GetFullPathName(linkTargetPath, MAX_PATH, tempFileName, + if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. */ @@ -215,21 +215,21 @@ /* * Make sure source file doesn't exist. */ - attr = GetFileAttributes(linkSourcePath); + attr = GetFileAttributesW(linkSourcePath); if (attr != INVALID_FILE_ATTRIBUTES) { Tcl_SetErrno(EEXIST); return -1; } /* * Get the full path referenced by the source file/directory. */ - if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, + if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. */ @@ -239,11 +239,11 @@ /* * Check the target. */ - attr = GetFileAttributes(linkTargetPath); + attr = GetFileAttributesW(linkTargetPath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The target doesn't exist. */ @@ -252,11 +252,11 @@ /* * It is a file. */ if (linkAction & TCL_CREATE_HARD_LINK) { - if (CreateHardLink(linkSourcePath, linkTargetPath, NULL)) { + if (CreateHardLinkW(linkSourcePath, linkTargetPath, NULL)) { /* * Success! */ return 0; @@ -314,11 +314,11 @@ /* * Get the full path referenced by the target. */ - if (!GetFullPathName(linkSourcePath, MAX_PATH, tempFileName, + if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName, &tempFilePart)) { /* * Invalid file. */ @@ -328,11 +328,11 @@ /* * Make sure source file does exist. */ - attr = GetFileAttributes(linkSourcePath); + attr = GetFileAttributesW(linkSourcePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * The source doesn't exist. */ @@ -393,15 +393,15 @@ * forward slashes everything appears to work, but the resulting symlink * is useless! */ for (loop = nativeTarget; *loop != 0; loop++) { - if (*loop == L'/') { - *loop = L'\\'; + if (*loop == '/') { + *loop = '\\'; } } - if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) { + if ((nativeTarget[len-1] == '\\') && (nativeTarget[len-2] != ':')) { nativeTarget[len-1] = 0; } /* * Build the reparse info. @@ -485,11 +485,11 @@ HANDLE hFile; DWORD returnedLength; memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - hFile = CreateFile(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, + hFile = CreateFileW(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) { @@ -500,11 +500,11 @@ TclWinConvertError(GetLastError()); CloseHandle(hFile); } else { CloseHandle(hFile); if (!linkOnly) { - RemoveDirectory(linkOrigPath); + RemoveDirectoryW(linkOrigPath); } return 0; } } return -1; @@ -545,11 +545,11 @@ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; Tcl_Obj *retVal; Tcl_DString ds; const char *copy; - attr = GetFileAttributes(linkDirPath); + attr = GetFileAttributesW(linkDirPath); if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) { return NULL; @@ -570,11 +570,11 @@ * which support reparse tags at present. If that changes in the * future, this code will have to be generalised. */ offset = 0; - if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { + if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == '\\') { /* * Check whether this is a mounted volume. */ if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, @@ -584,11 +584,11 @@ /* * There is some confusion between \??\ and \\?\ which we have * to fix here. It doesn't seem very well documented. */ - reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\'; + reparseBuffer->MountPointReparseBuffer.PathBuffer[1] = '\\'; /* * Check if a corresponding drive letter exists, and use that * if it is found */ @@ -632,14 +632,15 @@ offset = 4; } } - Tcl_WinTCharToUtf( + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString( reparseBuffer->MountPointReparseBuffer.PathBuffer, reparseBuffer->MountPointReparseBuffer - .SubstituteNameLength, &ds); + .SubstituteNameLength>>1, &ds); copy = Tcl_DStringValue(&ds)+offset; len = Tcl_DStringLength(&ds)-offset; retVal = Tcl_NewStringObj(copy,len); Tcl_IncrRefCount(retVal); @@ -678,11 +679,11 @@ DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; - hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, + hFile = CreateFileW(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* @@ -738,19 +739,19 @@ /* * Create the directory - it must not already exist. */ - if (CreateDirectory(linkDirPath, NULL) == 0) { + if (CreateDirectoryW(linkDirPath, NULL) == 0) { /* * Error creating directory. */ TclWinConvertError(GetLastError()); return -1; } - hFile = CreateFile(linkDirPath, GENERIC_WRITE, 0, NULL, + hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. @@ -771,11 +772,11 @@ * Error setting junction. */ TclWinConvertError(GetLastError()); CloseHandle(hFile); - RemoveDirectory(linkDirPath); + RemoveDirectoryW(linkDirPath); return -1; } CloseHandle(hFile); /* @@ -800,11 +801,11 @@ * None. * *---------------------------------------------------------------------- */ -void +TCL_NORETURN void tclWinDebugPanic( const char *format, ...) { #define TCL_MAX_WARN_LEN 1024 va_list argList; @@ -812,28 +813,38 @@ WCHAR msgString[TCL_MAX_WARN_LEN]; va_start(argList, format); vsnprintf(buf, sizeof(buf), format, argList); - msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the screen * and cause possible oversized window error. */ - if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } if (IsDebuggerPresent()) { OutputDebugStringW(msgString); } else { MessageBeep(MB_ICONEXCLAMATION); MessageBoxW(NULL, msgString, L"Fatal Error", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); } +#if defined(__GNUC__) + __builtin_trap(); +#elif defined(_WIN64) + __debugbreak(); +#elif defined(_MSC_VER) && defined (_M_IX86) + _asm {int 3} +#else + DebugBreak(); +#endif + abort(); } /* *--------------------------------------------------------------------------- * @@ -856,10 +867,20 @@ const char *argv0) /* If NULL, install PanicMessageBox, otherwise * ignore. */ { WCHAR wName[MAX_PATH]; char name[MAX_PATH * 3]; + + /* + * Under Windows we ignore argv0, and return the path for the file used to + * create this process. Only if it is NULL, install a new panic handler. + */ + + if (argv0 == NULL) { +# undef Tcl_SetPanicProc + Tcl_SetPanicProc(tclWinDebugPanic); + } GetModuleFileNameW(NULL, wName, MAX_PATH); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); @@ -910,35 +931,35 @@ if (norm != NULL) { /* * Match a single file directly. */ + int len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - size_t length = 0; - const char *str = TclGetStringFromObj(norm, &length); + const char *str = TclGetStringFromObj(norm, &len); - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); - if (GetFileAttributesEx(native, + if (GetFileAttributesExW(native, GetFileExInfoStandard, &data) != TRUE) { return TCL_OK; } attr = data.dwFileAttributes; - if (NativeMatchType(WinIsDrive(str, length), attr, native, types)) { + if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } return TCL_OK; } else { DWORD attr; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAW data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - size_t dirLength; + int dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ Tcl_DString dsOrig; /* UTF-8 encoding of dir. */ Tcl_Obj *fileNamePtr; @@ -956,15 +977,15 @@ /* * Verify that the specified path exists and is actually a directory. */ - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (native == NULL) { return TCL_OK; } - attr = GetFileAttributes(native); + attr = GetFileAttributesW(native); if ((attr == INVALID_FILE_ATTRIBUTES) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } @@ -1001,19 +1022,20 @@ dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } - native = Tcl_WinUtfToTChar(dirName, -1, &ds); + Tcl_DStringInit(&ds); + native = Tcl_UtfToWCharDString(dirName, -1, &ds); if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { - handle = FindFirstFile(native, &data); + handle = FindFirstFileW(native, &data); } else { /* * We can be more efficient, for pure directory requests. */ - handle = FindFirstFileEx(native, + handle = FindFirstFileExW(native, FindExInfoStandard, &data, FindExSearchLimitToDirectories, NULL, 0); } if (handle == INVALID_HANDLE_VALUE) { @@ -1074,11 +1096,12 @@ int checkDrive = 0, isDrive; DWORD attr; native = data.cFileName; attr = data.dwFileAttributes; - utfname = Tcl_WinTCharToUtf(native, -1, &ds); + Tcl_DStringInit(&ds); + utfname = Tcl_WCharToUtfDString(native, -1, &ds); if (!matchSpecialDots) { /* * If it is exactly '.' or '..' then we ignore it. */ @@ -1134,11 +1157,11 @@ /* * Free ds here to ensure that native is valid above. */ Tcl_DStringFree(&ds); - } while (FindNextFile(handle, &data) == TRUE); + } while (FindNextFileW(handle, &data) == TRUE); FindClose(handle); Tcl_DStringFree(&dsOrig); return TCL_OK; } @@ -1449,18 +1472,18 @@ } } Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); - wName = TclUtfToWCharDString(domain + 1, -1, &ds); + wName = Tcl_UtfToWCharDString(domain + 1, -1, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (rc == 0) { Tcl_DStringInit(&ds); - wName = TclUtfToWCharDString(name, nameLen, &ds); + wName = Tcl_UtfToWCharDString(name, nameLen, &ds); while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) { /* * User does not exist; if domain was not specified, try again * using current domain. */ @@ -1476,27 +1499,27 @@ rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain); if (rc != 0) { break; } - domain = INT2PTR(-1); /* repeat once */ + domain = (const char *)INT2PTR(-1); /* repeat once */ } if (rc == 0) { DWORD i, size = MAX_PATH; wHomeDir = uiPtr->usri1_home_dir; - if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { + if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) { size = lstrlenW(wHomeDir); - TclWCharToUtfDString(wHomeDir, size, bufferPtr); + Tcl_WCharToUtfDString(wHomeDir, size, bufferPtr); } else { /* * User exists but has no home dir. Return * "{GetProfilesDirectory}/". */ GetProfilesDirectoryW(buf, &size); - TclWCharToUtfDString(buf, size-1, bufferPtr); + Tcl_WCharToUtfDString(buf, size-1, bufferPtr); Tcl_DStringAppend(bufferPtr, "/", 1); Tcl_DStringAppend(bufferPtr, name, nameLen); } result = Tcl_DStringValue(bufferPtr); @@ -1568,11 +1591,11 @@ const WCHAR *nativePath, /* Path of file to access, native encoding. */ int mode) /* Permission setting. */ { DWORD attr; - attr = GetFileAttributes(nativePath); + attr = GetFileAttributesW(nativePath); if (attr == INVALID_FILE_ATTRIBUTES) { /* * File might not exist. */ @@ -1637,11 +1660,11 @@ } if (mode & X_OK) { mask |= GENERIC_EXECUTE; } - hFile = CreateFile(nativePath, mask, + hFile = CreateFileW(nativePath, mask, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL); if (hFile != INVALID_HANDLE_VALUE) { CloseHandle(hFile); return 0; @@ -1687,11 +1710,11 @@ /* * First find out how big the buffer needs to be. */ size = 0; - GetFileSecurity(nativePath, + GetFileSecurityW(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, 0, 0, &size); /* @@ -1718,14 +1741,14 @@ if (sdPtr == NULL) { goto accessError; } /* - * Call GetFileSecurity() for real. + * Call GetFileSecurityW() for real. */ - if (!GetFileSecurity(nativePath, + if (!GetFileSecurityW(nativePath, OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, sdPtr, size, &size)) { /* * Error getting owner SD @@ -1862,15 +1885,15 @@ if (path[len-4] != '.') { return 0; } path += len-3; - if ((wcsicmp(path, L"exe") == 0) - || (wcsicmp(path, L"com") == 0) - || (wcsicmp(path, L"cmd") == 0) - || (wcsicmp(path, L"cmd") == 0) - || (wcsicmp(path, L"bat") == 0)) { + if ((_wcsicmp(path, L"exe") == 0) + || (_wcsicmp(path, L"com") == 0) + || (_wcsicmp(path, L"cmd") == 0) + || (_wcsicmp(path, L"cmd") == 0) + || (_wcsicmp(path, L"bat") == 0)) { return 1; } return 0; } @@ -1895,16 +1918,16 @@ Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; const WCHAR *nativePath; - nativePath = Tcl_FSGetNativePath(pathPtr); + nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (!nativePath) { return -1; } - result = SetCurrentDirectory(nativePath); + result = SetCurrentDirectoryW(nativePath); if (result == 0) { TclWinConvertError(GetLastError()); return -1; } @@ -1941,11 +1964,11 @@ { WCHAR buffer[MAX_PATH]; char *p; WCHAR *native; - if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { + if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error getting working directory name: %s", Tcl_PosixError(interp))); @@ -1960,11 +1983,12 @@ native = (WCHAR *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } - Tcl_WinTCharToUtf(native, -1, bufferPtr); + Tcl_DStringInit(bufferPtr); + Tcl_WCharToUtfDString(native, -1, bufferPtr); /* * Convert to forward slashes for easier use in scripts. */ @@ -1987,11 +2011,11 @@ * written to since the last flush here. */ TclWinFlushDirtyChannels(); - return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0); + return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0); } /* *---------------------------------------------------------------------- * @@ -2041,11 +2065,11 @@ * default). However the subsequent GetFileInformationByHandle will * fail. We do a WinIsReserved to see if it is one of the special names, * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure. */ - fileHandle = CreateFile(nativePath, GENERIC_READ, + fileHandle = CreateFileW(nativePath, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL); if (fileHandle != INVALID_HANDLE_VALUE) { @@ -2099,21 +2123,21 @@ * Fall back on the less capable routines. This means no nlink or ino. */ WIN32_FILE_ATTRIBUTE_DATA data; - if (GetFileAttributesEx(nativePath, + if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { HANDLE hFind; - WIN32_FIND_DATA ffd; + WIN32_FIND_DATAW ffd; DWORD lasterror = GetLastError(); if (lasterror != ERROR_SHARING_VIOLATION) { TclWinConvertError(lasterror); return -1; } - hFind = FindFirstFile(nativePath, &ffd); + hFind = FindFirstFileW(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); return -1; } memcpy(&data, &ffd, sizeof(data)); @@ -2167,12 +2191,13 @@ Tcl_DString ds; WCHAR nativeFullPath[MAX_PATH]; WCHAR *nativePart; const char *fullPath; - GetFullPathName(nativePath, MAX_PATH, nativeFullPath, &nativePart); - fullPath = Tcl_WinTCharToUtf(nativeFullPath, -1, &ds); + GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart); + Tcl_DStringInit(&ds); + fullPath = Tcl_WCharToUtfDString(nativeFullPath, -1, &ds); if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { const char *p; DWORD dw; const WCHAR *nativeVol; @@ -2180,26 +2205,27 @@ p = strchr(fullPath + 2, '\\'); p = strchr(p + 1, '\\'); if (p == NULL) { /* - * Add terminating backslash to fullpath or GetVolumeInformation() + * Add terminating backslash to fullpath or GetVolumeInformationW() * won't work. */ fullPath = TclDStringAppendLiteral(&ds, "\\"); p = fullPath + Tcl_DStringLength(&ds); } else { p++; } - nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); + Tcl_DStringInit(&volString); + nativeVol = Tcl_UtfToWCharDString(fullPath, p - fullPath, &volString); dw = (DWORD) -1; - GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); + GetVolumeInformationW(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); /* - * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", - * but GetVolumeInformation() returns failure for "\\.\NUL". This will + * GetFullPathNameW() turns special devices like "NUL" into "\\.\NUL", + * but GetVolumeInformationW() returns failure for "\\.\NUL". This will * cause "NUL" to get a drive number of -1, which makes about as much * sense as anything since the special devices don't live on any * drive. */ @@ -2337,11 +2363,11 @@ TclpGetNativeCwd( ClientData clientData) { WCHAR buffer[MAX_PATH]; - if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { + if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { @@ -2356,11 +2382,11 @@ int TclpObjAccess( Tcl_Obj *pathPtr, int mode) { - return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode); + return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode); } int TclpObjLstat( Tcl_Obj *pathPtr, @@ -2372,11 +2398,11 @@ * written to since the last flush here. */ TclWinFlushDirtyChannels(); - return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1); + return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1); } #ifdef S_IFLNK Tcl_Obj * TclpObjLink( @@ -2385,18 +2411,18 @@ int linkAction) { if (toPtr != NULL) { int res; const WCHAR *LinkTarget; - const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr); if (normalizedToPtr == NULL) { return NULL; } - LinkTarget = Tcl_FSGetNativePath(normalizedToPtr); + LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr); if (LinkSource == NULL || LinkTarget == NULL) { return NULL; } res = WinLink(LinkSource, LinkTarget, linkAction); @@ -2404,11 +2430,11 @@ return toPtr; } else { return NULL; } } else { - const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr); + const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (LinkSource == NULL) { return NULL; } return WinReadLink(LinkSource); @@ -2446,34 +2472,35 @@ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath == NULL) { return NULL; } - path = TclGetString(normPath); + path = Tcl_GetString(normPath); if (path == NULL) { return NULL; } firstSeparator = strchr(path, '/'); if (firstSeparator == NULL) { - found = GetVolumeInformation(Tcl_FSGetNativePath(pathPtr), + found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); } else { Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); Tcl_IncrRefCount(driveName); - found = GetVolumeInformation(Tcl_FSGetNativePath(driveName), + found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE); Tcl_DecrRefCount(driveName); } if (found == 0) { return NULL; } else { Tcl_DString ds; - Tcl_WinTCharToUtf(volType, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(volType, -1, &ds); return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE } @@ -2512,23 +2539,24 @@ *--------------------------------------------------------------------------- */ int TclpObjNormalizePath( - Tcl_Interp *interp, - Tcl_Obj *pathPtr, - int nextCheckpoint) + TCL_UNUSED(Tcl_Interp *), + Tcl_Obj *pathPtr, /* An unshared object containing the path to + * normalize */ + int nextCheckpoint) /* offset to start at in pathPtr */ { char *lastValidPathEnd = NULL; Tcl_DString dsNorm; /* This will hold the normalized string. */ char *path, *currentPathEndPosition; Tcl_Obj *temp = NULL; int isDrive = 1; Tcl_DString ds; /* Some workspace. */ Tcl_DStringInit(&dsNorm); - path = TclGetString(pathPtr); + path = Tcl_GetString(pathPtr); currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } @@ -2539,14 +2567,17 @@ /* * Reached directory separator, or end of string. */ WIN32_FILE_ATTRIBUTE_DATA data; - const WCHAR *nativePath = Tcl_WinUtfToTChar(path, + const WCHAR *nativePath; + + Tcl_DStringInit(&ds); + nativePath = Tcl_UtfToWCharDString(path, currentPathEndPosition - path, &ds); - if (GetFileAttributesEx(nativePath, + if (GetFileAttributesExW(nativePath, GetFileExInfoStandard, &data) != TRUE) { /* * File doesn't exist. */ @@ -2561,12 +2592,12 @@ int i; for (i=0 ; i= L'a') { - wc -= (L'a' - L'A'); + if (wc >= 'a') { + wc -= ('a' - 'A'); ((WCHAR *) nativePath)[i] = wc; } } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, @@ -2619,16 +2650,16 @@ /* * Convert link to forward slashes. */ - for (path = TclGetString(to); *path != 0; path++) { + for (path = Tcl_GetString(to); *path != 0; path++) { if (*path == '\\') { *path = '/'; } } - path = TclGetString(to); + path = Tcl_GetString(to); currentPathEndPosition = path + nextCheckpoint; if (temp != NULL) { Tcl_DecrRefCount(temp); } temp = to; @@ -2652,12 +2683,12 @@ */ if (isDrive) { WCHAR drive = ((WCHAR *) nativePath)[0]; - if (drive >= L'a') { - drive -= (L'a' - L'A'); + if (drive >= 'a') { + drive -= ('a' - 'A'); ((WCHAR *) nativePath)[0] = drive; } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, Tcl_DStringLength(&ds)); } else { @@ -2741,21 +2772,24 @@ * Convert the entire known path to long form. */ if (1) { WCHAR wpath[MAX_PATH]; - const WCHAR *nativePath = - Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds); - DWORD wpathlen = GetLongPathNameProc(nativePath, + const WCHAR *nativePath; + DWORD wpathlen; + + Tcl_DStringInit(&ds); + nativePath = + Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); + wpathlen = GetLongPathNameProc(nativePath, (WCHAR *) wpath, MAX_PATH); - /* * We have to make the drive letter uppercase. */ - if (wpath[0] >= L'a') { - wpath[0] -= (L'a' - L'A'); + if (wpath[0] >= 'a') { + wpath[0] -= ('a' - 'A'); } Tcl_DStringAppend(&dsNorm, (const char *) wpath, wpathlen * sizeof(WCHAR)); Tcl_DStringFree(&ds); } @@ -2772,27 +2806,28 @@ * Concatenate the normalized string in dsNorm with the tail of the * path which we didn't recognise. The string in dsNorm is in the * native encoding, so we have to convert it to Utf. */ - Tcl_WinTCharToUtf((const WCHAR *) Tcl_DStringValue(&dsNorm), - Tcl_DStringLength(&dsNorm), &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString((const WCHAR *) Tcl_DStringValue(&dsNorm), + Tcl_DStringLength(&dsNorm)>>1, &ds); nextCheckpoint = Tcl_DStringLength(&ds); if (*lastValidPathEnd != 0) { /* * Not the end of the string. */ + int len; char *path; Tcl_Obj *tmpPathPtr; - size_t length; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); - path = TclGetStringFromObj(tmpPathPtr, &length); - Tcl_SetStringObj(pathPtr, path, length); + path = TclGetStringFromObj(tmpPathPtr, &len); + Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); } else { /* * End of string was reached above. */ @@ -2856,11 +2891,11 @@ /* * Path of form /foo/bar which is a path in the root directory of the * current volume. */ - const char *drive = TclGetString(useThisCwd); + const char *drive = Tcl_GetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, -1); Tcl_IncrRefCount(absolutePath); @@ -2871,11 +2906,11 @@ /* * Path of form C:foo/bar, but this only makes sense if the cwd is * also on drive C. */ - size_t cwdLen; + int cwdLen; const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; if (drive_cur >= 'a') { drive_cur -= ('a' - 'A'); @@ -2945,14 +2980,15 @@ TclpNativeToNormalized( ClientData clientData) { Tcl_DString ds; Tcl_Obj *objPtr; - size_t len; + int len; char *copy, *p; - Tcl_WinTCharToUtf((const WCHAR *) clientData, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds); copy = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); /* * Certain native path representations on Windows have this special prefix @@ -2995,11 +3031,11 @@ * * Results: * The nativePath representation. * * Side effects: - * Memory will be allocated. The path may need to be normalized. + * Memory will be allocated. The path might be normalized. * *--------------------------------------------------------------------------- */ ClientData @@ -3044,11 +3080,12 @@ */ Tcl_IncrRefCount(validPathPtr); } - str = TclGetStringFromObj(validPathPtr, &len); + str = Tcl_GetString(validPathPtr); + len = validPathPtr->length; if (strlen(str) != len) { /* * String contains NUL-bytes. This is invalid. */ @@ -3075,11 +3112,11 @@ /* * Overallocate 6 chars, making some room for extended paths */ - wp = nativePathPtr = Tcl_Alloc((len + 6) * sizeof(WCHAR)); + wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 1); @@ -3173,11 +3210,11 @@ return NULL; } len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); - copy = Tcl_Alloc(len); + copy = (char *)ckalloc(len); memcpy(copy, clientData, len); return copy; } /* @@ -3210,13 +3247,13 @@ FILETIME lastAccessTime, lastModTime; FromCTime(tval->actime, &lastAccessTime); FromCTime(tval->modtime, &lastModTime); - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); - attr = GetFileAttributes(native); + attr = GetFileAttributesW(native); if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { flags = FILE_FLAG_BACKUP_SEMANTICS; } @@ -3223,11 +3260,11 @@ /* * We use the native APIs (not 'utime') because there are some daylight * savings complications that utime gets wrong. */ - fileHandle = CreateFile(native, FILE_WRITE_ATTRIBUTES, 0, NULL, + fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL, OPEN_EXISTING, flags, NULL); if (fileHandle == INVALID_HANDLE_VALUE || !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { TclWinConvertError(GetLastError()); @@ -3261,13 +3298,13 @@ HANDLE token; LPBYTE buf = NULL; DWORD bufsz; int owned = 0; - native = Tcl_FSGetNativePath(pathPtr); + native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); - if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT, + if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. @@ -3289,11 +3326,11 @@ */ bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { - buf = Tcl_Alloc(bufsz); + buf = (LPBYTE)ckalloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); } } CloseHandle(token); @@ -3305,11 +3342,11 @@ if (secd) { LocalFree(secd); /* Also frees ownerSid */ } if (buf) { - Tcl_Free(buf); + ckfree(buf); } return (owned != 0); /* Convert non-0 to 1 */ } Index: win/tclWinInit.c ================================================================== --- win/tclWinInit.c +++ win/tclWinInit.c @@ -15,11 +15,11 @@ #include #include #include /* - * GetUserName() is found in advapi32.dll + * GetUserNameW() is found in advapi32.dll */ #ifdef _MSC_VER # pragma comment(lib, "advapi32.lib") #endif @@ -81,14 +81,13 @@ * Windows version dependend functions */ TclWinProcs tclWinProcs; /* - * The following arrays contain the human readable strings for the Windows + * The following arrays contain the human readable strings for the * processor values. */ - #define NUMPROCESSORS 11 static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" @@ -111,11 +110,11 @@ /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals, + * Initialize all the platform-dependent things like signals, * floating-point error handling and sockets. * * Called at process initialization time. * * Results: @@ -147,19 +146,19 @@ * If we are in a statically linked executable, then we need to explicitly * initialize the Windows function tables here since DllMain() will not be * invoked. */ - TclWinInit(GetModuleHandle(NULL)); + TclWinInit(GetModuleHandleW(NULL)); #endif /* * Fill available functions depending on windows version */ - handle = GetModuleHandle(L"KERNEL32"); + handle = GetModuleHandleW(L"KERNEL32"); tclWinProcs.cancelSynchronousIo = - (BOOL (WINAPI *)(HANDLE)) GetProcAddress(handle, + (BOOL (WINAPI *)(HANDLE))(void *)GetProcAddress(handle, "CancelSynchronousIo"); } /* *------------------------------------------------------------------------- @@ -179,18 +178,18 @@ */ void TclpInitLibraryPath( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; - size_t length; + int length; pathPtr = Tcl_NewObj(); /* * Initialize the substring used when locating the script library. The @@ -224,11 +223,11 @@ TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; bytes = TclGetStringFromObj(pathPtr, &length); *lengthPtr = length++; - *valuePtr = Tcl_Alloc(length); + *valuePtr = (char *)ckalloc(length); memcpy(*valuePtr, bytes, length); Tcl_DecrRefCount(pathPtr); } /* @@ -295,11 +294,11 @@ TclWinNoBackslash(buf); Tcl_SplitPath(buf, &pathc, &pathv); /* - * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8 + * The lstrcmpiA() will work even if pathv[pathc-1] is random UTF-8 * chars because I know shortlib is ascii. */ if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { /* @@ -315,11 +314,11 @@ objPtr = TclDStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_Free((void *)pathv); + ckfree(pathv); } } /* *--------------------------------------------------------------------------- @@ -339,11 +338,11 @@ */ static void InitializeDefaultLibraryDir( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; @@ -361,11 +360,11 @@ *end = '\\'; TclWinNoBackslash(name); sprintf(end + 1, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); - *valuePtr = Tcl_Alloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } /* @@ -387,11 +386,11 @@ */ static void InitializeSourceLibraryDir( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; @@ -409,11 +408,11 @@ *end = '\\'; TclWinNoBackslash(name); sprintf(end + 1, "../library"); *lengthPtr = strlen(name); - *valuePtr = Tcl_Alloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } /* @@ -452,14 +451,20 @@ const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { + UINT acp = GetACP(); + Tcl_DStringInit(bufPtr); - Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); - wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); - Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); + if (acp == CP_UTF8) { + Tcl_DStringAppend(bufPtr, "utf-8", 5); + } else { + Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE); + wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP()); + Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); + } return Tcl_DStringValue(bufPtr); } const char * TclpGetUserName( @@ -470,16 +475,16 @@ if (TclGetEnv("USERNAME", bufferPtr) == NULL) { WCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; - if (!GetUserName(szUserName, &cchUserNameLen)) { + if (!GetUserNameW(szUserName, &cchUserNameLen)) { return NULL; } cchUserNameLen--; - cchUserNameLen *= sizeof(WCHAR); - Tcl_WinTCharToUtf(szUserName, cchUserNameLen, bufferPtr); + Tcl_DStringInit(bufferPtr); + Tcl_WCharToUtfDString(szUserName, cchUserNameLen, bufferPtr); } return Tcl_DStringValue(bufferPtr); } /* @@ -515,13 +520,13 @@ Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); if (!osInfoInitialized) { - HMODULE handle = GetModuleHandle(L"NTDLL"); + HMODULE handle = GetModuleHandleW(L"NTDLL"); int(__stdcall *getversion)(void *) = - (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion"); + (int(__stdcall *)(void *))(void *)GetProcAddress(handle, "RtlGetVersion"); osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); if (!getversion || getversion(&osInfo)) { GetVersionExW(&osInfo); } osInfoInitialized = 1; @@ -532,20 +537,21 @@ * Define the tcl_platform array. */ Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", TCL_GLOBAL_ONLY); - Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "os", + "Windows NT", TCL_GLOBAL_ONLY); wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", processors[sys.oemId.wProcessorArchitecture], TCL_GLOBAL_ONLY); } -#ifdef _DEBUG +#ifndef NDEBUG /* * The existence of the "debug" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with debug * information. Using "info exists tcl_platform(debug)" a Tcl script can * direct the interpreter to load debug versions of DLLs with the load @@ -606,58 +612,64 @@ * Locate the entry in environ for a given name. On Unix this routine is * case sensitive, on Windows this matches mixed case. * * Results: * The return value is the index in environ of an entry with the name - * "name", or TCL_IO_FAILURE if there is no such entry. The integer - * at *lengthPtr is filled in with the length of name (if a matching - * entry is found) or the length of the environ array (if no - * matching entry is found). + * "name", or -1 if there is no such entry. The integer at *lengthPtr is + * filled in with the length of name (if a matching entry is found) or + * the length of the environ array (if no matching entry is found). * * Side effects: * None. * *---------------------------------------------------------------------- */ -size_t +# define tenviron2utfdstr(string, len, dsPtr) \ + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)) + +int TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ - size_t *lengthPtr) /* Used to return length of name (for + int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - size_t i, length, result = TCL_IO_FAILURE; - register const char *env, *p1, *p2; + int i, length, result = -1; + const WCHAR *env; + const char *p1, *p2; char *envUpper, *nameUpper; Tcl_DString envString; /* * Convert the name to all upper case for the case insensitive comparison. */ length = strlen(name); - nameUpper = Tcl_Alloc(length + 1); + nameUpper = (char *)ckalloc(length + 1); memcpy(nameUpper, name, length+1); Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); - for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { + for (i = 0, env = _wenviron[i]; + env != NULL; + i++, env = _wenviron[i]) { /* * Chop the env string off after the equal sign, then Convert the name * to all upper case, so we do not have to convert all the characters * after the equal sign. */ - envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); + Tcl_DStringInit(&envString); + envUpper = Tcl_WCharToUtfDString(env, -1, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; } - length = p1 - envUpper; + length = (int) (p1 - envUpper); Tcl_DStringSetLength(&envString, length+1); Tcl_UtfToUpper(envUpper); p1 = envUpper; p2 = nameUpper; @@ -675,11 +687,11 @@ *lengthPtr = i; done: Tcl_DStringFree(&envString); - Tcl_Free(nameUpper); + ckfree(nameUpper); return result; } /* * Local Variables: Index: win/tclWinInt.h ================================================================== --- win/tclWinInt.h +++ win/tclWinInt.h @@ -45,11 +45,11 @@ * stubs table. */ MODULE_SCOPE char TclWinDriveLetterForVolMountPoint( const WCHAR *mountPoint); -MODULE_SCOPE void TclWinEncodingsCleanup(); +MODULE_SCOPE void TclWinEncodingsCleanup(void); MODULE_SCOPE void TclWinInit(HINSTANCE hInst); MODULE_SCOPE TclFile TclWinMakeFile(HANDLE handle); MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName, @@ -56,13 +56,13 @@ int permissions, int appendMode); MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle, char *channelName, int permissions); MODULE_SCOPE HANDLE TclWinSerialOpen(HANDLE handle, const WCHAR *name, DWORD access); -MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal, - const TCHAR *LinkCopy); -MODULE_SCOPE int TclWinSymLinkDelete(const TCHAR *LinkOriginal, +MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, + const WCHAR *LinkCopy); +MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); @@ -83,16 +83,16 @@ HANDLE evControl; /* Auto-reset event used by the main thread to * signal when the pipe thread should attempt * 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 */ + ClientData 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 +/* If pipe-workers will use some tcl subsystem, we can use ckalloc without * more overhead for finalize thread (should be executed anyway) * * #define _PTI_USE_CKALLOC 1 */ @@ -110,11 +110,11 @@ #define PTI_STATE_DOWN 8 /* worker is down */ MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, - void *clientData, HANDLE wakeEvent); + ClientData clientData, HANDLE wakeEvent); MODULE_SCOPE int TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr); static inline void TclPipeThreadSignal( TclPipeThreadInfo **pipeTIPtr) Index: win/tclWinLoad.c ================================================================== --- win/tclWinLoad.c +++ win/tclWinLoad.c @@ -59,26 +59,26 @@ * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for this * file. */ - int flags) + TCL_UNUSED(int) /*flags*/) { HINSTANCE hInstance = NULL; - const TCHAR *nativeName; + const WCHAR *nativeName; Tcl_LoadHandle handlePtr; DWORD firstError; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ - nativeName = Tcl_FSGetNativePath(pathPtr); + nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName != NULL) { - hInstance = LoadLibraryEx(nativeName, NULL, + hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); } if (hInstance == NULL) { /* * Let the OS loader examine the binary search path for whatever @@ -93,12 +93,13 @@ * second load attempt below also fails. */ firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); - nativeName = Tcl_WinUtfToTChar(TclGetString(pathPtr), -1, &ds); - hInstance = LoadLibraryEx(nativeName, NULL, + Tcl_DStringInit(&ds); + nativeName = Tcl_UtfToWCharDString(Tcl_GetString(pathPtr), -1, &ds); + hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); } if (hInstance == NULL) { @@ -115,11 +116,11 @@ lastError = GetLastError(); else lastError = firstError; errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - TclGetString(pathPtr)); + Tcl_GetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, * because Windows seems to only return ERROR_MOD_NOT_FOUND for just * about any problem, but it's better than nothing. It'd be even @@ -168,11 +169,11 @@ /* * Succeded; package everything up for Tcl. */ - handlePtr = Tcl_Alloc(sizeof(struct Tcl_LoadHandle_)); + handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); handlePtr->clientData = (ClientData) hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; *loadHandle = handlePtr; *unloadProcPtr = &UnloadFile; @@ -200,26 +201,26 @@ Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol) { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; - Tcl_PackageInitProc *proc = NULL; + void *proc = NULL; /* * For each symbol, check for both Symbol and _Symbol, since Borland * generates C symbols with a leading '_' by default. */ - proc = (void *) GetProcAddress(hInstance, symbol); + proc = (void *)GetProcAddress(hInstance, symbol); if (proc == NULL) { Tcl_DString ds; const char *sym2; Tcl_DStringInit(&ds); TclDStringAppendLiteral(&ds, "_"); sym2 = Tcl_DStringAppend(&ds, symbol, -1); - proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2); + proc = (void *)GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); } if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); @@ -253,11 +254,11 @@ * that represents the loaded file. */ { HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); - Tcl_Free(loadHandle); + ckfree(loadHandle); } /* *---------------------------------------------------------------------- * @@ -278,14 +279,12 @@ *---------------------------------------------------------------------- */ int TclGuessPackageName( - const char *fileName, /* Name of file containing package (already - * translated to local form if needed). */ - Tcl_DString *bufPtr) /* Initialized empty dstring. Append package - * name to this if possible. */ + TCL_UNUSED(const char *), + TCL_UNUSED(Tcl_DString *)) { return 0; } /* @@ -414,11 +413,11 @@ /* * Store our computed value in the global. */ copyToGlobalBuffer: - dllDirectoryName = Tcl_Alloc((nameLen+1) * sizeof(WCHAR)); + dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); wcscpy(dllDirectoryName, name); return TCL_OK; } /* Index: win/tclWinNotify.c ================================================================== --- win/tclWinNotify.c +++ win/tclWinNotify.c @@ -47,11 +47,11 @@ * * You must hold the notifierMutex lock before accessing this variable. */ static int notifierCount = 0; -static const TCHAR className[] = TEXT("TclNotifier"); +static const WCHAR className[] = L"TclNotifier"; static int initialized = 0; static CRITICAL_SECTION notifierMutex; /* * Static routines defined in this file. @@ -81,11 +81,10 @@ { if (tclNotifierHooks.initNotifierProc) { return tclNotifierHooks.initNotifierProc(); } else { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - WNDCLASS class; TclpMasterLock(); if (!initialized) { initialized = 1; InitializeCriticalSection(¬ifierMutex); @@ -97,22 +96,24 @@ * this module. */ EnterCriticalSection(¬ifierMutex); if (notifierCount == 0) { - class.style = 0; - class.cbClsExtra = 0; - class.cbWndExtra = 0; - class.hInstance = TclWinGetTclInstance(); - class.hbrBackground = NULL; - class.lpszMenuName = NULL; - class.lpszClassName = className; - class.lpfnWndProc = NotifierProc; - class.hIcon = NULL; - class.hCursor = NULL; - - if (!RegisterClass(&class)) { + WNDCLASSW clazz; + + clazz.style = 0; + clazz.cbClsExtra = 0; + clazz.cbWndExtra = 0; + clazz.hInstance = TclWinGetTclInstance(); + clazz.hbrBackground = NULL; + clazz.lpszMenuName = NULL; + clazz.lpszClassName = className; + clazz.lpfnWndProc = NotifierProc; + clazz.hIcon = NULL; + clazz.hCursor = NULL; + + if (!RegisterClassW(&clazz)) { Tcl_Panic("Unable to register TclNotifier window class"); } } notifierCount++; LeaveCriticalSection(¬ifierMutex); @@ -122,11 +123,11 @@ InitializeCriticalSection(&tsdPtr->crit); tsdPtr->hwnd = NULL; tsdPtr->thread = GetCurrentThreadId(); - tsdPtr->event = CreateEvent(NULL, TRUE /* manual */, + tsdPtr->event = CreateEventW(NULL, TRUE /* manual */, FALSE /* !signaled */, NULL); return tsdPtr; } } @@ -192,11 +193,11 @@ EnterCriticalSection(¬ifierMutex); if (notifierCount) { notifierCount--; if (notifierCount == 0) { - UnregisterClass(className, TclWinGetTclInstance()); + UnregisterClassW(className, TclWinGetTclInstance()); } } LeaveCriticalSection(¬ifierMutex); } } @@ -244,11 +245,11 @@ * We do need to lock around access to the pending flag. */ EnterCriticalSection(&tsdPtr->crit); if (!tsdPtr->pending) { - PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0); + PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0); } tsdPtr->pending = 1; LeaveCriticalSection(&tsdPtr->crit); } else { SetEvent(tsdPtr->event); @@ -356,11 +357,11 @@ * destroying the window if we leave the modal loop, but for now we'll * leave it around. */ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { - tsdPtr->hwnd = CreateWindow(className, className, + tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); /* * Send an initial message to the window to ensure that we wake up @@ -404,11 +405,11 @@ if (message == WM_WAKEUP) { EnterCriticalSection(&tsdPtr->crit); tsdPtr->pending = 0; LeaveCriticalSection(&tsdPtr->crit); } else if (message != WM_TIMER) { - return DefWindowProc(hwnd, message, wParam, lParam); + return DefWindowProcW(hwnd, message, wParam, lParam); } /* * Process all of the runnable events. */ @@ -476,11 +477,11 @@ * Check to see if there are any messages in the queue before waiting * because MsgWaitForMultipleObjects will not wake up if there are * events currently sitting in the queue. */ - if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Wait for something to happen (a signal from another thread, a * message, or timeout) or loop servicing asynchronous procedure * calls queued to this thread. */ @@ -498,16 +499,16 @@ /* * Check to see if there are any messages to process. */ - if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) { /* * Retrieve and dispatch the first message. */ - result = GetMessage(&msg, NULL, 0, 0); + result = GetMessageW(&msg, NULL, 0, 0); if (result == 0) { /* * We received a request to exit this thread (WM_QUIT), so * propagate the quit message and start unwinding. */ @@ -521,11 +522,11 @@ */ status = -1; } else { TranslateMessage(&msg); - DispatchMessage(&msg); + DispatchMessageW(&msg); status = 1; } } else { status = 0; } Index: win/tclWinPanic.c ================================================================== --- win/tclWinPanic.c +++ win/tclWinPanic.c @@ -1,6 +1,6 @@ - /* +/* * tclWinPanic.c -- * * Contains the Windows-specific command-line panic proc. * * Copyright (c) 2013 by Jan Nijtmans. @@ -26,11 +26,11 @@ * None. * *---------------------------------------------------------------------- */ -TCL_NORETURN1 void +void Tcl_ConsolePanic( const char *format, ...) { #define TCL_MAX_WARN_LEN 26000 va_list argList; @@ -40,18 +40,18 @@ DWORD dummy; va_start(argList, format); vsnprintf(buf+3, sizeof(buf)-3, format, argList); buf[sizeof(buf)-1] = 0; - msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + msgString[TCL_MAX_WARN_LEN-1] = '\0'; MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN); /* * Truncate MessageBox string if it is too long to not overflow the buffer. */ - if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + if (msgString[TCL_MAX_WARN_LEN-1] != '\0') { memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); } if (IsDebuggerPresent()) { OutputDebugStringW(msgString); Index: win/tclWinPipe.c ================================================================== --- win/tclWinPipe.c +++ win/tclWinPipe.c @@ -59,11 +59,11 @@ * This list is used to map from pids to process handles. */ typedef struct ProcInfo { HANDLE hProcess; - size_t dwProcessId; + DWORD dwProcessId; struct ProcInfo *nextPtr; } ProcInfo; static ProcInfo *procList; @@ -308,11 +308,11 @@ *---------------------------------------------------------------------- */ void PipeSetupProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; Tcl_Time blockTime = { 0, 0 }; int block = 1; @@ -361,11 +361,11 @@ *---------------------------------------------------------------------- */ static void PipeCheckProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { PipeInfo *infoPtr; PipeEvent *evPtr; int needEvent; @@ -400,11 +400,11 @@ needEvent = 1; } if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = Tcl_Alloc(sizeof(PipeEvent)); + evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } @@ -431,11 +431,11 @@ TclWinMakeFile( HANDLE handle) /* Type-specific data. */ { WinFile *filePtr; - filePtr = Tcl_Alloc(sizeof(WinFile)); + filePtr = (WinFile *)ckalloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; return (TclFile)filePtr; } @@ -464,18 +464,18 @@ TempFileName( WCHAR name[MAX_PATH]) /* Buffer in which name for temporary file * gets stored. */ { const WCHAR *prefix = L"TCL"; - if (GetTempPath(MAX_PATH, name) != 0) { - if (GetTempFileName(name, prefix, 0, name) != 0) { + if (GetTempPathW(MAX_PATH, name) != 0) { + if (GetTempFileNameW(name, prefix, 0, name) != 0) { return 1; } } name[0] = '.'; name[1] = '\0'; - return GetTempFileName(name, prefix, 0, name); + return GetTempFileNameW(name, prefix, 0, name); } /* *---------------------------------------------------------------------- * @@ -575,19 +575,20 @@ default: createMode = OPEN_EXISTING; break; } - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + Tcl_DStringInit(&ds); + nativePath = Tcl_UtfToWCharDString(path, -1, &ds); /* * If the file is not being created, use the existing file attributes. */ flags = 0; if (!(mode & O_CREAT)) { - flags = GetFileAttributes(nativePath); + flags = GetFileAttributesW(nativePath); if (flags == 0xFFFFFFFF) { flags = 0; } } @@ -599,19 +600,19 @@ /* * Now we get to create the file. */ - handle = CreateFile(nativePath, accessMode, shareMode, + handle = CreateFileW(nativePath, accessMode, shareMode, NULL, createMode, flags, NULL); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { DWORD err; err = GetLastError(); - if ((err & 0xffffL) == ERROR_OPEN_FAILED) { + if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) { err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } TclWinConvertError(err); return NULL; } @@ -656,11 +657,11 @@ if (TempFileName(name) == 0) { return NULL; } - handle = CreateFile(name, + handle = CreateFileW(name, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL); if (handle == INVALID_HANDLE_VALUE) { goto error; } @@ -718,11 +719,11 @@ Tcl_DStringFree(&dstring); } TclWinConvertError(GetLastError()); CloseHandle(handle); - DeleteFile(name); + DeleteFileW(name); return NULL; } /* *---------------------------------------------------------------------- @@ -823,21 +824,21 @@ && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle) && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) { if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { TclWinConvertError(GetLastError()); - Tcl_Free(filePtr); + ckfree(filePtr); return -1; } } break; default: Tcl_Panic("TclpCloseFile: unexpected file type"); } - Tcl_Free(filePtr); + ckfree(filePtr); return 0; } /* *-------------------------------------------------------------------------- @@ -848,35 +849,35 @@ * child process. * * Results: * Returns the process id for the child process. If the pid was not known * by Tcl, either because the pid was not created by Tcl or the child - * process has already been reaped, TCL_IO_FAILURE is returned. + * process has already been reaped, -1 is returned. * * Side effects: * None. * *-------------------------------------------------------------------------- */ -size_t +int TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { ProcInfo *infoPtr; PipeInit(); Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (size_t) pid) { + if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); - return TCL_IO_FAILURE; + return (unsigned long) -1; } /* *---------------------------------------------------------------------- * @@ -934,11 +935,11 @@ * filled with the process id of the child * process. */ { int result, applType, createFlags; Tcl_DString cmdLine; /* Complete command line (WCHAR). */ - STARTUPINFO startInfo; + STARTUPINFOW startInfo; PROCESS_INFORMATION procInfo; SECURITY_ATTRIBUTES secAtts; HANDLE hProcess, h, inputHandle, outputHandle, errorHandle; char execPath[MAX_PATH * 3]; WinFile *filePtr; @@ -1045,11 +1046,11 @@ * * Fortunately, the helper application will detect a closed pipe as a * sink. */ - startInfo.hStdOutput = CreateFile(L"NUL:", GENERIC_WRITE, 0, + startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } @@ -1065,11 +1066,11 @@ /* * If handle was not set, errors should be sent to an infinitely deep * sink. */ - startInfo.hStdError = CreateFile(L"NUL:", GENERIC_WRITE, 0, + startInfo.hStdError = CreateFileW(L"NUL:", GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS); } @@ -1131,11 +1132,11 @@ * ab~1.def instead of "a b.default"). */ BuildCommandLine(execPath, argc, argv, &cmdLine); - if (CreateProcess(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), + if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", argv[0], Tcl_PosixError(interp))); @@ -1153,11 +1154,11 @@ /* * "When an application spawns a process repeatedly, a new thread instance * will be created for each process but the previous instances may not be * cleaned up. This results in a significant virtual memory loss each time * the process is spawned. If there is a WaitForInputIdle() call between - * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID + * CreateProcessW() and CloseHandle(), the problem does not occur." PSS ID * Number: Q124121 */ WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); @@ -1202,11 +1203,11 @@ static BOOL HasConsole(void) { HANDLE handle; - handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, + handle = CreateFileW(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (handle != INVALID_HANDLE_VALUE) { CloseHandle(handle); return TRUE; @@ -1272,11 +1273,11 @@ /* * Look for the program as an external program. First try the name as it * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name, * looking for an executable. * - * Using the raw SearchPath() function doesn't do quite what is necessary. + * Using the raw SearchPathW() function doesn't do quite what is necessary. * If the name of the executable already contains a '.' character, it will * not try appending the specified extension when searching (in other * words, SearchPath will not find the program "a.b.exe" if the arguments * specified "a.b" and ".exe"). So, first look for the file as it is * named. Then manually append the extensions, looking for a match. @@ -1288,13 +1289,14 @@ nameLen = Tcl_DStringLength(&nameBuf); for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { Tcl_DStringSetLength(&nameBuf, nameLen); Tcl_DStringAppend(&nameBuf, extensions[i], -1); - nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), + Tcl_DStringInit(&ds); + nativeName = Tcl_UtfToWCharDString(Tcl_DStringValue(&nameBuf), Tcl_DStringLength(&nameBuf), &ds); - found = SearchPath(NULL, nativeName, NULL, MAX_PATH, + found = SearchPathW(NULL, nativeName, NULL, MAX_PATH, nativeFullPath, &rest); Tcl_DStringFree(&ds); if (found == 0) { continue; } @@ -1302,25 +1304,26 @@ /* * Ignore matches on directories or data files, return if identified a * known type. */ - attr = GetFileAttributes(nativeFullPath); - if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { + attr = GetFileAttributesW(nativeFullPath); + if ((attr == 0xFFFFFFFF) || (attr & FILE_ATTRIBUTE_DIRECTORY)) { continue; } - strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds)); + Tcl_DStringInit(&ds); + strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); if ((ext != NULL) && (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } - hFile = CreateFile(nativeFullPath, + hFile = CreateFileW(nativeFullPath, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hFile == INVALID_HANDLE_VALUE) { continue; } @@ -1396,12 +1399,13 @@ * 16-bit applications. Otherwise the application may not be able to * correctly parse its own command line to separate off the * application name from the arguments. */ - GetShortPathName(nativeFullPath, nativeFullPath, MAX_PATH); - strcpy(fullName, Tcl_WinTCharToUtf(nativeFullPath, -1, &ds)); + GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH); + Tcl_DStringInit(&ds); + strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds)); Tcl_DStringFree(&ds); } return applType; } @@ -1409,11 +1413,11 @@ *---------------------------------------------------------------------- * * BuildCommandLine -- * * The command line arguments are stored in linePtr separated by spaces, - * in a form that CreateProcess() understands. Special characters in + * in a form that CreateProcessW() understands. Special characters in * individual arguments from argv[] must be quoted when being stored in * cmdLine. * * Results: * None. @@ -1725,11 +1729,12 @@ TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); - Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); + Tcl_DStringInit(linePtr); + Tcl_UtfToWCharDString(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- @@ -1756,11 +1761,11 @@ * can be read. */ int numPids, /* The number of pids in the pid array. */ Tcl_Pid *pidPtr) /* An array of process identifiers. */ { char channelName[16 + TCL_INTEGER_SPACE]; - PipeInfo *infoPtr = Tcl_Alloc(sizeof(PipeInfo)); + PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo)); PipeInit(); infoPtr->watchMask = 0; infoPtr->flags = 0; @@ -1782,11 +1787,11 @@ if (readFile != NULL) { /* * Start the background reader thread. */ - infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread, TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable), 0, NULL); SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_READABLE; @@ -1797,11 +1802,11 @@ if (writeFile != NULL) { /* * Start the background writer thread. */ - infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread, TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable), 0, NULL); SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST); infoPtr->validMask |= TCL_WRITABLE; @@ -1849,11 +1854,11 @@ int Tcl_CreatePipe( Tcl_Interp *interp, /* Errors returned in result.*/ Tcl_Channel *rchan, /* Where to return the read side. */ Tcl_Channel *wchan, /* Where to return the write side. */ - int flags) /* Reserved for future use. */ + TCL_UNUSED(int) /*flags*/) /* Reserved for future use. */ { HANDLE readHandle, writeHandle; SECURITY_ATTRIBUTES sec; sec.nLength = sizeof(SECURITY_ATTRIBUTES); @@ -1910,21 +1915,21 @@ chanTypePtr = Tcl_GetChannelType(chan); if (chanTypePtr != &pipeChannelType) { return; } - pipePtr = Tcl_GetChannelInstanceData(chan); + pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, - Tcl_NewWideIntObj( + Tcl_NewWideIntObj((unsigned) TclpGetPid(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - Tcl_Free(pipePtr->pidPtr); + ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; } } /* @@ -2107,28 +2112,28 @@ if (pipePtr->errorFile) { WinFile *filePtr = (WinFile *) pipePtr->errorFile; errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); - Tcl_Free(filePtr); + ckfree(filePtr); } else { errChan = NULL; } result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr, errChan); } if (pipePtr->numPids > 0) { - Tcl_Free(pipePtr->pidPtr); + ckfree(pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { - Tcl_Free(pipePtr->writeBuf); + ckfree(pipePtr->writeBuf); } - Tcl_Free(pipePtr); + ckfree(pipePtr); if (errorCode == 0) { return result; } return errorCode; @@ -2293,14 +2298,14 @@ /* * Reallocate the buffer to be large enough to hold the data. */ if (infoPtr->writeBuf) { - Tcl_Free(infoPtr->writeBuf); + ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = Tcl_Alloc(toWrite); + infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->writable); TclPipeThreadSignal(&infoPtr->writeTI); @@ -2558,11 +2563,11 @@ Tcl_MutexLock(&pipeMutex); prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (size_t) pid) { + if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } } Tcl_MutexUnlock(&pipeMutex); @@ -2676,11 +2681,11 @@ /* * Officially close the process handle. */ CloseHandle(infoPtr->hProcess); - Tcl_Free(infoPtr); + ckfree(infoPtr); return result; } /* @@ -2702,13 +2707,13 @@ */ void TclWinAddProcess( void *hProcess, /* Handle to process */ - size_t id) /* Global process identifier */ + unsigned long id) /* Global process identifier */ { - ProcInfo *procPtr = Tcl_Alloc(sizeof(ProcInfo)); + ProcInfo *procPtr = (ProcInfo*)ckalloc(sizeof(ProcInfo)); PipeInit(); procPtr->hProcess = hProcess; procPtr->dwProcessId = id; @@ -2733,14 +2738,13 @@ * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_PidObjCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; @@ -2754,11 +2758,11 @@ return TCL_ERROR; } if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { - chan = Tcl_GetChannel(interp, TclGetString(objv[1]), + chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } chanTypePtr = Tcl_GetChannelType(chan); @@ -2805,11 +2809,11 @@ PipeInfo *infoPtr, /* Pipe state. */ int blocking) /* Indicates whether call should be blocking * or not. */ { DWORD timeout, count; - HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle; + HANDLE *handle = (HANDLE *)((WinFile *) infoPtr->readFile)->handle; while (1) { /* * Synchronize with the reader thread. */ @@ -3182,37 +3186,37 @@ *---------------------------------------------------------------------- */ Tcl_Channel TclpOpenTemporaryFile( - Tcl_Obj *dirObj, + TCL_UNUSED(Tcl_Obj *) /*dirObj*/, Tcl_Obj *basenameObj, - Tcl_Obj *extensionObj, + TCL_UNUSED(Tcl_Obj *) /*extensionObj*/, Tcl_Obj *resultingNameObj) { WCHAR name[MAX_PATH]; char *namePtr; HANDLE handle; DWORD flags = FILE_ATTRIBUTE_TEMPORARY; - size_t length; - int counter, counter2; + int length, counter, counter2; Tcl_DString buf; if (!resultingNameObj) { flags |= FILE_FLAG_DELETE_ON_CLOSE; } namePtr = (char *) name; - length = GetTempPath(MAX_PATH, name); + length = GetTempPathW(MAX_PATH, name); if (length == 0) { goto gotError; } namePtr += length * sizeof(WCHAR); if (basenameObj) { const char *string = TclGetStringFromObj(basenameObj, &length); - Tcl_WinUtfToTChar(string, length, &buf); + Tcl_DStringInit(&buf); + Tcl_UtfToWCharDString(string, length, &buf); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); namePtr += Tcl_DStringLength(&buf); Tcl_DStringFree(&buf); } else { const WCHAR *baseStr = L"TCL"; @@ -3228,16 +3232,17 @@ do { char number[TCL_INTEGER_SPACE + 4]; sprintf(number, "%d.TMP", counter); counter = (unsigned short) (counter + 1); - Tcl_WinUtfToTChar(number, strlen(number), &buf); + Tcl_DStringInit(&buf); + Tcl_UtfToWCharDString(number, strlen(number), &buf); Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1); memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); - handle = CreateFile(name, + handle = CreateFileW(name, GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL); } while (handle == INVALID_HANDLE_VALUE && --counter2 > 0 && GetLastError() == ERROR_FILE_EXISTS); if (handle == INVALID_HANDLE_VALUE) { @@ -3278,15 +3283,15 @@ ClientData clientData, HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI; #ifndef _PTI_USE_CKALLOC - pipeTI = malloc(sizeof(TclPipeThreadInfo)); + pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo)); #else - pipeTI = Tcl_Alloc(sizeof(TclPipeThreadInfo)); + pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ - pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL); + pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; pipeTI->clientData = clientData; pipeTI->evWakeUp = wakeEvent; return (*pipeTIPtr = pipeTI); } @@ -3429,10 +3434,11 @@ * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); *pipeTIPtr = NULL; + /* FALLTHRU */ case PTI_STATE_DOWN: return 1; default: /* @@ -3642,11 +3648,11 @@ } CloseHandle(pipeTI->evControl); #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - Tcl_Free(pipeTI); + ckfree(pipeTI); #endif /* !_PTI_USE_CKALLOC */ } } /* @@ -3692,11 +3698,11 @@ SetEvent(pipeTI->evWakeUp); } #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - Tcl_Free(pipeTI); + ckfree(pipeTI); /* be sure all subsystems used are finalized */ Tcl_FinalizeThread(); #endif /* !_PTI_USE_CKALLOC */ } } Index: win/tclWinPort.h ================================================================== --- win/tclWinPort.h +++ win/tclWinPort.h @@ -12,13 +12,17 @@ */ #ifndef _TCLWINPORT #define _TCLWINPORT -#if !defined(_WIN64) && defined(BUILD_tcl) +#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ -# define _USE_32BIT_TIME_T +# define __MINGW_USE_VC2005_COMPAT +#endif +#if defined(_MSC_VER) && defined(_WIN64) && !defined(STATIC_BUILD) \ + && !defined(MP_32BIT) && !defined(MP_64BIT) +# define MP_64BIT #endif /* * We must specify the lower version we intend to support. * @@ -80,11 +84,19 @@ #include #include #include #include #include +#ifdef HAVE_INTTYPES_H +# include +#endif #include +#ifdef HAVE_STDINT_H +# include +#else +# include "../compat/stdint.h" +#endif #ifndef __GNUC__ # define strncasecmp _strnicmp # define strcasecmp _stricmp #endif @@ -300,19 +312,19 @@ #ifndef WIFSIGNALED # define WIFSIGNALED(stat) ((*((int *) &(stat))) & 0xC0000000) #endif #ifndef WTERMSIG -# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) +# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7F) #endif #ifndef WIFSTOPPED # define WIFSTOPPED(stat) 0 #endif #ifndef WSTOPSIG -# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) +# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xFF) #endif /* * Define constants for waitpid() system call if they aren't defined * by a system header file. @@ -470,10 +482,11 @@ * MSVC 8.0 started to mark many standard C library functions depreciated * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ #if defined(_MSC_VER) +# pragma warning(disable:4146) # pragma warning(disable:4244) # if _MSC_VER >= 1400 # pragma warning(disable:4267) # pragma warning(disable:4996) # endif @@ -526,11 +539,11 @@ /* * The following defines wrap the system memory allocation routines for * use by tclAlloc.c. */ -#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \ +#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ (DWORD)0, (DWORD)size)) #define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ (DWORD)0, (HGLOBAL)ptr)) #define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ (DWORD)0, (LPVOID)ptr, (DWORD)size)) @@ -542,11 +555,11 @@ /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. */ -#define TclpReleaseFile(file) Tcl_Free(file) +#define TclpReleaseFile(file) ckfree(file) /* * The following macros and declarations wrap the C runtime library * functions. */ @@ -558,7 +571,10 @@ #endif /* INVALID_SET_FILE_POINTER */ #ifndef LABEL_SECURITY_INFORMATION # define LABEL_SECURITY_INFORMATION (0x00000010L) #endif + +#define Tcl_DirEntry void +#define TclDIR void #endif /* _TCLWINPORT */ Index: win/tclWinReg.c ================================================================== --- win/tclWinReg.c +++ win/tclWinReg.c @@ -92,11 +92,11 @@ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); -static void DeleteCmd(ClientData clientData); +static void DeleteCmd(void *clientData); static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, REGSAM mode); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, @@ -114,17 +114,27 @@ HKEY *keyPtr); static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - const TCHAR * pKeyName, REGSAM mode); -static int RegistryObjCmd(ClientData clientData, + const WCHAR * pKeyName, REGSAM mode); +static int RegistryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); + +#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#endif static unsigned char * getByteArrayFromObj( Tcl_Obj *objPtr, size_t *lengthPtr @@ -141,12 +151,18 @@ /* 32-bit or without TIP #494 */ *lengthPtr = (size_t) (unsigned) length; return result; } +#ifdef __cplusplus +extern "C" { +#endif DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); +#ifdef __cplusplus +} +#endif /* *---------------------------------------------------------------------- * * Registry_Init -- @@ -173,11 +189,11 @@ } cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.3"); + return Tcl_PkgProvideEx(interp, "registry", "1.3.5", NULL); } /* *---------------------------------------------------------------------- * @@ -199,10 +215,11 @@ Tcl_Interp *interp, /* Interpreter for unloading */ int flags) /* Flags passed by the unload system */ { Tcl_Command cmd; Tcl_Obj *objv[3]; + (void)flags; /* * Unregister the registry package. There is no Tcl_PkgForget() */ @@ -213,11 +230,11 @@ /* * Delete the originally registered command. */ - cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } return TCL_OK; @@ -240,13 +257,13 @@ *---------------------------------------------------------------------- */ static void DeleteCmd( - ClientData clientData) + void *clientData) { - Tcl_Interp *interp = clientData; + Tcl_Interp *interp = (Tcl_Interp *)clientData; Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } /* @@ -265,11 +282,11 @@ *---------------------------------------------------------------------- */ static int RegistryObjCmd( - ClientData clientData, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int n = 1; @@ -284,10 +301,11 @@ BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; static const char *const modes[] = { "-32bit", "-64bit", NULL }; + (void)dummy; if (objc < 2) { wrongArgs: Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); return TCL_ERROR; @@ -413,11 +431,11 @@ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key to delete. */ REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; - const TCHAR *nativeTail; + const WCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; Tcl_DString buf; REGSAM saveMode = mode; @@ -424,11 +442,11 @@ /* * Find the parent of the key being deleted and open it. */ keyName = Tcl_GetString(keyNameObj); - buffer = Tcl_Alloc(keyNameObj->length + 1); + buffer = (char *)Tcl_Alloc(keyNameObj->length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName) != TCL_OK) { Tcl_Free(buffer); @@ -466,11 +484,12 @@ /* * Now we recursively delete the key and everything below it. */ - nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); + Tcl_DStringInit(&buf); + nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf); result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { Tcl_SetObjResult(interp, @@ -522,12 +541,13 @@ if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); - Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); - result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); + Tcl_DStringInit(&ds); + Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); + result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); @@ -566,11 +586,11 @@ Tcl_Obj *patternObj, /* Optional match pattern. */ REGSAM mode) /* Mode flags to pass. */ { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - TCHAR buffer[MAX_KEY_LENGTH]; + WCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ Tcl_Obj *resultPtr; /* List of subkeys being accumulated */ @@ -597,11 +617,11 @@ */ resultPtr = Tcl_NewObj(); for (index = 0;; ++index) { bufSize = MAX_KEY_LENGTH; - result = RegEnumKeyEx(key, index, buffer, &bufSize, + result = RegEnumKeyExW(key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { if (result == ERROR_NO_MORE_ITEMS) { result = TCL_OK; } else { @@ -611,11 +631,12 @@ AppendSystemError(interp, result); result = TCL_ERROR; } break; } - name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); + Tcl_DStringInit(&ds); + name = Tcl_WCharToUtfDString(buffer, bufSize, &ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; } result = Tcl_ListObjAppendElement(interp, resultPtr, @@ -661,11 +682,11 @@ { HKEY key; DWORD result, type; Tcl_DString ds; const char *valueName; - const TCHAR *nativeValue; + const WCHAR *nativeValue; /* * Attempt to open the key for reading. */ @@ -677,12 +698,13 @@ /* * Get the type of the value. */ valueName = Tcl_GetString(valueNameObj); - nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); - result = RegQueryValueEx(key, nativeValue, NULL, &type, + Tcl_DStringInit(&ds); + nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds); + result = RegQueryValueExW(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { @@ -730,11 +752,11 @@ Tcl_Obj *valueNameObj, /* Name of value to get. */ REGSAM mode) /* Mode flags to pass. */ { HKEY key; const char *valueName; - const TCHAR *nativeValue; + const WCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; /* * Attempt to open the key for reading. @@ -755,27 +777,28 @@ * Longer values need a second call with an expanded DString. */ Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); - length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; + length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1; valueName = Tcl_GetString(valueNameObj); - nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf); + Tcl_DStringInit(&buf); + nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf); - result = RegQueryValueEx(key, nativeValue, NULL, &type, + result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* * The Windows docs say that in this error case, we just need to * expand our buffer and request more data. Required for * HKEY_PERFORMANCE_DATA */ - length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); - Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); - result = RegQueryValueEx(key, nativeValue, + length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR)); + Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR)); + result = RegQueryValueExW(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { @@ -807,25 +830,27 @@ * terminated by two null characters. Also do a bounds check in case * we get bogus data. */ while ((p < end) && *((WCHAR *) p) != 0) { - WCHAR *wp; + WCHAR *wp = (WCHAR *) p; - Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); + Tcl_DStringInit(&buf); + Tcl_WCharToUtfDString(wp, wcslen(wp), &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - wp = (WCHAR *) p; while (*wp++ != 0) {/* empty body */} p = (char *) wp; Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); + WCHAR *wp = (WCHAR *) Tcl_DStringValue(&data); + Tcl_DStringInit(&buf); + Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&data), wcslen(wp), &buf); Tcl_DStringResult(interp, &buf); } else { /* * Save binary data as a byte array. */ @@ -878,11 +903,11 @@ return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); index = 0; result = TCL_OK; if (patternObj) { pattern = Tcl_GetString(patternObj); @@ -895,16 +920,15 @@ * indicating the end of the list. Note that we need to reset size after * each iteration because RegEnumValue smashes the old value. */ size = MAX_KEY_LENGTH; - while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), + while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - size *= sizeof(TCHAR); - Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, - &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); if (!pattern || Tcl_StringMatch(name, pattern)) { result = Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); if (result != TCL_OK) { @@ -951,11 +975,11 @@ char *keyName, *buffer, *hostName; HKEY rootKey; DWORD result; keyName = Tcl_GetString(keyNameObj); - buffer = Tcl_Alloc(keyNameObj->length + 1); + buffer = (char *)Tcl_Alloc(keyNameObj->length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); if (result == TCL_OK) { result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr); @@ -1006,12 +1030,13 @@ /* * Attempt to open the root key on a remote host if necessary. */ if (hostName) { - hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); - result = RegConnectRegistry((TCHAR *)hostName, rootKey, + Tcl_DStringInit(&buf); + hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); + result = RegConnectRegistryW((WCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { return result; } @@ -1021,16 +1046,17 @@ * Now open the specified key with the requested permissions. Note that * this key must be closed by the caller. */ if (keyName) { - keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); + Tcl_DStringInit(&buf); + keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); } if (flags & REG_CREATE) { DWORD create; - result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, + result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. @@ -1037,11 +1063,11 @@ */ *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, + result = RegOpenKeyExW(rootKey, (WCHAR *)keyName, 0, mode, keyPtr); } if (keyName) { Tcl_DStringFree(&buf); } @@ -1157,20 +1183,20 @@ */ static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - const TCHAR *keyName, /* Name of key to be deleted in external + const WCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ REGSAM mode) /* Mode flags to pass. */ { DWORD result, size; Tcl_DString subkey; HKEY hKey; REGSAM saveMode = mode; static int checkExProc = 0; - static FARPROC regDeleteKeyExProc = NULL; + static LONG (* regDeleteKeyExProc) (HKEY, LPCWSTR, REGSAM, DWORD) = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) NULL; /* * Do not allow NULL or empty key name. */ @@ -1177,26 +1203,26 @@ if (!keyName || *keyName == '\0') { return ERROR_BADKEY; } mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; - result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); + result = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ size = MAX_KEY_LENGTH; - result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), + result = RegEnumKeyExW(hKey, 0, (WCHAR *)Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { /* * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we * can't compile with it in. We need to check for it at runtime @@ -1205,23 +1231,23 @@ if (mode && !checkExProc) { HMODULE handle; checkExProc = 1; - handle = GetModuleHandle(TEXT("ADVAPI32")); - regDeleteKeyExProc = (FARPROC) - GetProcAddress(handle, "RegDeleteKeyExW"); + handle = GetModuleHandleW(L"ADVAPI32"); + regDeleteKeyExProc = (LONG (*) (HKEY, LPCWSTR, REGSAM, DWORD)) + (void *)GetProcAddress(handle, "RegDeleteKeyExW"); } if (mode && regDeleteKeyExProc) { result = regDeleteKeyExProc(startKey, keyName, mode, 0); } else { - result = RegDeleteKey(startKey, keyName); + result = RegDeleteKeyW(startKey, keyName); } break; } else if (result == ERROR_SUCCESS) { result = RecursiveDeleteKey(hKey, - (const TCHAR *) Tcl_DStringValue(&subkey), mode); + (const WCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); RegCloseKey(hKey); return result; @@ -1273,11 +1299,12 @@ if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } valueName = Tcl_GetString(valueNameObj); - valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf); + Tcl_DStringInit(&nameBuf); + valueName = (char *) Tcl_UtfToWCharDString(valueName, valueNameObj->length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) { @@ -1285,11 +1312,11 @@ Tcl_DStringFree(&nameBuf); return TCL_ERROR; } value = ConvertDWORD((DWORD) type, (DWORD) value); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; int objc, i; Tcl_Obj **objv; @@ -1317,30 +1344,32 @@ */ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } - Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, + Tcl_DStringInit(&buf); + Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; const char *data = Tcl_GetString(dataObj); - data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf); + Tcl_DStringInit(&buf); + data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf); /* * Include the null in the length, padding if needed for WCHAR. */ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); } else { BYTE *data; size_t bytelength; @@ -1348,11 +1377,11 @@ /* * Store binary data in the registry. */ data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); - result = RegSetValueEx(key, (TCHAR *) valueName, 0, + result = RegSetValueExW(key, (WCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } Tcl_DStringFree(&nameBuf); RegCloseKey(key); @@ -1408,20 +1437,21 @@ return TCL_ERROR; } } str = Tcl_GetString(objv[0]); - wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds); + Tcl_DStringInit(&ds); + wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } /* * Use the ignore the result. */ - result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, + result = SendMessageTimeoutW(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); Tcl_DStringFree(&ds); objPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result)); @@ -1452,30 +1482,31 @@ AppendSystemError( Tcl_Interp *interp, /* Current interpreter. */ DWORD error) /* Result code from error. */ { int length; - TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; + WCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { sprintf(msgBuf, "unknown error: %ld", error); msg = msgBuf; } else { char *msgPtr; - Tcl_WinTCharToUtf(tMsgPtr, -1, &ds); + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds); LocalFree(tMsgPtr); msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); Index: win/tclWinSerial.c ================================================================== --- win/tclWinSerial.c +++ win/tclWinSerial.c @@ -166,11 +166,11 @@ */ static int SerialBlockProc(ClientData instanceData, int mode); static void SerialCheckProc(ClientData clientData, int flags); static int SerialCloseProc(ClientData instanceData, - Tcl_Interp *interp); + Tcl_Interp *interp, int flags); static int SerialEventProc(Tcl_Event *evPtr, int flags); static void SerialExitHandler(ClientData clientData); static int SerialGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); static ThreadSpecificData *SerialInit(void); @@ -202,19 +202,19 @@ */ static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - SerialCloseProc, /* Close proc. */ + TCL_CLOSE2PROC, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ SerialSetOptionProc, /* Set option proc. */ SerialGetOptionProc, /* Get option proc. */ SerialWatchProc, /* Set up notifier to watch the channel. */ SerialGetHandleProc, /* Get an OS handle from channel. */ - NULL, /* close2proc. */ + SerialCloseProc, /* close2proc. */ SerialBlockProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ @@ -283,11 +283,11 @@ *---------------------------------------------------------------------- */ static void SerialExitHandler( - ClientData clientData) /* Old window proc */ + TCL_UNUSED(ClientData)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; /* @@ -321,11 +321,11 @@ *---------------------------------------------------------------------- */ static void ProcExitHandler( - ClientData clientData) /* Old window proc */ + TCL_UNUSED(ClientData)) { Tcl_MutexLock(&serialMutex); initialized = 0; Tcl_MutexUnlock(&serialMutex); } @@ -398,13 +398,17 @@ * Adjusts the block time if needed. * *---------------------------------------------------------------------- */ +#ifdef __cplusplus +#define min(a, b) (((a) < (b)) ? (a) : (b)) +#endif + void SerialSetupProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; int block = 1; int msec = INT_MAX; /* min. found block time */ @@ -455,11 +459,11 @@ *---------------------------------------------------------------------- */ static void SerialCheckProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; SerialEvent *evPtr; int needEvent; @@ -529,11 +533,11 @@ * Queue an event if the serial is signaled for reading or writing. */ if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = Tcl_Alloc(sizeof(SerialEvent)); + evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } @@ -595,18 +599,22 @@ */ static int SerialCloseProc( ClientData instanceData, /* Pointer to SerialInfo structure. */ - Tcl_Interp *interp) /* For error reporting. */ + TCL_UNUSED(Tcl_Interp *), + int flags) { SerialInfo *serialPtr = (SerialInfo *) instanceData; - int errorCode, result = 0; + int errorCode = 0, result = 0; SerialInfo *infoPtr, **nextPtrPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - errorCode = 0; + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { + return EINVAL; + } + if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); } @@ -660,14 +668,14 @@ /* * Wrap the error file into a channel and give it to the cleanup routine. */ if (serialPtr->writeBuf != NULL) { - Tcl_Free(serialPtr->writeBuf); + ckfree(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } - Tcl_Free(serialPtr); + ckfree(serialPtr); if (errorCode == 0) { return result; } return errorCode; @@ -1025,14 +1033,14 @@ /* * Reallocate the buffer to be large enough to hold the data. */ if (infoPtr->writeBuf) { - Tcl_Free(infoPtr->writeBuf); + ckfree(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = Tcl_Alloc(toWrite); + infoPtr->writeBuf = (char *)ckalloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; ResetEvent(infoPtr->evWritable); TclPipeThreadSignal(&infoPtr->writeTI); @@ -1240,11 +1248,11 @@ */ static int SerialGetHandleProc( ClientData instanceData, /* The serial state. */ - int direction, /* TCL_READABLE or TCL_WRITABLE */ + TCL_UNUSED(int) /*direction*/, ClientData *handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; *handlePtr = (ClientData) infoPtr->handle; @@ -1289,11 +1297,11 @@ infoPtr = (SerialInfo *) pipeTI->clientData; buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; - myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); /* * Loop until all of the bytes are written or an error occurs. */ @@ -1401,21 +1409,21 @@ /* * If an open channel is specified, close it */ - if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { + if (handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) { return INVALID_HANDLE_VALUE; } /* * Multithreaded I/O needs the overlapped flag set otherwise * ClearCommError blocks under Windows NT/2000 until serial output is * finished */ - handle = CreateFile(name, access, 0, 0, OPEN_EXISTING, + handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); return handle; } @@ -1445,11 +1453,11 @@ { SerialInfo *infoPtr; SerialInit(); - infoPtr = Tcl_Alloc(sizeof(SerialInfo)); + infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; @@ -1484,19 +1492,19 @@ SetCommTimeouts(handle, &no_timeout); InitializeCriticalSection(&infoPtr->csWrite); if (permissions & TCL_READABLE) { - infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); } if (permissions & TCL_WRITABLE) { /* * Initially the channel is writable and the writeThread is idle. */ - infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); - infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL); + infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL); + infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL); infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread, TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->evWritable), 0, NULL); } @@ -1667,12 +1675,13 @@ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { goto getStateFailed; } - native = Tcl_WinUtfToTChar(value, -1, &ds); - result = BuildCommDCB(native, &dcb); + Tcl_DStringInit(&ds); + native = Tcl_UtfToWCharDString(value, -1, &ds); + result = BuildCommDCBW(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1771,11 +1780,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -xchar: should be a list of" " two elements with each a single 8-bit character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } /* * These dereferences are safe, even in the zero-length string cases, @@ -1802,11 +1811,11 @@ if ((character > 0xFF) || argv[1][charLen]) { goto badXchar; } dcb.XoffChar = (char) character; } - Tcl_Free((void *)argv); + ckfree(argv); if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; } return TCL_OK; @@ -1827,11 +1836,11 @@ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -ttycontrol: should be " "a list of signal,value pairs", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); } - Tcl_Free((void *)argv); + ckfree(argv); return TCL_ERROR; } for (i = 0; i < argc - 1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { @@ -1885,11 +1894,11 @@ result = TCL_ERROR; break; } } - Tcl_Free((void *)argv); + ckfree(argv); return result; } /* * Option -sysbuffer {read_size write_size} @@ -1911,11 +1920,11 @@ outSize = infoPtr->sysBufWrite; } else if (argc == 2) { inSize = atoi(argv[0]); outSize = atoi(argv[1]); } - Tcl_Free((void *)argv); + ckfree(argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad value \"%s\" for -sysbuffer: should be " @@ -2149,11 +2158,11 @@ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); } if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) { - char buf[TCL_UTF_MAX]; + char buf[4]; valid = 1; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { TclWinConvertError(GetLastError()); Index: win/tclWinSock.c ================================================================== --- win/tclWinSock.c +++ win/tclWinSock.c @@ -233,11 +233,11 @@ TcpState *socketList; /* Every open socket in this thread has an * entry on this list. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -static WNDCLASS windowClass; +static WNDCLASSW windowClass; /* * Static routines for this file: */ @@ -278,11 +278,15 @@ */ static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ +#ifndef TCL_NO_DEPRECATED TcpCloseProc, /* Close proc. */ +#else + TCL_CLOSE2PROC, /* Close proc. */ +#endif TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TcpSetOptionProc, /* Set option proc. */ TcpGetOptionProc, /* Get option proc. */ @@ -308,11 +312,11 @@ /* * Simple wrapper round the SendMessage syscall. */ #define SendSelectMessage(tsdPtr, message, payload) \ - SendMessage((tsdPtr)->hwnd, SOCKET_SELECT, \ + SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT, \ (WPARAM) (message), (LPARAM) (payload)) /* * Address print debug functions @@ -358,26 +362,26 @@ */ void InitializeHostName( char **valuePtr, - size_t *lengthPtr, + unsigned int *lengthPtr, Tcl_Encoding *encodingPtr) { - WCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1]; - DWORD length = MAX_COMPUTERNAME_LENGTH + 1; + WCHAR wbuf[256]; + DWORD length = sizeof(wbuf)/sizeof(WCHAR); Tcl_DString ds; - if (GetComputerName(tbuf, &length) != 0) { + Tcl_DStringInit(&ds); + if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ - Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds)); + Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, -1, &ds)); } else { - Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { /* * The buffer size of 256 is recommended by the MSDN page that * documents gethostname() as being always adequate. */ @@ -395,11 +399,11 @@ } } *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = Tcl_Alloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } /* @@ -487,11 +491,11 @@ */ void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Careful! This is a finalizer! */ @@ -499,11 +503,11 @@ return; } if (tsdPtr->socketThread != NULL) { if (tsdPtr->hwnd != NULL) { - PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); + PostMessageW(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0); /* * Wait for the thread to exit. This ensures that we are * completely cleaned up before we leave this function. */ @@ -540,19 +544,18 @@ * Sets the device into blocking or nonblocking mode. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpBlockModeProc( ClientData instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; if (mode == TCL_MODE_NONBLOCKING) { SET_BITS(statePtr->flags, TCP_NONBLOCKING); } else { CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); @@ -644,14 +647,14 @@ * Loop in the blocking case until the connect signal is present */ while (1) { /* - * Get the statePtr lock. - */ + * Get the statePtr lock. + */ - tsdPtr = TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* * Check for connect event. */ @@ -772,23 +775,22 @@ * Reads input from the input device of the channel. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpInputProc( ClientData instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ int *errorCodePtr) /* Where to store error code. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -924,14 +926,14 @@ ClientData instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int written; DWORD error; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; /* * Check that WinSock is initialized; do not call it if not, to prevent @@ -1032,17 +1034,16 @@ * Closes the socket. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpCloseProc( ClientData instanceData, /* The socket to close. */ - Tcl_Interp *interp) /* Unused. */ + TCL_UNUSED(Tcl_Interp *)) { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; /* TIP #218 */ int errorCode = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* @@ -1064,11 +1065,11 @@ statePtr->sockets = thisfd->next; if (closesocket(thisfd->fd) == SOCKET_ERROR) { TclWinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); } - Tcl_Free(thisfd); + ckfree(thisfd); } } if (statePtr->addrlist != NULL) { freeaddrinfo(statePtr->addrlist); @@ -1106,11 +1107,11 @@ * socket list. This is now done by the thread action callbacks, and only * there. This happens before this code is called. We can free without * fear of damaging the list. */ - Tcl_Free(statePtr); + ckfree(statePtr); return errorCode; } /* *---------------------------------------------------------------------- @@ -1133,44 +1134,36 @@ TcpClose2Proc( ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { - TcpState *statePtr = instanceData; - int errorCode = 0; - int sd; + TcpState *statePtr = (TcpState *)instanceData; + int readError = 0; + int writeError = 0; /* * Shutdown the OS socket handle. */ - switch(flags) { - case TCL_CLOSE_READ: - sd = SD_RECEIVE; - break; - case TCL_CLOSE_WRITE: - sd = SD_SEND; - break; - default: - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "socket close2proc called bidirectionally", -1)); - } - return TCL_ERROR; + if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { + return TcpCloseProc(instanceData, interp); } /* * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or * TCL_WRITABLE so this should never be called for a server socket. */ - if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) { + if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { + TclWinConvertError((DWORD) WSAGetLastError()); + readError = Tcl_GetErrno(); + } + if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { TclWinConvertError((DWORD) WSAGetLastError()); - errorCode = Tcl_GetErrno(); + writeError = Tcl_GetErrno(); } - - return errorCode; + return (readError != 0) ? readError : writeError; } /* *---------------------------------------------------------------------- * @@ -1190,15 +1183,17 @@ static int TcpSetOptionProc( ClientData 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. */ + TCL_UNUSED(const char *) /*value*/) /* New value for option. */ { #ifdef TCL_FEATURE_KEEPALIVE_NAGLE TcpState *statePtr = instanceData; SOCKET sock; +#else + (void)instanceData; #endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/ /* * Check that WinSock is initialized; do not call it if not, to prevent * system crashes. This can happen at exit time if the exit handler for @@ -1298,11 +1293,11 @@ * for, or NULL to get all options and their * values. */ Tcl_DString *dsPtr) /* Where to store the computed value; * initialized by caller. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; char host[NI_MAXHOST], port[NI_MAXSERV]; SOCKET sock; size_t len = 0; int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" @@ -1617,11 +1612,11 @@ ClientData instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; /* * Update the watch events mask. Only if the socket is not a server * socket. [Bug 557878] */ @@ -1664,18 +1659,17 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int TcpGetHandleProc( ClientData instanceData, /* The socket state. */ - int direction, /* Not used. */ + TCL_UNUSED(int) /*direction*/, ClientData *handlePtr) /* Where to store the handle. */ { - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; *handlePtr = INT2PTR(statePtr->sockets->fd); return TCL_OK; } @@ -1728,11 +1722,11 @@ * 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 = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (async_callback) { goto reenter; } @@ -2147,11 +2141,11 @@ if (TclpHasSockets(NULL) != TCL_OK) { return NULL; } - tsdPtr = TclThreadDataKeyGet(&dataKey); + tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. */ @@ -2339,11 +2333,11 @@ if (addrlist != NULL) { freeaddrinfo(addrlist); } if (statePtr != NULL) { - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; sprintf(channelName, SOCK_TEMPLATE, statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, @@ -2395,11 +2389,10 @@ * connection acceptance mechanism. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void TcpAccept( TcpFdList *fds, /* Server socket that accepted newSocket. */ SOCKET newSocket, /* Newly accepted socket. */ address addr) /* Address of new socket. */ @@ -2407,11 +2400,11 @@ TcpState *newInfoPtr; TcpState *statePtr = fds->statePtr; int len = sizeof(addr); char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Win-NT has a misfeature that sockets are inherited in child processes * by default. Turn off the inherit bit. */ @@ -2478,11 +2471,11 @@ static void InitSockets(void) { DWORD id; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); if (!initialized) { initialized = 1; TclCreateLateExitHandler(SocketExitHandler, NULL); @@ -2502,11 +2495,11 @@ windowClass.lpszClassName = className; windowClass.lpfnWndProc = SocketProc; windowClass.hIcon = NULL; windowClass.hCursor = NULL; - if (!RegisterClass(&windowClass)) { + if (!RegisterClassW(&windowClass)) { TclWinConvertError(GetLastError()); goto initFailure; } } @@ -2527,15 +2520,15 @@ tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->pendingTcpState = NULL; tsdPtr->socketList = NULL; tsdPtr->hwnd = NULL; tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto initFailure; } - tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL); + tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL); if (tsdPtr->socketListLock == NULL) { goto initFailure; } tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0, &id); @@ -2584,11 +2577,10 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static int SocketsEnabled(void) { int enabled; @@ -2614,24 +2606,23 @@ * None. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void SocketExitHandler( - ClientData clientData) /* Not used. */ + TCL_UNUSED(ClientData)) { Tcl_MutexLock(&socketMutex); /* * Make sure the socket event handling window is cleaned-up for, at * most, this thread. */ TclpFinalizeSockets(); - UnregisterClass(className, TclWinGetTclInstance()); + UnregisterClassW(className, TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } /* @@ -2651,11 +2642,11 @@ *---------------------------------------------------------------------- */ void SocketSetupProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { TcpState *statePtr; Tcl_Time blockTime = { 0, 0 }; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -2696,11 +2687,11 @@ *---------------------------------------------------------------------- */ static void SocketCheckProc( - ClientData data, /* Not used. */ + TCL_UNUSED(ClientData), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { TcpState *statePtr; SocketEvent *evPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -2720,11 +2711,11 @@ statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = Tcl_Alloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); } } @@ -2995,11 +2986,11 @@ if (fds == NULL) { /* * Add the first FD. */ - statePtr->sockets = Tcl_Alloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* * Find end of list and append FD. */ @@ -3006,11 +2997,11 @@ while (fds->next != NULL) { fds = fds->next; } - fds->next = Tcl_Alloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = fds->next; } /* * Populate new FD. @@ -3039,11 +3030,11 @@ */ static TcpState * NewSocketInfo(SOCKET socket) { - TcpState *statePtr = Tcl_Alloc(sizeof(TcpState)); + TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -3082,11 +3073,11 @@ */ int *errorCodePtr) /* Where to store errors? */ { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. */ @@ -3168,17 +3159,17 @@ static DWORD WINAPI SocketThread( LPVOID arg) { MSG msg; - ThreadSpecificData *tsdPtr = arg; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *)arg; /* * Create a dummy window receiving socket events. */ - tsdPtr->hwnd = CreateWindow(className, className, WS_TILED, 0, 0, 0, 0, + tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg); /* * Signalize thread creator that we are done creating the window. */ @@ -3194,15 +3185,15 @@ } /* * Process all messages on the socket window until WM_QUIT. This threads * exits only when instructed to do so by the call to - * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets(). + * PostMessageW(SOCKET_TERMINATE) in TclpFinalizeSockets(). */ - while (GetMessage(&msg, NULL, 0, 0) > 0) { - DispatchMessage(&msg); + while (GetMessageW(&msg, NULL, 0, 0) > 0) { + DispatchMessageW(&msg); } /* * This releases waiters on thread exit in TclpFinalizeSockets() */ @@ -3243,31 +3234,31 @@ TcpState *statePtr; int info_found = 0; TcpFdList *fds = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) #ifdef _WIN64 - GetWindowLongPtr(hwnd, GWLP_USERDATA); + GetWindowLongPtrW(hwnd, GWLP_USERDATA); #else - GetWindowLong(hwnd, GWL_USERDATA); + GetWindowLongW(hwnd, GWL_USERDATA); #endif switch (message) { default: - return DefWindowProc(hwnd, message, wParam, lParam); + return DefWindowProcW(hwnd, message, wParam, lParam); break; case WM_CREATE: /* * Store the initial tsdPtr, it's from a different thread, so it's not * directly accessible, but needed. */ #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, + SetWindowLongPtrW(hwnd, GWLP_USERDATA, (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams); #else - SetWindowLong(hwnd, GWL_USERDATA, + SetWindowLongW(hwnd, GWL_USERDATA, (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams); #endif break; case WM_DESTROY: @@ -3402,10 +3393,72 @@ } /* *---------------------------------------------------------------------- * + * TclWinGetSockOpt, et al. -- + * + * Those functions are historically exported by the stubs table and + * just use the original system calls now. + * + * Warning: + * Those functions are depreciated and will be removed with TCL 9.0. + * + * Results: + * As defined for each function. + * + * Side effects: + * As defined for each function. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +#undef TclWinGetSockOpt +int +TclWinGetSockOpt( + SOCKET s, + int level, + int optname, + char *optval, + int *optlen) +{ + + return getsockopt(s, level, optname, optval, optlen); +} +#undef TclWinSetSockOpt +int +TclWinSetSockOpt( + SOCKET s, + int level, + int optname, + const char *optval, + int optlen) +{ + return setsockopt(s, level, optname, optval, optlen); +} + +#undef TclpInetNtoa +char * +TclpInetNtoa( + struct in_addr addr) +{ + return inet_ntoa(addr); +} +#undef TclWinGetServByName +struct servent * +TclWinGetServByName( + const char *name, + const char *proto) +{ + return getservbyname(name, proto); +} +#endif /* TCL_NO_DEPRECATED */ + +/* + *---------------------------------------------------------------------- + * * TcpThreadActionProc -- * * Insert or remove any thread local refs to this channel. * * Results: @@ -3421,11 +3474,11 @@ TcpThreadActionProc( ClientData instanceData, int action) { ThreadSpecificData *tsdPtr; - TcpState *statePtr = instanceData; + TcpState *statePtr = (TcpState *)instanceData; int notifyCmd; if (action == TCL_CHANNEL_THREAD_INSERT) { /* * Ensure that socket subsystem is initialized in this thread, or else Index: win/tclWinTest.c ================================================================== --- win/tclWinTest.c +++ win/tclWinTest.c @@ -11,10 +11,15 @@ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" +#ifdef TCL_WITH_EXTERNAL_TOMMATH +# include "tommath.h" +#else +# include "tclTomMath.h" +#endif /* * For TestplatformChmod on Windows */ #ifdef _WIN32 @@ -30,23 +35,18 @@ /* * Forward declarations of functions defined later in this file: */ -static int TesteventloopCmd(ClientData dummy, Tcl_Interp* interp, - int objc, Tcl_Obj *const objv[]); -static int TestvolumetypeCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, - int objc, Tcl_Obj *const objv[]); -static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TesteventloopCmd; +static Tcl_ObjCmdProc TestvolumetypeCmd; +static Tcl_ObjCmdProc TestwinclockCmd; +static Tcl_ObjCmdProc TestwinsleepCmd; +static Tcl_ObjCmdProc TestSizeCmd; static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); -static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp, - int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc TestchmodCmd; /* *---------------------------------------------------------------------- * * TclplatformtestInit -- @@ -76,10 +76,11 @@ Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -99,11 +100,11 @@ *---------------------------------------------------------------------- */ static int TesteventloopCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of @@ -134,21 +135,21 @@ done = 0; while (!done) { MSG msg; - if (!GetMessage(&msg, NULL, 0, 0)) { + if (!GetMessageW(&msg, NULL, 0, 0)) { /* * The application is exiting, so repost the quit message and * start unwinding. */ PostQuitMessage((int) msg.wParam); break; } TranslateMessage(&msg); - DispatchMessage(&msg); + DispatchMessageW(&msg); } (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), @@ -175,11 +176,11 @@ *---------------------------------------------------------------------- */ static int TestvolumetypeCmd( - ClientData clientData, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { #define VOL_BUF_SIZE 32 @@ -241,11 +242,11 @@ *---------------------------------------------------------------------- */ static int TestwinclockCmd( - ClientData dummy, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }; @@ -290,11 +291,11 @@ return TCL_OK; } static int TestwinsleepCmd( - ClientData clientData, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int ms; @@ -307,10 +308,36 @@ return TCL_ERROR; } Sleep((DWORD) ms); return TCL_OK; } + +static int +TestSizeCmd( + TCL_UNUSED(ClientData), + 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]), "time_t") == 0) { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t))); + return TCL_OK; + } + 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, "time_t|st_mtime"); + return TCL_ERROR; +} /* *---------------------------------------------------------------------- * * TestExceptionCmd -- @@ -333,11 +360,11 @@ *---------------------------------------------------------------------- */ static int TestExceptionCmd( - ClientData dummy, /* Unused */ + TCL_UNUSED(ClientData), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { static const char *const cmds[] = { @@ -386,11 +413,10 @@ */ /* SMASH! */ RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL); - /* NOTREACHED */ return TCL_OK; } static int TestplatformChmod( @@ -431,11 +457,11 @@ /* * nativePath not found */ - if (attr == 0xffffffff) { + if (attr == 0xFFFFFFFF) { res = -1; goto done; } /* @@ -463,11 +489,11 @@ if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } - secDesc = Tcl_Alloc(secDescLen); + secDesc = (BYTE *)ckalloc(secDescLen); if (!GetFileSecurityA(nativePath, infoBits, (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { goto done; } @@ -475,11 +501,11 @@ /* * Get the World SID. */ - userSid = Tcl_Alloc(GetSidLengthRequired((UCHAR) 1)); + userSid = (SID *)ckalloc(GetSidLengthRequired((UCHAR) 1)); InitializeSid(userSid, &userSidAuthority, (BYTE) 1); *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID; /* * If curAclPresent == false then curAcl and curAclDefaulted not valid. @@ -501,11 +527,11 @@ * Allocate memory for the new ACL. */ newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) + GetLengthSid(userSid) - sizeof(DWORD); - newAcl = Tcl_Alloc(newAclSize); + newAcl = (PACL) ckalloc(newAclSize); /* * Initialize the new ACL. */ @@ -578,20 +604,20 @@ res = 0; } done: if (secDesc) { - Tcl_Free(secDesc); + ckfree(secDesc); } if (newAcl) { - Tcl_Free(newAcl); + ckfree(newAcl); } if (userSid) { - Tcl_Free(userSid); + ckfree(userSid); } if (userDomain) { - Tcl_Free(userDomain); + ckfree(userDomain); } if (res != 0) { return res; } @@ -622,11 +648,11 @@ *--------------------------------------------------------------------------- */ static int TestchmodCmd( - ClientData dummy, /* Not used. */ + TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int i, mode; Index: win/tclWinThrd.c ================================================================== --- win/tclWinThrd.c +++ win/tclWinThrd.c @@ -176,11 +176,11 @@ ); lpOrigStartAddress = winThreadPtr->lpStartAddress; lpOrigParameter = winThreadPtr->lpParameter; - Tcl_Free(winThreadPtr); + ckfree(winThreadPtr); return lpOrigStartAddress(lpOrigParameter); } /* *---------------------------------------------------------------------- @@ -202,18 +202,18 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ ClientData clientData, /* The one argument to Main(). */ - size_t stackSize, /* Size of stack for the new thread. */ + int stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; - winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread)); + winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc; winThreadPtr->lpParameter = clientData; winThreadPtr->fpControl = _controlfp(0, 0); EnterCriticalSection(&joinLock); @@ -566,11 +566,11 @@ /* * Double inside master lock check to avoid a race. */ if (*mutexPtr == NULL) { - csPtr = Tcl_Alloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); } TclpMasterUnlock(); @@ -627,11 +627,11 @@ { CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr; if (csPtr != NULL) { DeleteCriticalSection(csPtr); - Tcl_Free(csPtr); + ckfree(csPtr); *mutexPtr = NULL; } } /* @@ -680,11 +680,11 @@ /* * Create the per-thread event and queue pointers. */ if (tsdPtr->flags == WIN_THREAD_UNINIT) { - tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */, + tsdPtr->condEvent = CreateEventW(NULL, TRUE /* manual reset */, FALSE /* non signaled */, NULL); tsdPtr->nextPtr = NULL; tsdPtr->prevPtr = NULL; tsdPtr->flags = WIN_THREAD_RUNNING; doExit = 1; @@ -709,11 +709,11 @@ /* * Initialize the per-condition queue pointers and Mutex. */ if (*condPtr == NULL) { - winCondPtr = Tcl_Alloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; *condPtr = (Tcl_Condition) winCondPtr; TclRememberCondition(condPtr); @@ -920,11 +920,11 @@ * reclaimed. */ if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - Tcl_Free(winCondPtr); + ckfree(winCondPtr); *condPtr = NULL; } } @@ -938,11 +938,11 @@ Tcl_Mutex * TclpNewAllocMutex(void) { allocMutex *lockPtr; - lockPtr = malloc(sizeof(allocMutex)); + lockPtr = (allocMutex *)malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock; InitializeCriticalSection(&lockPtr->wlock); @@ -1035,11 +1035,11 @@ void * TclpThreadCreateKey(void) { DWORD *key; - key = TclpSysAlloc(sizeof *key); + key = (DWORD *)TclpSysAlloc(sizeof *key, 0); if (key == NULL) { Tcl_Panic("unable to allocate thread key!"); } *key = TlsAlloc(); @@ -1053,11 +1053,11 @@ void TclpThreadDeleteKey( void *keyPtr) { - DWORD *key = keyPtr; + DWORD *key = (DWORD *)keyPtr; if (!TlsFree(*key)) { Tcl_Panic("unable to delete key"); } @@ -1067,11 +1067,11 @@ void TclpThreadSetMasterTSD( void *tsdKeyPtr, void *ptr) { - DWORD *key = tsdKeyPtr; + DWORD *key = (DWORD *)tsdKeyPtr; if (!TlsSetValue(*key, ptr)) { Tcl_Panic("unable to set master TSD value"); } } @@ -1078,11 +1078,11 @@ void * TclpThreadGetMasterTSD( void *tsdKeyPtr) { - DWORD *key = tsdKeyPtr; + DWORD *key = (DWORD *)tsdKeyPtr; return TlsGetValue(*key); } #endif /* TCL_THREADS */ Index: win/tclWinTime.c ================================================================== --- win/tclWinTime.c +++ win/tclWinTime.c @@ -10,16 +10,41 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#define SECSPERDAY (60L * 60L * 24L) +#define SECSPERYEAR (SECSPERDAY * 365L) +#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) + /* * Number of samples over which to estimate the performance counter. */ #define SAMPLES 64 +/* + * The following arrays contain the day of year for the last day of each + * month, where index 1 is January. + */ + +#ifndef TCL_NO_DEPRECATED +static const int normalDays[] = { + -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 +}; + +static const int leapDays[] = { + -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 +}; + +typedef struct { + char tzName[64]; /* Time zone name */ + struct tm tm; /* time information */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; +#endif /* TCL_NO_DEPRECATED */ + /* * Data for managing high-resolution timers. */ typedef struct { @@ -71,11 +96,11 @@ 0, 1, (HANDLE) NULL, (HANDLE) NULL, (HANDLE) NULL, -#ifdef HAVE_CAST_TO_UNION +#if defined(HAVE_CAST_TO_UNION) && !defined(__cplusplus) (LARGE_INTEGER) (Tcl_WideInt) 0, (ULARGE_INTEGER) (DWORDLONG) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, (LARGE_INTEGER) (Tcl_WideInt) 0, @@ -97,17 +122,20 @@ */ static struct { int initialized; /* 1 if initialized, 0 otherwise */ int perfCounter; /* 1 if performance counter usable for wide clicks */ double microsecsScale; /* Denominator scale between clock / microsecs */ -} wideClick = {0, 0.0}; +} wideClick = {0, 0, 0.0}; /* * Declarations for functions defined later in this file. */ +#ifndef TCL_NO_DEPRECATED +static struct tm * ComputeGMT(const time_t *tp); +#endif /* TCL_NO_DEPRECATED */ static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq); @@ -142,11 +170,11 @@ * None. * *---------------------------------------------------------------------- */ -Tcl_WideUInt +unsigned long TclpGetSeconds(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ @@ -168,11 +196,11 @@ * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution * clock available on the system. There are no guarantees on what the * resolution will be. In Tcl we will call this value a "click". The - * start time is also system dependant. + * start time is also system dependent. * * Results: * Number of clicks from some start time. * * Side effects: @@ -179,30 +207,30 @@ * None. * *---------------------------------------------------------------------- */ -Tcl_WideUInt +unsigned long TclpGetClicks(void) { Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { - return (Tcl_WideUInt)usecSincePosixEpoch; + return (unsigned long)usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as * nearly as we can, and return it. */ Tcl_Time now; /* Current Tcl time */ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ - return (Tcl_WideUInt)(now.sec * 1000000) + now.usec; + return (unsigned long)(now.sec * 1000000) + now.usec; } } /* *---------------------------------------------------------------------- @@ -383,12 +411,12 @@ *---------------------------------------------------------------------- */ static void NativeScaleTime( - Tcl_Time *timePtr, - ClientData clientData) + TCL_UNUSED(Tcl_Time *), + TCL_UNUSED(ClientData)) { /* * Native scale is 1:1. Nothing is done. */ } @@ -493,13 +521,13 @@ SYSTEM_INFO systemInfo; int regs[4]; GetSystemInfo(&systemInfo); if (TclWinCPUID(0, regs) == TCL_OK - && regs[1] == 0x756e6547 /* "Genu" */ - && regs[3] == 0x49656e69 /* "ineI" */ - && regs[2] == 0x6c65746e /* "ntel" */ + && regs[1] == 0x756E6547 /* "Genu" */ + && regs[3] == 0x49656E69 /* "ineI" */ + && regs[2] == 0x6C65746E /* "ntel" */ && TclWinCPUID(1, regs) == TCL_OK && ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */ || ((regs[0] & 0x00F00000) /* Extended family */ && (regs[3] & 0x10000000))) /* Hyperthread */ && (((regs[1]&0x00FF0000) >> 16)/* CPU count */ @@ -518,12 +546,12 @@ if (timeInfo.perfCounterAvailable) { DWORD id; InitializeCriticalSection(&timeInfo.cs); - timeInfo.readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL); - timeInfo.exitEvent = CreateEvent(NULL, FALSE, FALSE, NULL); + timeInfo.readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + timeInfo.exitEvent = CreateEventW(NULL, FALSE, FALSE, NULL); timeInfo.calibrationThread = CreateThread(NULL, 256, CalibrationThread, (LPVOID) NULL, 0, &id); SetThreadPriority(timeInfo.calibrationThread, THREAD_PRIORITY_HIGHEST); @@ -619,11 +647,11 @@ */ static void NativeGetTime( Tcl_Time *timePtr, - ClientData clientData) + TCL_UNUSED(ClientData)) { Tcl_WideInt usecSincePosixEpoch; /* * Try to use high resolution timer. @@ -664,11 +692,11 @@ void TclWinResetTimerResolution(void); static void StopCalibration( - ClientData unused) /* Client data is unused */ + TCL_UNUSED(ClientData)) { SetEvent(timeInfo.exitEvent); /* * If Tcl_Finalize was called from DllMain, the calibration thread is in a @@ -678,10 +706,247 @@ WaitForSingleObject(timeInfo.calibrationThread, 100); CloseHandle(timeInfo.exitEvent); CloseHandle(timeInfo.calibrationThread); } +/* + *---------------------------------------------------------------------- + * + * TclpGetDate -- + * + * This function converts between seconds and struct tm. If useGMT is + * true, then the returned date will be in Greenwich Mean Time (GMT). + * Otherwise, it will be in the local time zone. + * + * Results: + * Returns a static tm structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +struct tm * +TclpGetDate( + const time_t *t, + int useGMT) +{ + struct tm *tmPtr; + time_t time; +#if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)) +# define t2 *t /* no need to cripple time to 32-bit */ +#else + time_t t2 = *(__time32_t *)t; +#endif + + if (!useGMT) { +#if defined(_MSC_VER) && (_MSC_VER >= 1900) +# undef timezone /* prevent conflict with timezone() function */ + long timezone = 0; +#endif + + tzset(); + + /* + * If we are in the valid range, let the C run-time library handle it. + * Otherwise we need to fake it. Note that this algorithm ignores + * daylight savings time before the epoch. + */ + + /* + * Hm, Borland's localtime manages to return NULL under certain + * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, + * since 'localtime' isn't supposed to do this, possibly leading to + * crashes. + * + * Patch: We only call this function if we are at least one day into + * the epoch, else we handle it ourselves (like we do for times < 0). + * H. Giese, June 2003 + */ + +#ifdef __BORLANDC__ +#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY +#else +#define LOCALTIME_VALIDITY_BOUNDARY 0 +#endif + + if (t2 >= LOCALTIME_VALIDITY_BOUNDARY) { + return TclpLocaltime(&t2); + } + +#if defined(_MSC_VER) && (_MSC_VER >= 1900) + _get_timezone(&timezone); +#endif + + time = t2 - timezone; + + /* + * If we aren't near to overflowing the long, just add the bias and + * use the normal calculation. Otherwise we will need to adjust the + * result at the end. + */ + + if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { + tmPtr = ComputeGMT(&time); + } else { + tmPtr = ComputeGMT(&t2); + + tzset(); + + /* + * Add the bias directly to the tm structure to avoid overflow. + * Propagate seconds overflow into minutes, hours and days. + */ + + time = tmPtr->tm_sec - timezone; + tmPtr->tm_sec = (int)(time % 60); + if (tmPtr->tm_sec < 0) { + tmPtr->tm_sec += 60; + time -= 60; + } + + time = tmPtr->tm_min + time/60; + tmPtr->tm_min = (int)(time % 60); + if (tmPtr->tm_min < 0) { + tmPtr->tm_min += 60; + time -= 60; + } + + time = tmPtr->tm_hour + time/60; + tmPtr->tm_hour = (int)(time % 24); + if (tmPtr->tm_hour < 0) { + tmPtr->tm_hour += 24; + time -= 24; + } + + time /= 24; + tmPtr->tm_mday += (int)time; + tmPtr->tm_yday += (int)time; + tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; + } + } else { + tmPtr = ComputeGMT(&t2); + } + return tmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ComputeGMT -- + * + * This function computes GMT given the number of seconds since the epoch + * (midnight Jan 1 1970). + * + * Results: + * Returns a (per thread) statically allocated struct tm. + * + * Side effects: + * Updates the values of the static struct tm. + * + *---------------------------------------------------------------------- + */ + +static struct tm * +ComputeGMT( + const time_t *tp) +{ + struct tm *tmPtr; + long tmp, rem; + int isLeap; + const int *days; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tmPtr = &tsdPtr->tm; + + /* + * Compute the 4 year span containing the specified time. + */ + + tmp = (long)(*tp / SECSPER4YEAR); + rem = (long)(*tp % SECSPER4YEAR); + + /* + * Correct for weird mod semantics so the remainder is always positive. + */ + + if (rem < 0) { + tmp--; + rem += SECSPER4YEAR; + } + + /* + * Compute the year after 1900 by taking the 4 year span and adjusting for + * the remainder. This works because 2000 is a leap year, and 1900/2100 + * are out of the range. + */ + + tmp = (tmp * 4) + 70; + isLeap = 0; + if (rem >= SECSPERYEAR) { /* 1971, etc. */ + tmp++; + rem -= SECSPERYEAR; + if (rem >= SECSPERYEAR) { /* 1972, etc. */ + tmp++; + rem -= SECSPERYEAR; + if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ + tmp++; + rem -= SECSPERYEAR + SECSPERDAY; + } else { + isLeap = 1; + } + } + } + tmPtr->tm_year = tmp; + + /* + * Compute the day of year and leave the seconds in the current day in the + * remainder. + */ + + tmPtr->tm_yday = rem / SECSPERDAY; + rem %= SECSPERDAY; + + /* + * Compute the time of day. + */ + + tmPtr->tm_hour = rem / 3600; + rem %= 3600; + tmPtr->tm_min = rem / 60; + tmPtr->tm_sec = rem % 60; + + /* + * Compute the month and day of month. + */ + + days = (isLeap) ? leapDays : normalDays; + for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { + /* empty body */ + } + tmPtr->tm_mon = --tmp; + tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; + + /* + * Compute day of week. Epoch started on a Thursday. + */ + + tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; + if ((*tp % SECSPERDAY) < 0) { + tmPtr->tm_wday--; + } + tmPtr->tm_wday %= 7; + if (tmPtr->tm_wday < 0) { + tmPtr->tm_wday += 7; + } + + return tmPtr; +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * CalibrationThread -- * @@ -706,11 +971,11 @@ *---------------------------------------------------------------------- */ static DWORD WINAPI CalibrationThread( - LPVOID arg) + TCL_UNUSED(LPVOID)) { FILETIME curFileTime; DWORD waitResult; /* @@ -750,11 +1015,10 @@ break; } UpdateTimeEachSecond(); } - /* lint */ return (DWORD) 0; } /* *---------------------------------------------------------------------- @@ -1067,10 +1331,81 @@ return estFreq; } } +/* + *---------------------------------------------------------------------- + * + * TclpGmtime -- + * + * Wrapper around the 'gmtime' library function to make it thread safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes gmtime or gmtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_NO_DEPRECATED +struct tm * +TclpGmtime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * The MS implementation of gmtime is thread safe because it returns the + * time in a block of thread-local storage, and Windows does not provide a + * Posix gmtime_r function. + */ + +#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) + return gmtime(timePtr); +#else + return _gmtime32((const __time32_t *)timePtr); +#endif +} + +/* + *---------------------------------------------------------------------- + * + * TclpLocaltime -- + * + * Wrapper around the 'localtime' library function to make it thread + * safe. + * + * Results: + * Returns a pointer to a 'struct tm' in thread-specific data. + * + * Side effects: + * Invokes localtime or localtime_r as appropriate. + * + *---------------------------------------------------------------------- + */ + +struct tm * +TclpLocaltime( + const time_t *timePtr) /* Pointer to the number of seconds since the + * local system's epoch */ +{ + /* + * The MS implementation of localtime is thread safe because it returns + * the time in a block of thread-local storage, and Windows does not + * provide a Posix localtime_r function. + */ + +#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400) + return localtime(timePtr); +#else + return _localtime32((const __time32_t *)timePtr); +#endif +} +#endif /* TCL_NO_DEPRECATED */ + /* *---------------------------------------------------------------------- * * Tcl_SetTimeProc -- *