summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-02-13 22:06:10 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-02-13 22:06:10 (GMT)
commit8c3eb78cf7bd96819cbf50c6552954c785098f69 (patch)
treeef70c73ff15c99c137682381b9c15c4871fe505c
parent14b5289e4aa4945dd080d1d3d2dad7f54537eec8 (diff)
parent73cc9cd62f844146e1d9a835511da3b641aafac0 (diff)
downloadtcl-8c3eb78cf7bd96819cbf50c6552954c785098f69.zip
tcl-8c3eb78cf7bd96819cbf50c6552954c785098f69.tar.gz
tcl-8c3eb78cf7bd96819cbf50c6552954c785098f69.tar.bz2
Merge 8.7
-rw-r--r--.travis.yml124
-rw-r--r--doc/AddErrInfo.33
-rw-r--r--doc/CrtChannel.34
-rw-r--r--doc/CrtSlave.334
-rw-r--r--doc/Eval.33
-rw-r--r--doc/Panic.313
-rw-r--r--doc/SetResult.32
-rw-r--r--doc/StaticPkg.32
-rw-r--r--doc/StringObj.34
-rw-r--r--doc/Tcl_Main.32
-rw-r--r--doc/TraceVar.333
-rw-r--r--doc/Utf.314
-rw-r--r--doc/lappend.n5
-rw-r--r--doc/lassign.n4
-rw-r--r--doc/lindex.n5
-rw-r--r--doc/linsert.n5
-rw-r--r--doc/list.n6
-rw-r--r--doc/llength.n5
-rw-r--r--doc/lmap.n5
-rw-r--r--doc/lpop.n5
-rw-r--r--doc/lrange.n5
-rw-r--r--doc/lremove.n4
-rw-r--r--doc/lrepeat.n4
-rw-r--r--doc/lreplace.n5
-rw-r--r--doc/lreverse.n5
-rw-r--r--doc/lsearch.n6
-rw-r--r--doc/lset.n5
-rw-r--r--doc/lsort.n5
-rw-r--r--doc/zipfs.32
-rw-r--r--generic/regcustom.h2
-rw-r--r--generic/tcl.decls24
-rw-r--r--generic/tcl.h40
-rw-r--r--generic/tclBasic.c37
-rw-r--r--generic/tclBinary.c4
-rw-r--r--generic/tclCmdIL.c22
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--generic/tclCompCmdsSZ.c1
-rw-r--r--generic/tclDecls.h71
-rw-r--r--generic/tclDisassemble.c2
-rw-r--r--generic/tclEncoding.c14
-rw-r--r--generic/tclExecute.c215
-rw-r--r--generic/tclIO.c104
-rw-r--r--generic/tclIOCmd.c2
-rw-r--r--generic/tclIORTrans.c38
-rw-r--r--generic/tclIOUtil.c4
-rw-r--r--generic/tclInt.decls12
-rw-r--r--generic/tclInt.h12
-rw-r--r--generic/tclIntDecls.h5
-rw-r--r--generic/tclLink.c2
-rw-r--r--generic/tclLoad.c2
-rw-r--r--generic/tclObj.c47
-rw-r--r--generic/tclParse.c2
-rw-r--r--generic/tclResult.c6
-rw-r--r--generic/tclScan.c4
-rw-r--r--generic/tclStrToD.c576
-rw-r--r--generic/tclStringObj.c10
-rw-r--r--generic/tclStubInit.c52
-rw-r--r--generic/tclTestObj.c38
-rw-r--r--generic/tclTrace.c6
-rw-r--r--generic/tclUtf.c32
-rw-r--r--generic/tclZipfs.c40
-rw-r--r--generic/tclZlib.c2
-rw-r--r--library/tcltest/tcltest.tcl2
-rw-r--r--libtommath/tommath_private.h4
-rw-r--r--tests/cmdIL.test17
-rw-r--r--tests/internals.tcl96
-rw-r--r--tests/oo.test4
-rw-r--r--tests/stringObj.test10
-rw-r--r--unix/Makefile.in2
-rwxr-xr-xunix/configure54
-rw-r--r--unix/configure.ac5
-rw-r--r--unix/tcl.m427
-rw-r--r--unix/tcl.pc.in2
-rw-r--r--unix/tclUnixSock.c30
-rw-r--r--unix/tclUnixThrd.c4
-rw-r--r--win/Makefile.in4
-rw-r--r--win/makefile.vc2
-rw-r--r--win/rules.vc15
-rw-r--r--win/tclWinInit.c12
-rw-r--r--win/tclWinSock.c30
80 files changed, 1224 insertions, 847 deletions
diff --git a/.travis.yml b/.travis.yml
index 6dd0e88..236bb2e 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -6,41 +6,34 @@ matrix:
# Testing on Linux with various compilers
- name: "Linux/GCC/Shared"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc
env:
- BUILD_DIR=unix
- - name: "Linux/GCC/Shared: UTF_MAX=6"
+ - name: "Linux/GCC/Shared: UTF_MAX=4"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc
env:
- BUILD_DIR=unix
- - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6
- - name: "Linux/GCC/Shared: UTF_MAX=3"
- os: linux
- dist: xenial
- compiler: gcc
- env:
- - BUILD_DIR=unix
- - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3
+ - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4
- name: "Linux/GCC/Shared: NO_DEPRECATED"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
- name: "Linux/GCC/Static"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
- name: "Linux/GCC/Debug"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc
env:
- BUILD_DIR=unix
@@ -48,7 +41,7 @@ matrix:
# C++ build.
- name: "Linux/G++/Shared"
os: linux
- dist: xenial
+ dist: bionic
compiler: g++
env:
- BUILD_DIR=unix
@@ -56,7 +49,7 @@ matrix:
# Older versions of GCC...
- name: "Linux/GCC 7/Shared"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc-7
addons:
apt:
@@ -68,7 +61,7 @@ matrix:
- BUILD_DIR=unix
- name: "Linux/GCC 6/Shared"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc-6
addons:
apt:
@@ -80,7 +73,7 @@ matrix:
- BUILD_DIR=unix
- name: "Linux/GCC 5/Shared"
os: linux
- dist: xenial
+ dist: bionic
compiler: gcc-5
addons:
apt:
@@ -90,22 +83,10 @@ matrix:
- g++-5
env:
- BUILD_DIR=unix
- - name: "Linux/GCC 4.9/Shared"
- os: linux
- dist: xenial
- compiler: gcc-4.9
- addons:
- apt:
- sources:
- - ubuntu-toolchain-r-test
- packages:
- - g++-4.9
- env:
- - BUILD_DIR=unix
# Clang
- name: "Linux/Clang/Shared"
os: linux
- dist: xenial
+ dist: bionic
compiler: clang
env:
- BUILD_DIR=unix
@@ -118,14 +99,14 @@ matrix:
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
- name: "Linux/Clang/Static"
os: linux
- dist: xenial
+ dist: bionic
compiler: clang
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
- name: "Linux/Clang/Debug"
os: linux
- dist: xenial
+ dist: bionic
compiler: clang
env:
- BUILD_DIR=unix
@@ -150,6 +131,13 @@ matrix:
homebrew:
packages:
- libtommath
+ - name: "macOS/Xcode 11/Shared"
+ os: osx
+ osx_image: xcode11
+ env:
+ - BUILD_DIR=macosx
+ install: []
+ script: *mactest
- name: "macOS/Xcode 10/Shared"
os: osx
osx_image: xcode10.3
@@ -187,7 +175,7 @@ matrix:
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows/GCC/Shared/no test"
os: linux
- dist: xenial
+ dist: bionic
compiler: x86_64-w64-mingw32-gcc
addons:
apt:
@@ -208,7 +196,7 @@ matrix:
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows-32/GCC/Shared/no test"
os: linux
- dist: xenial
+ dist: bionic
compiler: i686-w64-mingw32-gcc
addons:
apt:
@@ -234,17 +222,17 @@ matrix:
- 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=6"
+ - 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'
+ - 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
@@ -252,8 +240,8 @@ matrix:
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'
+ - 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
@@ -261,8 +249,8 @@ matrix:
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'
+ - 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
@@ -270,8 +258,8 @@ matrix:
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'
+ - 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
# Test on Windows with MSVC native (32-bit)
- name: "Windows/MSVC-x86/Shared"
os: windows
@@ -280,17 +268,17 @@ matrix:
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=6"
+ - 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'
+ - 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
@@ -298,8 +286,8 @@ matrix:
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'
+ - 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
@@ -307,8 +295,8 @@ matrix:
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'
+ - 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
@@ -316,8 +304,8 @@ matrix:
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'
+ - 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
# Test on Windows with GCC native
- name: "Windows/GCC/Shared"
os: windows
@@ -328,19 +316,12 @@ matrix:
before_install: &makepreinst
- choco install -y make zip
- cd ${BUILD_DIR}
- - name: "Windows/GCC/Shared: UTF_MAX=6"
+ - name: "Windows/GCC/Shared: UTF_MAX=4"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
- before_install: *makepreinst
- - name: "Windows/GCC/Shared: UTF_MAX=3"
- os: windows
- compiler: gcc
- env:
- - BUILD_DIR=win
- - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
+ - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4"
before_install: *makepreinst
- name: "Windows/GCC/Shared: NO_DEPRECATED"
os: windows
@@ -379,19 +360,12 @@ matrix:
env:
- BUILD_DIR=win
before_install: *makepreinst
- - name: "Windows/GCC-x86/Shared: UTF_MAX=6"
- os: windows
- compiler: gcc
- env:
- - BUILD_DIR=win
- - CFGOPT="CFLAGS=-DTCL_UTF_MAX=6"
- before_install: *makepreinst
- - name: "Windows/GCC-x86/Shared: UTF_MAX=3"
+ - name: "Windows/GCC-x86/Shared: UTF_MAX=4"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
+ - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4"
before_install: *makepreinst
- name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
os: windows
diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3
index 0b59349..5b0fe5a 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -247,6 +247,9 @@ record instead of a value. Otherwise, it is similar to
.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
diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3
index 6ef94b5..929b1b8 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -648,8 +648,8 @@ It should call \fBTcl_BadChannelOption\fR which itself returns
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
diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3
index ac681bc..b8ac421 100644
--- a/doc/CrtSlave.3
+++ b/doc/CrtSlave.3
@@ -119,7 +119,7 @@ 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
@@ -158,12 +158,12 @@ If no such slave interpreter exists, \fBNULL\fR is returned.
\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
@@ -198,33 +198,33 @@ 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.
diff --git a/doc/Eval.3 b/doc/Eval.3
index f7c6976..1abe6f2 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -156,7 +156,8 @@ 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. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.
+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
diff --git a/doc/Panic.3 b/doc/Panic.3
index ba39ddf..53b84da 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -53,13 +53,13 @@ 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)
@@ -86,6 +86,9 @@ 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
@@ -93,11 +96,9 @@ have a panic message displayed the same way that panic messages from Tcl
will be displayed.
.PP
\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. This
+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
-This function 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"
abort(3), printf(3), exec(n), format(n)
.SH KEYWORDS
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index a640956..1622290 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -145,6 +145,8 @@ call; the last argument in the list must be a NULL pointer.
.PP
\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
diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3
index 8d04cd1..b22edcc 100644
--- a/doc/StaticPkg.3
+++ b/doc/StaticPkg.3
@@ -65,7 +65,7 @@ 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. Its symbol
+\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
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index 12fc413..2b665cc 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -249,7 +249,9 @@ 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.
+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.
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index 816dfeb..dc4f45f 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -190,7 +190,7 @@ procedure (if any) returns. In non-interactive mode, after
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)
diff --git a/doc/TraceVar.3 b/doc/TraceVar.3
index c3edfa4..82aa7b8 100644
--- a/doc/TraceVar.3
+++ b/doc/TraceVar.3
@@ -5,7 +5,7 @@
'\" 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
@@ -95,7 +95,7 @@ Invoke \fIproc\fR whenever an attempt is made to modify the variable.
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
@@ -160,10 +160,6 @@ 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
@@ -330,6 +326,15 @@ 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
@@ -354,24 +359,8 @@ 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"
diff --git a/doc/Utf.3 b/doc/Utf.3
index 9b0ec3c..09e6420 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_WCharToUtfDString, Tcl_UtfToWCharDString, Tcl_Char16ToUtfDString, 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
+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 <tcl.h>\fR
@@ -120,6 +120,12 @@ A null-terminated Unicode string.
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
negative, all bytes up to the first null byte are used.
@@ -148,11 +154,11 @@ case-insensitive (1).
.PP
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 \fBTCL_UTF_MAX\fR bytes. A multibyte UTF-8 sequence
+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
diff --git a/doc/lappend.n b/doc/lappend.n
index 66bea5f..89b6909 100644
--- a/doc/lappend.n
+++ b/doc/lappend.n
@@ -49,8 +49,9 @@ Using \fBlappend\fR to build up a list of numbers.
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:
diff --git a/doc/lassign.n b/doc/lassign.n
index 5620de6..67048ba 100644
--- a/doc/lassign.n
+++ b/doc/lassign.n
@@ -52,7 +52,9 @@ command in many shell languages like this:
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:
diff --git a/doc/lindex.n b/doc/lindex.n
index be4f169..01e0d8b 100644
--- a/doc/lindex.n
+++ b/doc/lindex.n
@@ -115,8 +115,9 @@ set idx 3
\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
diff --git a/doc/linsert.n b/doc/linsert.n
index 91db726..3179256 100644
--- a/doc/linsert.n
+++ b/doc/linsert.n
@@ -45,8 +45,9 @@ set newList [\fBlinsert\fR $midList end-1 lazy]
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
diff --git a/doc/list.n b/doc/list.n
index a182fc8..3fa1975 100644
--- a/doc/list.n
+++ b/doc/list.n
@@ -46,9 +46,9 @@ while \fBconcat\fR with the same arguments will return
\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:
diff --git a/doc/llength.n b/doc/llength.n
index 7e46064..26824a0 100644
--- a/doc/llength.n
+++ b/doc/llength.n
@@ -49,8 +49,9 @@ An empty list is not necessarily an empty string:
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:
diff --git a/doc/lmap.n b/doc/lmap.n
index 1a7858d..026e9d0 100644
--- a/doc/lmap.n
+++ b/doc/lmap.n
@@ -77,7 +77,10 @@ set prefix [\fBlmap\fR x $values {expr {
# 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:
diff --git a/doc/lpop.n b/doc/lpop.n
index 0ce8ff8..631bc58 100644
--- a/doc/lpop.n
+++ b/doc/lpop.n
@@ -86,8 +86,9 @@ The indicated value becomes the new value of \fIx\fR.
\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
diff --git a/doc/lrange.n b/doc/lrange.n
index a4fd98b..0d4b261 100644
--- a/doc/lrange.n
+++ b/doc/lrange.n
@@ -71,8 +71,9 @@ elements to
{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
diff --git a/doc/lremove.n b/doc/lremove.n
index b947863..59d261b 100644
--- a/doc/lremove.n
+++ b/doc/lremove.n
@@ -46,7 +46,9 @@ Removing the same element indicated in two different ways:
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:
diff --git a/doc/lrepeat.n b/doc/lrepeat.n
index 4719bfd..2e17f9c 100644
--- a/doc/lrepeat.n
+++ b/doc/lrepeat.n
@@ -32,7 +32,9 @@ is identical to \fBlist element ...\fR.
\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:
diff --git a/doc/lreplace.n b/doc/lreplace.n
index 68cddfe..bc9d7ca 100644
--- a/doc/lreplace.n
+++ b/doc/lreplace.n
@@ -95,8 +95,9 @@ 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
diff --git a/doc/lreverse.n b/doc/lreverse.n
index 4c2f762..2ed496a 100644
--- a/doc/lreverse.n
+++ b/doc/lreverse.n
@@ -25,8 +25,9 @@ input list, \fIlist\fR, except with the elements in the reverse order.
\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:
diff --git a/doc/lsearch.n b/doc/lsearch.n
index 9172d96..f38afc9 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -227,8 +227,10 @@ The same thing for a flattened list:
\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,
diff --git a/doc/lset.n b/doc/lset.n
index e425274..afc721f 100644
--- a/doc/lset.n
+++ b/doc/lset.n
@@ -136,8 +136,9 @@ The indicated return value also becomes the new value of \fIx\fR.
\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
diff --git a/doc/lsort.n b/doc/lsort.n
index 17a921a..2018e30 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -264,8 +264,9 @@ More complex sorting using a comparison function:
{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:
diff --git a/doc/zipfs.3 b/doc/zipfs.3
index 23b9a93..348557f 100644
--- a/doc/zipfs.3
+++ b/doc/zipfs.3
@@ -83,7 +83,7 @@ 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
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 4396399..a6c19a3 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -88,7 +88,7 @@ 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 */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 528938d..928f8d3 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -523,7 +523,7 @@ declare 145 {
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 {
@@ -1244,10 +1244,10 @@ declare 350 {
declare 351 {
int Tcl_UniCharIsWordChar(int ch)
}
-declare 352 {
+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,
unsigned long numChars)
}
@@ -1356,7 +1356,7 @@ declare 382 {deprecated {No longer in use, changed to macro}} {
declare 383 {
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,
int length)
}
@@ -1482,11 +1482,11 @@ declare 417 {
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,
unsigned long numChars)
}
-declare 420 {
+declare 420 {deprecated {Use Tcl_StringCaseMatch}} {
int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase)
}
@@ -2009,19 +2009,19 @@ declare 554 {
# 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
@@ -2050,7 +2050,7 @@ declare 565 {
# 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
diff --git a/generic/tcl.h b/generic/tcl.h
index b1b1527..9768778 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1031,7 +1031,11 @@ typedef struct Tcl_DString {
#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
@@ -2106,16 +2110,15 @@ typedef struct Tcl_EncodingType {
/*
* 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,
+ * 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 (UCS-2) (the default). If > 3,
* 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.
+ * is the default and recommended mode.
*/
#ifndef TCL_UTF_MAX
-#define TCL_UTF_MAX 4
+#define TCL_UTF_MAX 3
#endif
/*
@@ -2123,15 +2126,11 @@ typedef struct Tcl_EncodingType {
* reflected in regcustom.h.
*/
-#if TCL_UTF_MAX > 4
+#if TCL_UTF_MAX > 3
/*
* 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.
+ * (perhaps wchar_t). ILP64/SILP64 systems may have troubles. The
+ * size of this value must be reflected correctly in regcustom.h.
*/
typedef int Tcl_UniChar;
#else
@@ -2168,9 +2167,16 @@ typedef struct Tcl_Config {
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 <tommath.h> or including <tommath.h> here. But the libtommath project
+ * didn't honor our request. See: <https://github.com/libtom/libtommath/pull/473>
+ *
+ * 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 *).
*/
#ifndef MP_INT_DECLARED
@@ -2178,6 +2184,8 @@ typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData);
typedef struct mp_int mp_int;
#endif
+#endif
+
/*
*----------------------------------------------------------------------------
* Definitions needed for Tcl_ParseArgvObj routines.
@@ -2311,10 +2319,10 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
/*
*----------------------------------------------------------------------------
* 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) 0xFCA3BACF + (TCL_UTF_MAX>4))
+#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
/*
* The following function is required to be defined in all stubs aware
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0eca69d..034acde 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -7687,10 +7687,16 @@ ExprIsqrtFunc(
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;
@@ -7737,10 +7743,17 @@ ExprSqrtFunc(
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 {
@@ -7907,7 +7920,9 @@ ExprAbsFunc(
}
goto unChanged;
} else if (l == WIDE_MIN) {
- mp_init_i64(&big, l);
+ if (mp_init_i64(&big, l) != MP_OKAY) {
+ return TCL_ERROR;
+ }
goto tooLarge;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
@@ -7938,7 +7953,9 @@ ExprAbsFunc(
if (mp_isneg((const mp_int *) ptr)) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
- (void)mp_neg(&big, &big);
+ if (mp_neg(&big, &big) != MP_OKAY) {
+ return TCL_ERROR;
+ }
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
} else {
unChanged:
@@ -8283,15 +8300,19 @@ ExprRoundFunc(
}
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;
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index c3793ed..d269fbe 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1367,7 +1367,7 @@ BinaryFormatCmd(
badField:
{
Tcl_UniChar ch = 0;
- char buf[TCL_UTF_MAX + 1] = "";
+ char buf[5] = "";
TclUtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
@@ -1737,7 +1737,7 @@ BinaryScanCmd(
badField:
{
Tcl_UniChar ch = 0;
- char buf[TCL_UTF_MAX + 1] = "";
+ char buf[5] = "";
TclUtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index a2858fa..44bec4b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -4032,9 +4032,11 @@ Tcl_LsortObjCmd(
int sortMode = SORTMODE_ASCII;
int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
+ size_t elmArrSize;
SortElement *elementArray = NULL, *elementPtr;
SortInfo sortInfo; /* Information about this sort that needs to
* be passed to the comparison function. */
+# define MAXCALLOC 1024000
# define NUM_LISTS 30
SortElement *subList[NUM_LISTS+1];
/* This array holds pointers to temporary
@@ -4358,7 +4360,19 @@ Tcl_LsortObjCmd(
* begins sorting it into the sublists as it appears.
*/
- elementArray = (SortElement *)ckalloc(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;
@@ -4491,7 +4505,11 @@ Tcl_LsortObjCmd(
TclStackFree(interp, sortInfo.indexv);
}
if (elementArray) {
- ckfree(elementArray);
+ if (elmArrSize <= MAXCALLOC) {
+ ckfree((char *)elementArray);
+ } else {
+ free((char *)elementArray);
+ }
}
return sortInfo.resultCode;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 56efe7b..136eecb 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1228,7 +1228,7 @@ Tcl_SplitObjCmd(
len = TclUtfToUniChar(stringPtr, &ch);
fullchar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(stringPtr + len, &ch);
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
@@ -1923,7 +1923,7 @@ StringIsCmd(
int fullchar;
length2 = TclUtfToUniChar(string1, &ch);
fullchar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (length2 < 3)) {
length2 += TclUtfToUniChar(string1 + length2, &ch);
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index b9ef056..ac8ca48 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -701,6 +701,7 @@ TclCompileStringIsCmd(
OP( LNOT);
return TCL_OK;
}
+ break;
case STR_IS_DOUBLE: {
int satisfied, isEmpty;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 38673cd..3387164 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -478,7 +478,8 @@ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
/* 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,
@@ -1063,9 +1064,11 @@ EXTERN int Tcl_UniCharIsUpper(int ch);
/* 351 */
EXTERN int Tcl_UniCharIsWordChar(int ch);
/* 352 */
-EXTERN int 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,
+TCL_DEPRECATED("Use Tcl_UtfNcmp")
+int Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
const Tcl_UniChar *uct,
unsigned long numChars);
/* 354 */
@@ -1156,7 +1159,8 @@ Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */
-EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
+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,
@@ -1250,11 +1254,13 @@ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
EXTERN int Tcl_IsChannelExisting(const char *channelName);
/* 419 */
-EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
+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);
/* 421 */
EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
@@ -1644,18 +1650,18 @@ EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
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);
@@ -1674,7 +1680,7 @@ EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
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);
@@ -2087,7 +2093,7 @@ typedef struct TclStubs {
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 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
@@ -2300,8 +2306,8 @@ typedef struct TclStubs {
int (*tcl_UniCharIsSpace) (int ch); /* 349 */
int (*tcl_UniCharIsUpper) (int ch); /* 350 */
int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
- int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
- int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
+ 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 */
@@ -2332,7 +2338,7 @@ typedef struct TclStubs {
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 */
- void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
+ 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 */
@@ -2367,8 +2373,8 @@ typedef struct TclStubs {
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, unsigned long numChars); /* 419 */
- int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
+ 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 */
@@ -2503,18 +2509,18 @@ typedef struct TclStubs {
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 */
@@ -4009,7 +4015,22 @@ extern const TclStubs *tclStubsPtr;
#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) \
@@ -4109,7 +4130,7 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_StringMatch
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
# undef Tcl_UniCharToUtfDString
# define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
# undef Tcl_UtfToUniCharDString
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 548534f..83642f0 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -901,7 +901,7 @@ PrintSourceToObj(
i += 2;
continue;
default:
-#if TCL_UTF_MAX > 4
+#if TCL_UTF_MAX > 3
if (ch > 0xffff) {
Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
i += 10;
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 0f5337e..c888962 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2621,7 +2621,7 @@ UtfToUtf16Proc(
*/
if (clientData) {
-#if TCL_UTF_MAX > 4
+#if TCL_UTF_MAX > 3
if (*chPtr <= 0xFFFF) {
*dst++ = (*chPtr & 0xFF);
*dst++ = (*chPtr >> 8);
@@ -2636,7 +2636,7 @@ UtfToUtf16Proc(
*dst++ = (*chPtr >> 8);
#endif
} else {
-#if TCL_UTF_MAX > 4
+#if TCL_UTF_MAX > 3
if (*chPtr <= 0xFFFF) {
*dst++ = (*chPtr >> 8);
*dst++ = (*chPtr & 0xFF);
@@ -2703,7 +2703,7 @@ UtfToUcs2Proc(
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
int len;
#endif
Tcl_UniChar ch = 0;
@@ -2734,7 +2734,7 @@ UtfToUcs2Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
src += (len = TclUtfToUniChar(src, &ch));
if ((ch >= 0xD800) && (len < 3)) {
src += TclUtfToUniChar(src, &ch);
@@ -2960,7 +2960,7 @@ TableFromUtfProc(
}
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]
@@ -3173,7 +3173,7 @@ Iso88591FromUtfProc(
*/
if (ch > 0xff
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
|| ((ch >= 0xD800) && (len < 3))
#endif
) {
@@ -3181,7 +3181,7 @@ Iso88591FromUtfProc(
result = TCL_CONVERT_UNKNOWN;
break;
}
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) len = 4;
#endif
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f7f6c87..e757230 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -317,12 +317,16 @@ VarHashCreateVar(
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); \
@@ -330,6 +334,7 @@ VarHashCreateVar(
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_F(0, (cleanup), 1); \
+ break; \
} \
} while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
@@ -338,12 +343,16 @@ VarHashCreateVar(
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); \
@@ -351,6 +360,7 @@ VarHashCreateVar(
objResultPtr = TCONST((condition) > 0); \
} \
NEXT_INST_V(0, (cleanup), 1); \
+ break; \
} \
} while (0)
#else /* TCL_COMPILE_DEBUG */
@@ -652,6 +662,7 @@ static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
#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:
@@ -1797,6 +1808,7 @@ TclIncrObj(
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");
@@ -1855,8 +1867,11 @@ TclIncrObj(
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;
}
@@ -2577,23 +2592,27 @@ TEBCresume(
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;
@@ -2624,6 +2643,7 @@ TEBCresume(
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
+ break;
case INST_CONCAT_STK:
/*
@@ -2635,6 +2655,7 @@ TEBCresume(
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:
/*
@@ -2656,6 +2677,7 @@ TEBCresume(
PUSH_TAUX_OBJ(objPtr);
TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
NEXT_INST_F(1, 0, 0);
+ break;
case INST_EXPAND_DROP:
/*
@@ -2782,6 +2804,7 @@ TEBCresume(
TclNewObj(objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_INVOKE_STK4:
objc = TclGetUInt4AtPtr(pc+1);
@@ -4263,6 +4286,7 @@ TEBCresume(
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);
@@ -4432,6 +4456,7 @@ TEBCresume(
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;
@@ -5663,7 +5688,6 @@ TEBCresume(
JUMP_PEEPHOLE_F(match, 2, 2);
}
- break;
/*
* End of string-related instructions.
@@ -6093,6 +6117,7 @@ TEBCresume(
TclSetIntObj(valuePtr, wResult);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
+ break;
case INST_DIV:
if (w2 == 0) {
@@ -6150,6 +6175,9 @@ TEBCresume(
} 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);
@@ -6232,6 +6260,7 @@ TEBCresume(
/* -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) {
@@ -6357,6 +6386,7 @@ TEBCresume(
}
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_BREAK:
/*
@@ -6752,6 +6782,7 @@ TEBCresume(
TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
(int) CURR_DEPTH));
NEXT_INST_F(5, 0, 0);
+ break;
case INST_END_CATCH:
catchTop--;
@@ -6761,6 +6792,7 @@ TEBCresume(
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);
@@ -6774,11 +6806,13 @@ TEBCresume(
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();
@@ -6786,6 +6820,7 @@ TEBCresume(
CACHE_STACK_INFO();
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
+ break;
case INST_RETURN_CODE_BRANCH: {
int code;
@@ -6825,6 +6860,7 @@ TEBCresume(
}
TRACE_APPEND(("OK\n"));
NEXT_INST_F(1, 1, 0);
+ break;
case INST_DICT_EXISTS: {
int found;
@@ -7594,6 +7630,13 @@ TEBCresume(
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".
@@ -8033,6 +8076,7 @@ ExecuteExtendedBinaryMathOp(
Tcl_Obj *objResultPtr;
int invalid, zero;
long shift;
+ mp_err err;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
@@ -8094,9 +8138,14 @@ ExecuteExtendedBinaryMathOp(
* Arguments are opposite sign; remainder is sum.
*/
- mp_init_i64(&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);
}
@@ -8109,21 +8158,27 @@ ExecuteExtendedBinaryMathOp(
}
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:
@@ -8249,11 +8304,16 @@ ExecuteExtendedBinaryMathOp(
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);
@@ -8266,20 +8326,25 @@ ExecuteExtendedBinaryMathOp(
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- mp_init(&bigResult);
+ err = mp_init(&bigResult);
- switch (opcode) {
- case INST_BITAND:
- mp_and(&big1, &big2, &bigResult);
- break;
+ if (err == MP_OKAY) {
+ switch (opcode) {
+ case INST_BITAND:
+ err = mp_and(&big1, &big2, &bigResult);
+ break;
- case INST_BITOR:
- mp_or(&big1, &big2, &bigResult);
- break;
+ case INST_BITOR:
+ err = mp_or(&big1, &big2, &bigResult);
+ break;
- case INST_BITXOR:
- mp_xor(&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);
@@ -8342,8 +8407,8 @@ ExecuteExtendedBinaryMathOp(
} else {
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
negativeExponent = mp_isneg(&big2);
- mp_mod_2d(&big2, 1, &big2);
- oddExponent = big2.used != 0;
+ err = mp_mod_2d(&big2, 1, &big2);
+ oddExponent = (err == MP_OKAY) && !mp_iszero(&big2);
mp_clear(&big2);
}
@@ -8500,8 +8565,13 @@ ExecuteExtendedBinaryMathOp(
return GENERAL_ARITHMETIC_ERROR;
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
- mp_init(&bigResult);
- mp_expt_u32(&big1, (unsigned int)w2, &bigResult);
+ 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);
}
@@ -8648,38 +8718,44 @@ ExecuteExtendedBinaryMathOp(
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.
- */
+ 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.
+ */
- mp_sub_d(&bigResult, 1, &bigResult);
- mp_add(&bigRemainder, &big2, &bigRemainder);
+ err = mp_sub_d(&bigResult, 1, &bigResult);
+ if (err == MP_OKAY) {
+ err = mp_add(&bigRemainder, &big2, &bigRemainder);
+ }
+ }
+ mp_clear(&bigRemainder);
+ break;
}
- mp_clear(&bigRemainder);
- break;
}
mp_clear(&big1);
mp_clear(&big2);
@@ -8700,6 +8776,7 @@ ExecuteExtendedUnaryMathOp(
Tcl_WideInt w;
mp_int big;
Tcl_Obj *objResultPtr;
+ mp_err err = MP_OKAY;
(void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
@@ -8711,8 +8788,13 @@ ExecuteExtendedUnaryMathOp(
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
/* ~a = - a - 1 */
- (void)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) {
@@ -8723,12 +8805,18 @@ ExecuteExtendedUnaryMathOp(
if (w != WIDE_MIN) {
WIDE_RESULT(-w);
}
- mp_init_i64(&big, w);
+ err = mp_init_i64(&big, w);
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
break;
default:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
}
- (void)mp_neg(&big, &big);
+ err = mp_neg(&big, &big);
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
BIG_RESULT(&big);
}
@@ -8824,6 +8912,7 @@ TclCompareTwoNumbers(
mp_clear(&big2);
return compare;
}
+ break;
case TCL_NUMBER_DOUBLE:
d1 = *((const double *)ptr1);
@@ -8870,6 +8959,7 @@ TclCompareTwoNumbers(
Tcl_InitBignumFromDouble(NULL, d1, &big1);
goto bigCompare;
}
+ break;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
@@ -8906,10 +8996,11 @@ TclCompareTwoNumbers(
mp_clear(&big2);
return compare;
}
+ break;
default:
Tcl_Panic("unexpected number type");
- return TCL_ERROR;
}
+ return TCL_ERROR;
}
#ifdef TCL_COMPILE_DEBUG
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2e5d43c..4b53fc4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -204,8 +204,6 @@ static Tcl_Encoding GetBinaryEncoding();
static void FreeBinaryEncoding(ClientData clientData);
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,
@@ -492,9 +490,8 @@ ChanSeek(
* type and non-NULL.
*/
- if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
- chanPtr->typePtr->wideSeekProc != NULL) {
- return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
+ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) {
+ return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
offset, mode, errnoPtr);
}
@@ -503,7 +500,7 @@ ChanSeek(
return -1;
}
- return chanPtr->typePtr->seekProc(chanPtr->instanceData,
+ return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
offset, mode, errnoPtr);
}
@@ -4216,7 +4213,7 @@ WillWrite(
{
int inputBuffered;
- if ((chanPtr->typePtr->seekProc != NULL) &&
+ if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) &&
((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
int ignore;
@@ -4238,7 +4235,7 @@ WillRead(
Tcl_SetErrno(EINVAL);
return -1;
}
- if ((chanPtr->typePtr->seekProc != NULL)
+ if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
/*
* CAVEAT - The assumption here is that FlushChannel() will push out
@@ -4720,7 +4717,7 @@ Tcl_GetsObj(
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--;
@@ -6284,7 +6281,7 @@ ReadChars(
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) {
@@ -6999,7 +6996,7 @@ Tcl_Seek(
* defined. This means that the channel does not support seeking.
*/
- if (chanPtr->typePtr->seekProc == NULL) {
+ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) {
Tcl_SetErrno(EINVAL);
return -1;
}
@@ -7163,7 +7160,7 @@ Tcl_Tell(
* defined. This means that the channel does not support seeking.
*/
- if (chanPtr->typePtr->seekProc == NULL) {
+ if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) {
Tcl_SetErrno(EINVAL);
return -1;
}
@@ -10502,49 +10499,15 @@ 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 {
+ if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2)
+ || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) {
/*
* In <v2 channel versions, the version field is occupied by the
* Tcl_DriverBlockModeProc
*/
-
return TCL_CHANNEL_VERSION_1;
}
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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));
+ return chanTypePtr->version;
}
/*
@@ -10567,15 +10530,14 @@ Tcl_ChannelBlockModeProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
- return chanTypePtr->blockModeProc;
+ if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
+ /*
+ * The v1 structure had the blockModeProc in a different place.
+ */
+ return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
}
- /*
- * The v1 structure had the blockModeProc in a different place.
- */
-
- return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
+ return chanTypePtr->blockModeProc;
}
/*
@@ -10815,10 +10777,10 @@ Tcl_ChannelFlushProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
- return chanTypePtr->flushProc;
+ if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
+ return NULL;
}
- return NULL;
+ return chanTypePtr->flushProc;
}
/*
@@ -10842,10 +10804,10 @@ Tcl_ChannelHandlerProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
- return chanTypePtr->handlerProc;
+ if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
+ return NULL;
}
- return NULL;
+ return chanTypePtr->handlerProc;
}
/*
@@ -10869,10 +10831,10 @@ Tcl_ChannelWideSeekProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
- return chanTypePtr->wideSeekProc;
+ if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) {
+ return NULL;
}
- return NULL;
+ return chanTypePtr->wideSeekProc;
}
/*
@@ -10897,10 +10859,10 @@ Tcl_ChannelThreadActionProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
- return chanTypePtr->threadActionProc;
+ if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) {
+ return NULL;
}
- return NULL;
+ return chanTypePtr->threadActionProc;
}
/*
@@ -11212,10 +11174,10 @@ 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;
}
/*
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index a4ccde3..70206be 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -719,7 +719,7 @@ Tcl_CloseObjCmd(
/*
* 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.
*/
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 7ec7a56..5ef409e 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -27,10 +27,6 @@
#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.
*/
@@ -1388,15 +1384,14 @@ ReflectSeekWide(
* non-NULL...
*/
- if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
- parent->typePtr->wideSeekProc != NULL) {
- curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
+ if (Tcl_ChannelWideSeekProc(parent->typePtr) != NULL) {
+ curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
seekMode, errorCodePtr);
} else if (offset < LONG_MIN || offset > LONG_MAX) {
*errorCodePtr = EOVERFLOW;
curPos = -1;
} else {
- curPos = parent->typePtr->seekProc(
+ curPos = Tcl_ChannelSeekProc(parent->typePtr)(
parent->instanceData, offset, seekMode,
errorCodePtr);
}
@@ -3395,33 +3390,6 @@ TransformLimit(
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
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 4eed34c..6179637 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -170,7 +170,7 @@ const Tcl_Filesystem tclNativeFilesystem = {
TclpObjCopyDirectory,
TclpObjLstat,
/* Needs casts since we're using version_2. */
- (Tcl_FSLoadFileProc *) TclpDlopen,
+ (Tcl_FSLoadFileProc *)(void *) TclpDlopen,
(Tcl_FSGetCwdProc *) TclpGetNativeCwd,
TclpObjChdir
};
@@ -3181,7 +3181,7 @@ Tcl_LoadFile(
}
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) {
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 556da28..ec6b77f 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -380,7 +380,7 @@ declare 93 {
}
# Removed in 8.5:
#declare 94 {
-# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
+# int TclProcInterpProc(void *clientData, Tcl_Interp *interp,
# int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
@@ -553,7 +553,7 @@ declare 138 {
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_PackageInitProc **proc1Ptr,
-# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
+# Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
# int TclLooksLikeInt(const char *bytes, int length)
@@ -608,11 +608,11 @@ declare 153 {
# moved to tclTest.c (static) in 8.3.2/8.4a2
#declare 154 {
-# int TclTestChannelCmd(ClientData clientData,
+# int TclTestChannelCmd(void *clientData,
# Tcl_Interp *interp, int argc, char **argv)
#}
#declare 155 {
-# int TclTestChannelEventCmd(ClientData clientData,
+# int TclTestChannelEventCmd(void *clientData,
# Tcl_Interp *interp, int argc, char **argv)
#}
@@ -1034,6 +1034,10 @@ declare 258 {
Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj)
}
+
+declare 259 {
+ void TclUnusedStubEntry(void)
+}
##############################################################################
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 86b2685..6704789 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2914,11 +2914,11 @@ 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,
int strLen, const unsigned char *pattern,
int ptnLen, int flags);
-MODULE_SCOPE double TclCeil(const mp_int *a);
+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,
@@ -3001,7 +3001,7 @@ 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);
@@ -3058,8 +3058,6 @@ MODULE_SCOPE int TclInfoLocalsCmd(ClientData 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(
@@ -3194,7 +3192,7 @@ MODULE_SCOPE int TclScanElement(const char *string, int length,
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,
@@ -4630,7 +4628,7 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
*----------------------------------------------------------------
*/
-#if TCL_UTF_MAX > 4
+#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
((((unsigned char) *(str)) < 0x80) ? \
((*(chPtr) = (unsigned char) *(str)), 1) \
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 16bcdf8..d3941fd 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -658,6 +658,8 @@ EXTERN void TclStaticPackage(Tcl_Interp *interp,
/* 258 */
EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
+/* 259 */
+EXTERN void TclUnusedStubEntry(void);
typedef struct TclIntStubs {
int magic;
@@ -922,6 +924,7 @@ typedef struct TclIntStubs {
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 */
+ void (*tclUnusedStubEntry) (void); /* 259 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
@@ -1367,6 +1370,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclpCreateTemporaryDirectory \
(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
+#define TclUnusedStubEntry \
+ (tclIntStubsPtr->tclUnusedStubEntry) /* 259 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclLink.c b/generic/tclLink.c
index cce838d..9ed7f51 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -164,7 +164,7 @@ Tcl_LinkVar(
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));
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index e142891..d690902 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -886,7 +886,7 @@ Tcl_UnloadObjCmd(
for (ipPrevPtr = ipPtr; ipPtr != NULL;
ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
- if (ipPtr->pkgPtr == pkgPtr) {
+ if (ipPtr->pkgPtr == defaultPtr) {
ipPrevPtr->nextPtr = ipPtr->nextPtr;
break;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index fdc3329..bc1953a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -182,10 +182,7 @@ static Tcl_ThreadDataKey pendingObjDataKey;
*temp = bignum; \
(objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
- } else { \
- if ((bignum).alloc > 0x7fff) { \
- mp_shrink(&(bignum)); \
- } \
+ } 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)); \
@@ -3358,14 +3355,20 @@ TclGetWideBitsFromObj(
}
if (objPtr->typePtr == &tclBignumType) {
mp_int big;
+ mp_err err;
Tcl_WideUInt value = 0, scratch;
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_ubin(&big, bytes, sizeof(Tcl_WideInt), &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++;
}
@@ -3512,14 +3515,14 @@ UpdateStringOfBignum(
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;
@@ -3550,7 +3553,7 @@ Tcl_NewBignumObj(
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewBignumObj(
- mp_int *bignumValue,
+ void *bignumValue,
const char *file,
int line)
{
@@ -3563,7 +3566,7 @@ Tcl_DbNewBignumObj(
#else
Tcl_Obj *
Tcl_DbNewBignumObj(
- mp_int *bignumValue,
+ void *bignumValue,
const char *file,
int line)
{
@@ -3608,7 +3611,9 @@ GetBignumFromObj(
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 */
@@ -3627,8 +3632,10 @@ GetBignumFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
- mp_init_i64(bignumValue,
- objPtr->internalRep.wideValue);
+ if (mp_init_i64(bignumValue,
+ objPtr->internalRep.wideValue) != MP_OKAY) {
+ return TCL_ERROR;
+ }
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
@@ -3674,9 +3681,9 @@ 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);
}
/*
@@ -3709,9 +3716,9 @@ 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);
}
/*
@@ -3734,12 +3741,13 @@ Tcl_TakeBignumFromObj(
void
Tcl_SetBignumObj(
Tcl_Obj *objPtr, /* Object to set */
- mp_int *bignumValue) /* Value to store */
+ void *big) /* Value to store */
{
Tcl_WideUInt value = 0;
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");
@@ -3787,8 +3795,9 @@ Tcl_SetBignumObj(
void
TclSetBignumIntRep(
Tcl_Obj *objPtr,
- mp_int *bignumValue)
+ void *big)
{
+ mp_int *bignumValue = (mp_int *)big;
objPtr->typePtr = &tclBignumType;
PACK_BIGNUM(*bignumValue, objPtr);
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 44c1a74..3bc6722 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -936,7 +936,7 @@ TclParseBackslash(
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';
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 3d39bc5..2336aad 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -853,7 +853,6 @@ SetupAppendBuffer(
Tcl_FreeResult((Tcl_Interp *) iPtr);
iPtr->result = iPtr->appendResult;
}
-#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -883,7 +882,6 @@ Tcl_FreeResult(
{
Interp *iPtr = (Interp *) interp;
-#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -893,10 +891,10 @@ Tcl_FreeResult(
iPtr->freeProc = 0;
}
-#endif /* !TCL_NO_DEPRECATED */
ResetObjResult(iPtr);
}
-
+#endif /* !TCL_NO_DEPRECATED */
+
/*
*----------------------------------------------------------------------
*
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 9c9137c..054d935 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -267,7 +267,7 @@ ValidateFormat(
* these are messy operations because we do
* not want to use the formatting engine;
* we're inside there! */
- char buf[TCL_UTF_MAX + 1] = "";
+ char buf[5] = "";
/*
* Initialize an array that records the number of times a variable is
@@ -880,7 +880,7 @@ Tcl_ScanObjCmd(
offset = TclUtfToUniChar(string, &sch);
i = (int)sch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((sch >= 0xD800) && (offset < 3)) {
offset += TclUtfToUniChar(string+offset, &sch);
i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 64ebbfc..be26d0b 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -15,18 +15,11 @@
#include "tclInt.h"
#include "tclTomMath.h"
+#include <float.h>
#include <math.h>
-/*
- * Older MSVC has no copysign function, but it's available at least since
- * MSVC++ 12.0 (that is Visual Studio 2013).
- */
-
-#if (defined(_MSC_VER) && (_MSC_VER < 1800))
-inline static double
-copysign(double a, double b) {
- return _copysign(a, b);
-}
+#ifdef _WIN32
+#define copysign _copysign
#endif
/*
@@ -310,7 +303,7 @@ 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 *,
@@ -541,6 +534,7 @@ TclParseNumber(
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
int explicitOctal = 0;
+ mp_err err = MP_OKAY;
#define ALL_BITS ((Tcl_WideUInt)-1)
#define MOST_BITS (ALL_BITS >> 1)
@@ -723,7 +717,7 @@ TclParseNumber(
|| (octalSignificandWide >
((Tcl_WideUInt)-1 >> shift)))) {
octalSignificandOverflow = 1;
- mp_init_u64(&octalSignificandBig,
+ err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
}
}
@@ -731,10 +725,17 @@ TclParseNumber(
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) {
@@ -840,17 +841,22 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > ((Tcl_WideUInt)-1 >> shift))) {
significandOverflow = 1;
- mp_init_u64(&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;
@@ -882,17 +888,22 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > ((Tcl_WideUInt)-1 >> shift))) {
significandOverflow = 1;
- mp_init_u64(&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;
@@ -1227,15 +1238,18 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
- mp_init_u64(&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:
@@ -1248,15 +1262,18 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
- mp_init_u64(&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:
@@ -1269,20 +1286,20 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
octalSignificandWide > (MOST_BITS + signum) >> shift)) {
octalSignificandOverflow = 1;
- mp_init_u64(&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)) {
- mp_init_u64(&octalSignificandBig,
+ if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) {
+ err = mp_init_u64(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
@@ -1296,26 +1313,29 @@ TclParseNumber(
}
}
}
- if (octalSignificandOverflow) {
+ if ((err == MP_OKAY) && octalSignificandOverflow) {
if (signum) {
- (void)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;
- mp_init_u64(&significandBig, significandWide);
+ err = mp_init_u64(&significandBig, significandWide);
}
returnInteger:
if (!significandOverflow) {
- if (significandWide > MOST_BITS+signum) {
- mp_init_u64(&significandBig,
+ if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) {
+ err = mp_init_u64(&significandBig,
significandWide);
significandOverflow = 1;
} else {
@@ -1329,12 +1349,15 @@ TclParseNumber(
}
}
}
- if (significandOverflow) {
+ if ((err == MP_OKAY) && significandOverflow) {
if (signum) {
- (void)mp_neg(&significandBig, &significandBig);
+ err = mp_neg(&significandBig, &significandBig);
}
TclSetBignumIntRep(objPtr, &significandBig);
}
+ if (err != MP_OKAY) {
+ return TCL_ERROR;
+ }
break;
case FRACTION:
@@ -1405,7 +1428,7 @@ TclParseNumber(
#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
@@ -1499,7 +1522,9 @@ AccumulateDecimalDigit(
* bignum and fall through into the bignum case.
*/
- mp_init_u64(bignumRepPtr, w);
+ if (mp_init_u64(bignumRepPtr, w) != MP_OKAY) {
+ return 0;
+ }
} else {
/*
* Wide multiplication.
@@ -1519,10 +1544,12 @@ AccumulateDecimalDigit(
* 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
@@ -1533,18 +1560,21 @@ AccumulateDecimalDigit(
*/
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;
@@ -1645,7 +1675,9 @@ MakeLowPrecisionDouble(
* call MakeHighPrecisionDouble to do it the hard way.
*/
- mp_init_u64(&significandBig, significand);
+ if (mp_init_u64(&significandBig, significand) != MP_OKAY) {
+ return 0.0;
+ }
retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
exponent);
mp_clear(&significandBig);
@@ -1694,7 +1726,7 @@ MakeHighPrecisionDouble(
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.
@@ -1859,6 +1891,7 @@ RefineApproximation(
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,
@@ -1907,7 +1940,9 @@ RefineApproximation(
msb = binExponent + M2; /* 1008 */
nDigits = msb / MP_DIGIT_BIT + 1;
- mp_init_size(&twoMv, nDigits);
+ if (mp_init_size(&twoMv, nDigits) != MP_OKAY) {
+ return approxResult;
+ }
i = (msb % MP_DIGIT_BIT + 1);
twoMv.used = nDigits;
significand *= SafeLdExp(1.0, i);
@@ -1917,8 +1952,9 @@ RefineApproximation(
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;
}
}
@@ -1928,20 +1964,27 @@ RefineApproximation(
* 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);
+ 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.
*/
- mp_sub(&twoMd, &twoMv, &twoMd);
+ if (err == MP_OKAY) {
+ err = mp_sub(&twoMd, &twoMv, &twoMd);
+ }
/*
* The result, 2Mv-2Md, needs to be divided by 2M to yield a correction
@@ -1952,16 +1995,25 @@ RefineApproximation(
scale = binExponent - mantBits - 1;
mp_set_u64(&twoMv, 1);
- for (i=0; i<=8; ++i) {
+ 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;
}
/*
@@ -2010,8 +2062,15 @@ RefineApproximation(
*/
shift = mp_count_bits(&twoMv) - FP_PRECISION - 1;
if (shift > 0) {
- mp_div_2d(&twoMv, shift, &twoMv, NULL);
- mp_div_2d(&twoMd, shift, &twoMd, NULL);
+ 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;
}
/*
@@ -2050,7 +2109,7 @@ RefineApproximation(
*----------------------------------------------------------------------
*/
-static inline void
+static inline mp_err
MulPow5(
mp_int *base, /* Number to multiply. */
unsigned n, /* Power of 5 to multiply by. */
@@ -2059,23 +2118,25 @@ MulPow5(
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;
}
/*
@@ -3276,8 +3337,7 @@ ShouldBankerRoundUpToNextPowD(
* 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) {
@@ -3345,23 +3405,31 @@ ShorteningBignumConversionPowD(
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
*/
- mp_init_u64(&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;
@@ -3372,13 +3440,21 @@ ShorteningBignumConversionPowD(
* 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);
+ }
+ 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);
}
- mp_init(&temp);
/*
* Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
@@ -3460,10 +3536,14 @@ ShorteningBignumConversionPowD(
* 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;
}
@@ -3482,7 +3562,7 @@ ShorteningBignumConversionPowD(
if (endPtr) {
*endPtr = s;
}
- return retval;
+ return (err == MP_OKAY) ? retval : NULL;
}
/*
@@ -3530,22 +3610,27 @@ StrictBignumConversionPowD(
mp_digit digit; /* Current output digit. */
char *s = retval; /* Cursor in the output buffer. */
int i; /* Index in the output buffer. */
+ mp_err err;
(void)dPtr;
/*
* b = bw * 2**b2 * 5**b5
*/
- mp_init_u64(&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;
}
@@ -3556,7 +3641,7 @@ StrictBignumConversionPowD(
*/
i = 1;
- for (;;) {
+ while (err == MP_OKAY) {
if (b.used <= sd) {
digit = 0;
} else {
@@ -3588,7 +3673,7 @@ StrictBignumConversionPowD(
* Advance to the next digit.
*/
- mp_mul_d(&b, 10, &b);
+ err = mp_mul_d(&b, 10, &b);
++i;
}
@@ -3670,8 +3755,9 @@ ShouldBankerRoundUpToNext(
* 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) {
@@ -3730,23 +3816,33 @@ ShorteningBignumConversion(
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
*/
- mp_init_u64(&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;
@@ -3756,21 +3852,29 @@ ShorteningBignumConversion(
* 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!");
}
@@ -3783,7 +3887,7 @@ ShorteningBignumConversion(
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) {
@@ -3818,8 +3922,8 @@ ShorteningBignumConversion(
*/
*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);
}
@@ -3830,17 +3934,21 @@ ShorteningBignumConversion(
* 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);
+ }
+ if (err == MP_OKAY) {
+ err = mp_div_d(&S, 5, &S, NULL);
}
- mp_div_d(&S, 5, &S, NULL);
--s5;
/*
@@ -3870,11 +3978,13 @@ ShorteningBignumConversion(
* 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);
}
}
@@ -3938,6 +4048,7 @@ StrictBignumConversion(
int digit; /* Current digit of the result. */
int g; /* Size of the current digit ground. */
int i, j;
+ mp_err err;
(void)dPtr;
/*
@@ -3945,18 +4056,29 @@ StrictBignumConversion(
* S = 2**s2 * 5*s5
*/
- mp_init_multi(&dig, NULL);
- mp_init_u64(&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;
}
@@ -3966,7 +4088,7 @@ StrictBignumConversion(
*/
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!");
}
@@ -3978,12 +4100,11 @@ StrictBignumConversion(
*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.
*/
@@ -3993,16 +4114,20 @@ StrictBignumConversion(
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);
+ }
+ if (err == MP_OKAY) {
+ err = mp_mul_2d(&b, g, &b);
}
- mp_mul_2d(&b, g, &b);
/*
* As with the shortening bignum conversion, it's possible at this
@@ -4016,8 +4141,8 @@ StrictBignumConversion(
* 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];
@@ -4034,8 +4159,7 @@ StrictBignumConversion(
*/
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;
@@ -4410,6 +4534,7 @@ TclInitDoubleConversion(void)
Tcl_WideUInt iv;
} bitwhack;
#endif
+ mp_err err = MP_OKAY;
#if defined(__sgi) && defined(_COMPILER_VERSION)
union fpc_csr mipsCR;
@@ -4424,7 +4549,8 @@ TclInitDoubleConversion(void)
maxpow10_wide = (int)
floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
- pow10_wide = (Tcl_WideUInt *)ckalloc((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;
@@ -4465,16 +4591,19 @@ TclInitDoubleConversion(void)
*/
for (i=0; i<9; ++i) {
- mp_init(pow5 + i);
+ err = err || mp_init(pow5 + i);
}
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_u64(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");
}
/*
@@ -4562,10 +4691,12 @@ 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.
@@ -4583,19 +4714,24 @@ Tcl_InitBignumFromDouble(
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;
- mp_init_i64(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;
}
@@ -4616,11 +4752,13 @@ Tcl_InitBignumFromDouble(
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;
/*
@@ -4649,11 +4787,13 @@ TclBignumToDouble(
* '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) {
@@ -4662,12 +4802,12 @@ TclBignumToDouble(
* Round to even
*/
- mp_div_2d(a, -shift, &b, NULL);
- if (mp_isodd(&b)) {
+ err = mp_div_2d(a, -shift, &b, NULL);
+ if ((err == MP_OKAY) && mp_isodd(&b)) {
if (mp_isneg(&b)) {
- mp_sub_d(&b, 1, &b);
+ err = mp_sub_d(&b, 1, &b);
} else {
- mp_add_d(&b, 1, &b);
+ err = mp_add_d(&b, 1, &b);
}
}
} else {
@@ -4676,13 +4816,15 @@ TclBignumToDouble(
* Ordinary rounding
*/
- mp_div_2d(a, -1-shift, &b, NULL);
- if (mp_isneg(&b)) {
- mp_sub_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_add_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);
}
}
@@ -4690,8 +4832,11 @@ TclBignumToDouble(
* 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);
@@ -4729,14 +4874,16 @@ TclBignumToDouble(
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 (mp_isneg(a)) {
- 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);
@@ -4746,19 +4893,26 @@ TclCeil(
} 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];
@@ -4786,14 +4940,16 @@ TclCeil(
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 (mp_isneg(a)) {
- 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);
@@ -4804,11 +4960,14 @@ TclFloor(
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];
@@ -4850,6 +5009,7 @@ BignumToBiasedFrExp(
int shift;
int i;
double r;
+ mp_err err = MP_OKAY;
/*
* Determine how many bits we need, and extract that many from the input.
@@ -4858,13 +5018,15 @@ BignumToBiasedFrExp(
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);
}
/*
@@ -4872,8 +5034,10 @@ BignumToBiasedFrExp(
*/
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);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 71cdce4..6ab2371 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -571,7 +571,7 @@ Tcl_GetUniChar(
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) {
@@ -755,7 +755,7 @@ Tcl_GetRange(
if (last < first) {
return Tcl_NewObj();
}
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
/* See: bug [11ae2be95dac9417] */
if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
@@ -2273,7 +2273,7 @@ Tcl_AppendFormatToObj(
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);
@@ -2312,7 +2312,7 @@ Tcl_AppendFormatToObj(
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;
@@ -2616,7 +2616,7 @@ AppendPrintfToObjVA(
end = q;
}
- q = bytes + TCL_UTF_MAX;
+ q = bytes + 4;
while ((bytes < end) && (bytes < q)
&& ((*bytes & 0xC0) == 0x80)) {
bytes++;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 6403d47..b94134f 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -40,6 +40,14 @@
#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
@@ -64,6 +72,21 @@
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
+#if TCL_UTF_MAX > 3
+static void uniCodePanic() {
+ 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 *)) uniCodePanic
+# define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *)) uniCodePanic
+# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar)) uniCodePanic
+# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int)) uniCodePanic
+# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int)) uniCodePanic
+# define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long)) uniCodePanic
+# define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int)) uniCodePanic
+# define Tcl_UniCharLen (int(*)(const Tcl_UniChar *)) uniCodePanic
+# define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long)) uniCodePanic
+#endif
+
#define TclBN_mp_add mp_add
#define TclBN_mp_and mp_and
#define TclBN_mp_clamp mp_clamp
@@ -126,7 +149,7 @@
#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
@@ -151,7 +174,7 @@ static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i)
return MP_OKAY;
}
-#define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))TclBN_mp_set_long
+#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);
@@ -232,6 +255,7 @@ mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) {
# define Tcl_NewLongObj 0
# define Tcl_DbNewLongObj 0
# define Tcl_BackgroundError 0
+# define Tcl_FreeResult 0
#else
mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
@@ -481,22 +505,24 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
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))uniCharNcmp
+#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))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))utfNcmp
+#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))utfNcasecmp
-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))uniCharNcasecmp
+#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp
#endif /* TCL_WIDE_INT_IS_LONG */
@@ -592,6 +618,13 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
# 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
@@ -941,6 +974,7 @@ static const TclIntStubs tclIntStubs = {
TclPtrUnsetVar, /* 256 */
TclStaticPackage, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
+ TclUnusedStubEntry, /* 259 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 4d927a6..cfe7886 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -25,6 +25,14 @@
#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:
@@ -164,7 +172,7 @@ TestbignumobjCmd(
};
int index, varIndex;
const char *string;
- mp_int bignumValue, newValue;
+ mp_int bignumValue;
Tcl_Obj **varPtr;
(void)dummy;
@@ -238,19 +246,16 @@ TestbignumobjCmd(
&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;
@@ -266,19 +271,16 @@ TestbignumobjCmd(
&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;
@@ -294,10 +296,16 @@ TestbignumobjCmd(
&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;
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 08d3771..a7d0c72 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -79,8 +79,7 @@ typedef struct {
* 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
@@ -2569,6 +2568,9 @@ TclObjCallVarTraces(
leaveErrMsg);
}
+#undef TCL_INTERP_DESTROYED
+#define TCL_INTERP_DESTROYED 0x100
+
int
TclCallVarTraces(
Interp *iPtr, /* Interpreter containing variable. */
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 8bc4d49..9522f11 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -787,7 +787,7 @@ Tcl_UtfFindFirst(
while (1) {
len = TclUtfToUniChar(src, &find);
fullchar = find;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &find);
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
@@ -835,7 +835,7 @@ Tcl_UtfFindLast(
while (1) {
len = TclUtfToUniChar(src, &find);
fullchar = find;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((fullchar != ch) && (find >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &find);
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
@@ -878,7 +878,7 @@ Tcl_UtfNext(
Tcl_UniChar ch = 0;
int len = TclUtfToUniChar(src, &ch);
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &ch);
}
@@ -960,19 +960,19 @@ Tcl_UniCharAtIndex(
{
Tcl_UniChar ch = 0;
int fullchar = 0;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
int len = 0;
#endif
while (index-- >= 0) {
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
src += (len = TclUtfToUniChar(src, &ch));
#else
src += TclUtfToUniChar(src, &ch);
#endif
}
fullchar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
/* If last Tcl_UniChar was a high surrogate, combine with low surrogate */
(void)TclUtfToUniChar(src, &ch);
@@ -988,7 +988,7 @@ Tcl_UniCharAtIndex(
* 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.
*
@@ -1013,7 +1013,7 @@ Tcl_UtfAtIndex(
len = TclUtfToUniChar(src, &ch);
src += len;
}
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
/* Index points at character following high Surrogate */
src += TclUtfToUniChar(src, &ch);
@@ -1110,7 +1110,7 @@ Tcl_UtfToUpper(
while (*src) {
len = TclUtfToUniChar(src, &ch);
upChar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &ch);
/* Combine surrogates */
@@ -1172,7 +1172,7 @@ Tcl_UtfToLower(
while (*src) {
len = TclUtfToUniChar(src, &ch);
lowChar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &ch);
/* Combine surrogates */
@@ -1237,7 +1237,7 @@ Tcl_UtfToTitle(
if (*src) {
len = TclUtfToUniChar(src, &ch);
titleChar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &ch);
/* Combine surrogates */
@@ -1257,7 +1257,7 @@ Tcl_UtfToTitle(
while (*src) {
len = TclUtfToUniChar(src, &ch);
lowChar = ch;
-#if TCL_UTF_MAX <= 4
+#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) {
len += TclUtfToUniChar(src + len, &ch);
/* Combine surrogates */
@@ -1369,7 +1369,7 @@ Tcl_UtfNcmp(
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) {
@@ -1420,7 +1420,7 @@ Tcl_UtfNcasecmp(
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) {
@@ -1469,7 +1469,7 @@ TclUtfCmp(
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) {
@@ -1515,7 +1515,7 @@ TclUtfCasecmp(
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) {
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 0bac634..ae0c0c5 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -392,6 +392,8 @@ static int ZipChannelRead(void *instanceData, char *buf,
int toRead, int *errloc);
static int ZipChannelSeek(void *instanceData, long offset,
int mode, int *errloc);
+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,
@@ -430,7 +432,7 @@ static const Tcl_Filesystem zipfsFilesystem = {
NULL, /* renameFileProc */
NULL, /* copyDirectoryProc */
NULL, /* lstatProc */
- (Tcl_FSLoadFileProc *) ZipFSLoadFile,
+ (Tcl_FSLoadFileProc *)(void *)ZipFSLoadFile,
NULL, /* getCwdProc */
NULL, /* chdirProc */
};
@@ -454,7 +456,7 @@ static Tcl_ChannelType ZipChannelType = {
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 */
};
@@ -1286,7 +1288,7 @@ ZipFSCatalogFilesystem(
*zf = *zf0;
zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
- Tcl_CreateExitHandler(ZipfsExitHandler, (ClientData)zf);
+ Tcl_CreateExitHandler(ZipfsExitHandler, zf);
zf->mountPointLen = strlen(zf->mountPoint);
zf->nameLength = strlen(zipname);
zf->name = (char *)ckalloc(zf->nameLength + 1);
@@ -1852,7 +1854,7 @@ TclZipfs_Unmount(
ckfree(z);
}
ZipFSCloseArchive(interp, zf);
- Tcl_DeleteExitHandler(ZipfsExitHandler, (ClientData)zf);
+ Tcl_DeleteExitHandler(ZipfsExitHandler, zf);
ckfree(zf);
unmounted = 1;
done:
@@ -3499,7 +3501,7 @@ ZipChannelWrite(
/*
*-------------------------------------------------------------------------
*
- * ZipChannelSeek --
+ * ZipChannelSeek/ZipChannelWideSeek --
*
* This function is called to position file pointer of channel.
*
@@ -3512,15 +3514,15 @@ ZipChannelWrite(
*-------------------------------------------------------------------------
*/
-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)) {
/*
@@ -3552,20 +3554,30 @@ ZipChannelSeek(
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;
}
+
+static int
+ZipChannelSeek(
+ void *instanceData,
+ long offset,
+ int mode,
+ int *errloc)
+{
+ return ZipChannelWideSeek(instanceData, offset, mode, errloc);
+}
/*
*-------------------------------------------------------------------------
@@ -4743,7 +4755,7 @@ ZipFSLoadFile(
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 {
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 71f0ad5..23cea39 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -204,7 +204,7 @@ static void ZlibTransformTimerRun(void *clientData);
static const Tcl_ChannelType zlibChannelType = {
"zlib",
- TCL_CHANNEL_VERSION_3,
+ TCL_CHANNEL_VERSION_5,
ZlibTransformClose,
ZlibTransformInput,
ZlibTransformOutput,
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index c51467b..e5cfc77 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -970,7 +970,7 @@ proc tcltest::testConstraint {constraint {value ""}} {
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))} {
diff --git a/libtommath/tommath_private.h b/libtommath/tommath_private.h
index d076934..138d39e 100644
--- a/libtommath/tommath_private.h
+++ b/libtommath/tommath_private.h
@@ -283,10 +283,6 @@ MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len);
MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used); \
}
-#ifdef _MSC_VER
-/* Prevent false positive: unary minus operator applied to unsigned type, result still unsigned */
-#pragma warning(disable: 4146)
-#endif
#define MP_SET_SIGNED(name, uname, type, utype) \
void name(mp_int * a, type b) \
{ \
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 215796f..05b5040 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -19,6 +19,8 @@ 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
@@ -519,6 +521,21 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
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 {
diff --git a/tests/internals.tcl b/tests/internals.tcl
new file mode 100644
index 0000000..6b5bb87
--- /dev/null
+++ b/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. \ No newline at end of file
diff --git a/tests/oo.test b/tests/oo.test
index 235a90d..3b56f30 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -111,8 +111,8 @@ test oo-0.8 {leak in variable management} -setup {
} -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 {}
diff --git a/tests/stringObj.test b/tests/stringObj.test
index bda7285..3779bca 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -23,6 +23,8 @@ 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]
@@ -464,19 +466,19 @@ 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
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 3876f1f..c35c940 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -282,7 +282,7 @@ STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_D
${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
@EXTRA_CC_SWITCHES@
-CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT -DMP_WUR=
+CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT
APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@
diff --git a/unix/configure b/unix/configure
index 59f2c5d..e8e3691 100755
--- a/unix/configure
+++ b/unix/configure
@@ -4681,12 +4681,13 @@ fi
if test $libtommath_ok = yes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing mp_log_u32" >&5
-$as_echo_n "checking for library containing mp_log_u32... " >&6; }
-if ${ac_cv_search_mp_log_u32+:} false; 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_func_search_save_LIBS=$LIBS
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ltommath $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
@@ -4705,40 +4706,22 @@ return mp_log_u32 ();
return 0;
}
_ACEOF
-for ac_lib in '' tommath; do
- if test -z "$ac_lib"; then
- ac_res="none required"
- else
- ac_res=-l$ac_lib
- LIBS="-l$ac_lib $ac_func_search_save_LIBS"
- fi
- if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_search_mp_log_u32=$ac_res
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext
- if ${ac_cv_search_mp_log_u32+:} false; then :
- break
-fi
-done
-if ${ac_cv_search_mp_log_u32+:} false; then :
-
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_tommath_mp_log_u32=yes
else
- ac_cv_search_mp_log_u32=no
+ ac_cv_lib_tommath_mp_log_u32=no
fi
-rm conftest.$ac_ext
-LIBS=$ac_func_search_save_LIBS
+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_search_mp_log_u32" >&5
-$as_echo "$ac_cv_search_mp_log_u32" >&6; }
-ac_res=$ac_cv_search_mp_log_u32
-if test "$ac_res" != no; then :
- test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
-
+{ $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
-
+ libtommath_ok=no
fi
fi
@@ -5330,7 +5313,7 @@ fi
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; }
@@ -6600,7 +6583,7 @@ fi
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;'
@@ -6750,7 +6733,6 @@ else
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)'
diff --git a/unix/configure.ac b/unix/configure.ac
index f0ba688..b893d1a 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -180,9 +180,8 @@ if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then
AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include <tommath.h>])],[
libtommath_ok=no])
AS_IF([test $libtommath_ok = yes], [
- AC_SEARCH_LIBS([mp_log_u32],[tommath],[],[
- libtommath_ok=no
- ])])
+ 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])
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index e45042d..594c9c9 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -293,10 +293,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
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
@@ -330,12 +326,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
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)
@@ -376,10 +366,6 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
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
@@ -413,12 +399,6 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
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)
@@ -624,8 +604,6 @@ AC_DEFUN([SC_ENABLE_FRAMEWORK], [
# 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], [
@@ -635,7 +613,6 @@ AC_DEFUN([SC_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)'
@@ -1109,7 +1086,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
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,
@@ -1821,7 +1798,7 @@ dnl # preprocessing tests use only CPPFLAGS.
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)"
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index ca932d2..a343707 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -11,7 +11,7 @@ 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}
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 993ee95..31095bd 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -689,32 +689,22 @@ TcpClose2Proc(
int flags) /* Flags that indicate which side to close. */
{
TcpState *statePtr = (TcpState *)instanceData;
- int errorCode = 0;
- int sd;
+ 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 ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
+ return TcpCloseProc(instanceData, interp);
}
- if (shutdown(statePtr->fds.fd,sd) < 0) {
- errorCode = errno;
+ if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) {
+ readError = errno;
}
-
- return errorCode;
+ if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0)) {
+ writeError = errno;
+ }
+ return (readError != 0) ? readError : writeError;
}
/*
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 5cc937f..795c62c 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -266,9 +266,9 @@ TclpThreadCreate(
}
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;
diff --git a/win/Makefile.in b/win/Makefile.in
index 2243214..33644cb 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -82,7 +82,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
#CFLAGS = $(CFLAGS_DEBUG)
#CFLAGS = $(CFLAGS_OPTIMIZE)
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING -DMP_FIXED_CUTOFFS -DMP_NO_STDINT -DMP_WUR=
+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
@@ -834,7 +834,7 @@ install-binaries: binaries
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)" \
diff --git a/win/makefile.vc b/win/makefile.vc
index 97eb250..42bea4a 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -439,7 +439,7 @@ 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 /DMP_FIXED_CUTOFFS /DMP_WUR=
+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
diff --git a/win/rules.vc b/win/rules.vc
index 064823b..872b3a0 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -686,7 +686,7 @@ LINKERFLAGS = $(LINKERFLAGS) -ltcg
# 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)
-# TCL_UTF_MAX=6 - forces a build using 32-bit Tcl_UniChar in stead of 16-bit.
+# TCL_UTF_MAX=4 - forces a build allowing 4-byte UTF-8 sequences internally.
# Further, LINKERFLAGS are modified based on above.
# Default values for all the above
@@ -761,8 +761,8 @@ _USE_64BIT_TIME_T = 1
!endif
!if [nmakehlp -f $(OPTS) "utfmax"]
-!message *** Force 32-bit Tcl_UniChar
-TCL_UTF_MAX = 6
+!message *** Force allowing 4-byte UTF-8 sequences internally
+TCL_UTF_MAX = 4
!endif
# Yes, it's weird that the "symbols" option controls DEBUG and
@@ -1302,11 +1302,8 @@ OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1
!else
OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1
!endif
-!if $(VCVERSION) >= 1700
-OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1
-!endif
!if $(VCVERSION) >= 1800
-OPTDEFINES = $(OPTDEFINES) /DHAVE_STDBOOL_H=1
+OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1
!endif
!if $(TCL_MEM_DEBUG)
@@ -1363,8 +1360,8 @@ OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
-!if "$(TCL_UTF_MAX)" == "6"
-OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=6
+!if "$(TCL_UTF_MAX)" == "4"
+OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=4
!endif
# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 8297513..4a1bbfd 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -454,10 +454,16 @@ 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);
}
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index bb6c690..d37d39b 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1137,26 +1137,15 @@ TcpClose2Proc(
int flags) /* Flags that indicate which side to close. */
{
TcpState *statePtr = (TcpState *)instanceData;
- int errorCode = 0;
- int sd;
+ 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);
}
/*
@@ -1164,12 +1153,15 @@ TcpClose2Proc(
* 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());
- errorCode = Tcl_GetErrno();
+ readError = Tcl_GetErrno();
}
-
- return errorCode;
+ if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) {
+ TclWinConvertError((DWORD) WSAGetLastError());
+ writeError = Tcl_GetErrno();
+ }
+ return (readError != 0) ? readError : writeError;
}
/*