Compare commits

..
Author SHA1 Message Date
dgp 9befca04cc Make simplificiations possible when we know just bytes are getting copied
without complications of encodings
2014-08-21 04:13:35 +00:00
dgp d8f1034a21 Copy Write() to WriteBytes() to create an arena for performance hacking. 2014-08-20 21:44:31 +00:00
630 changed files with 69710 additions and 31814 deletions
-10
View File
@@ -1,10 +0,0 @@
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.bc
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
-10
View File
@@ -1,10 +0,0 @@
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.bc
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
-24
View File
@@ -6,7 +6,6 @@
*.lib
*.o
*.obj
*.pdb
*.res
*.sl
*.so
@@ -18,31 +17,8 @@
*/tclsh*
*/tcltest*
*/versions.vc
*/version.vc
html
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src
libtommath/*.pdf
libtommath/*.pl
libtommath/*.sh
libtommath/tombc/*
libtommath/pre_gen/*
libtommath/pics/*
libtommath/mtest/*
libtommath/logs/*
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
unix/autoMkindex.tcl
unix/dltest.marker
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/Debug*
win/Release*
win/pkgs/*
win/tcl.hpj
win/nmhlp-out.txt
-188
View File
@@ -1,188 +0,0 @@
sudo: false
language: c
matrix:
include:
# Testing on Linux with various compilers
- name: "Linux/Clang/Shared"
os: linux
dist: xenial
compiler: clang
env:
- BUILD_DIR=unix
- name: "Linux/Clang/Static"
os: linux
dist: xenial
compiler: clang
env:
- CFGOPT=--disable-shared
- BUILD_DIR=unix
- name: "Linux/GCC/Shared"
os: linux
dist: xenial
compiler: gcc
env:
- BUILD_DIR=unix
- name: "Linux/GCC/Static"
os: linux
dist: xenial
compiler: gcc
env:
- CFGOPT=--disable-shared
- BUILD_DIR=unix
# Older versions of GCC...
- name: "Linux/GCC 7/Shared"
os: linux
dist: xenial
compiler: gcc-7
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-7
env:
- BUILD_DIR=unix
- name: "Linux/GCC 6/Shared"
os: linux
dist: xenial
compiler: gcc-6
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-6
env:
- BUILD_DIR=unix
- name: "Linux/GCC 5/Shared"
os: linux
dist: xenial
compiler: gcc-5
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- 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
# Testing on Mac, various styles
- name: "macOS/Xcode 11/Shared/Unix-like"
os: osx
osx_image: xcode11
env:
- BUILD_DIR=unix
- name: "macOS/Xcode 11/Shared/Mac-like"
os: osx
osx_image: xcode11
env:
- BUILD_DIR=macosx
install: []
script: &mactest
- make all
# The styles=develop avoids some weird problems on OSX
- make test styles=develop
- name: "macOS/Xcode 10/Shared/Mac-like"
os: osx
osx_image: xcode10.2
env:
- BUILD_DIR=macosx
install: []
script: *mactest
- name: "macOS/Xcode 9/Shared/Mac-like"
os: osx
osx_image: xcode9
env:
- BUILD_DIR=macosx
install: []
script: *mactest
- name: "macOS/Xcode 8/Shared/Mac-like"
os: osx
osx_image: xcode8
env:
- BUILD_DIR=macosx
install: []
script: *mactest
# Test with mingw-w64 (32 bit) cross-compile
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows-32/GCC/Shared/no test"
os: linux
dist: xenial
compiler: i686-w64-mingw32-gcc
addons: &mingw32
apt:
packages:
- gcc-mingw-w64-base
- binutils-mingw-w64-i686
- gcc-mingw-w64-i686
- gcc-mingw-w64
- gcc-multilib
- wine
env:
- BUILD_DIR=win
- CFGOPT="--host=i686-w64-mingw32 --enable-threads"
script: &crosstest
- make all
- make tcltest
# Include a high visibility marker that tests are skipped outright
- >
echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`"
- name: "Linux-cross-Windows-32/GCC/Static/no test"
os: linux
dist: xenial
compiler: i686-w64-mingw32-gcc
addons: *mingw32
env:
- BUILD_DIR=win
- CFGOPT="--host=i686-w64-mingw32 --disable-shared --enable-threads"
script: *crosstest
# Test with mingw-w64 (64 bit)
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows-64/GCC/Shared/no test"
os: linux
dist: xenial
compiler: x86_64-w64-mingw32-gcc
addons: &mingw64
apt:
packages:
- gcc-mingw-w64-base
- binutils-mingw-w64-x86-64
- gcc-mingw-w64-x86-64
- gcc-mingw-w64
- wine
env:
- BUILD_DIR=win
- CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads"
script: *crosstest
- name: "Linux-cross-Windows-64/GCC/Static/no test"
os: linux
dist: xenial
compiler: x86_64-w64-mingw32-gcc
addons: *mingw64
env:
- BUILD_DIR=win
- CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --enable-threads --disable-shared"
script: *crosstest
before_install:
- cd ${BUILD_DIR}
install:
- ./configure ${CFGOPT} --prefix=$HOME
before_script:
- export ERROR_ON_FAILURES=1
script:
- make all
- make tcltest
- make test
+2 -2
View File
@@ -66,7 +66,7 @@ a better first place to look now.
(https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ),
diagnosed by dgp to be a close relative of [Bug 781585], which was
fixed by commit [f46fb50cb3]. This bug was introduced by myself in
commit [cbfe055d8c].
commit [cbfe055d8c].
2013-05-28 Harald Oehlmann <oehhar@users.sf.net>
@@ -268,7 +268,7 @@ a better first place to look now.
2013-02-05 Don Porter <dgp@users.sourceforge.net>
* win/tclWinFile.c: [Bug 3603434]: Make sure TclpObjNormalizePath()
* win/tclWinFile.c: [Bug 3603434]: Make sure TclpObjNormalizePath()
properly declares "a:/" to be normalized, even when no "A:" drive is
present on the system.
+1 -1
View File
@@ -414,7 +414,7 @@
Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the
new stacked channel implementation. Their stub slots were also moved
to give preference to the new 8.3.2 stub functions. This will cause an
incompatibility with 8.4a1 only.
incompatability with 8.4a1 only.
(StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that
didn't set nonBlocking correctly when resetting the flags for the
write side. [Bug: 6261]
+3 -3
View File
@@ -847,7 +847,7 @@
exit.
* tests/exec.test: marked exec-18.1 unixOnly until the Windows
incompatibility (in the test, not the core) can be resolved.
incompatability (in the test, not the core) can be resolved.
* tests/http.test (http-3.11): added close $fp that was causing an
error on Windows because the file was not closed before deleting.
@@ -3642,7 +3642,7 @@
* compat/strtoll.c (strtoll):
* compat/strtoull.c (strtoull):
* unix/tclUnixPort.h:
* win/tclWinPort.h: Const-ing 64-bit compatibility declarations. Note
* win/tclWinPort.h: Const-ing 64-bit compatability declarations. Note
that the return pointer is non-const because it is entirely legal for
the functions to be called from somewhere that owns the string being
passed. Fixes problem reported by Larry Virden.
@@ -3779,7 +3779,7 @@
There are a lot of changes from this TIP, so please see
http://purl.org/tcl/tip/72.html for discussion of
backward-compatibility issues, but the main ones modifications are in:
backward-compatability issues, but the main ones modifications are in:
* generic/tcl.h: New types.
* generic/tcl.decls: New public functions.
+2 -2
View File
@@ -947,7 +947,7 @@
declarations match and will end up using the declarations in the
public code from now on because of #include ordering. Keeping the old
declarations in tclInt.decls; there's no need to gratuitously break
compatibility for those extensions which are already clients of the
compatability for those extensions which are already clients of the
namespace code.
2003-08-23 Zoran Vasiljevic <zoran@archiwrae.com>
@@ -1278,7 +1278,7 @@
* generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get]
and [array set] work with dictionaries, producing them and consuming
them. Note that for compatibility reasons, you will never get a dict
them. Note that for compatability reasons, you will never get a dict
from feeding a string literal to [array set] since that alters the
trace behaviour of "multi-key" sets. [Bug 759935]
+1 -1
View File
@@ -1356,7 +1356,7 @@
2004-10-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* *.3: Convert CONST to const and VOID to void so we document how
people should actually use the Tcl API and not the compatibility hacks
people should actually use the Tcl API and not the compatability hacks
that it has to have.
* doc/man.macros, *.3: Update .AS macro so it can know how wide to
+185
View File
@@ -0,0 +1,185 @@
README: Tcl
This is the Tcl 8.5.15 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
Contents
--------
1. Introduction
2. Documentation
3. Compiling and installing Tcl
4. Development tools
5. Tcl newsgroup
6. The Tcler's Wiki
7. Mailing lists
8. Support and Training
9. Tracking Development
10. Thank You
1. Introduction
---------------
Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
takes place at:
http://core.tcl.tk/
Tcl/Tk release and mailing list services are hosted by SourceForge:
http://sourceforge.net/projects/tcl/
with the Tcl Developer Xchange hosted at:
http://www.tcl.tk/
Tcl is a freely available open source package. You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part. See the file
"license.terms" for complete information.
2. Documentation
----------------
Extensive documentation is available at our website.
The home page for this release, including new features, is
http://www.tcl.tk/software/tcltk/8.5.html
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
http://sourceforge.net/projects/tcl/files/Tcl/
Information about Tcl itself can be found at
http://www.tcl.tk/about/
There have been many Tcl books on the market. Many are mentioned in the Wiki:
http://wiki.tcl.tk/_/ref?N=25206
To view the complete set of reference manual entries for Tcl 8.5 online,
visit the URL:
http://www.tcl.tk/man/tcl8.5/
2a. Unix Documentation
----------------------
The "doc" subdirectory in this release contains a complete set of
reference manual entries for Tcl. Files with extension ".1" are for
programs (for example, tclsh.1); files with extension ".3" are for C
library procedures; and files with extension ".n" describe Tcl
commands. The file "doc/Tcl.n" gives a quick summary of the Tcl
language syntax. To print any of the man pages on Unix, cd to the
"doc" directory and invoke your favorite variant of troff using the
normal -man macros, for example
ditroff -man Tcl.n
to print Tcl.n. If Tcl has been installed correctly and your "man" program
supports it, you should be able to access the Tcl manual entries using the
normal "man" mechanisms, such as
man Tcl
2b. Windows Documentation
-------------------------
The "doc" subdirectory in this release contains a complete set of Windows
help files for Tcl. Once you install this Tcl release, a shortcut to the
Windows help Tcl documentation will appear in the "Start" menu:
Start | Programs | Tcl | Tcl Help
3. Compiling and installing Tcl
-------------------------------
There are brief notes in the unix/README, win/README, and macosx/README about
compiling on these different platforms. There is additional information
about building Tcl from sources at
http://www.tcl.tk/doc/howto/compile.html
4. Development tools
---------------------------
ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more. More information can be found at
http://www.ActiveState.com/Tcl
5. Tcl newsgroup
----------------
There is a USENET news group, "comp.lang.tcl", intended for the exchange of
information about Tcl, Tk, and related applications. The newsgroup is a
great place to ask general information questions. For bug reports, please
see the "Support and bug fixes" section below.
6. Tcl'ers Wiki
---------------
A Wiki-based open community site covering all aspects of Tcl/Tk is at:
http://wiki.tcl.tk/
It is dedicated to the Tcl programming language and its extensions. A
wealth of useful information can be found there. It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications. You can also recommend
additional URLs by editing the wiki yourself.
7. Mailing lists
----------------
Several mailing lists are hosted at SourceForge to discuss development or
use issues (like Macintosh and Windows topics). For more information and
to subscribe, visit:
http://sourceforge.net/projects/tcl/
and go to the Mailing Lists page.
8. Support and Training
------------------------
We are very interested in receiving bug reports, patches, and suggestions
for improvements. We prefer that you send this information to us as
tickets entered into our tracker at:
http://core.tcl.tk/tcl/reportlist
We will log and follow-up on each bug, although we cannot promise a
specific turn-around time. Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
the size of the installed base.
The Tcl community is too large for us to provide much individual support
for users. If you need help we suggest that you post questions to
comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric
questions for which no one else is likely to know the answer. In addition,
see the following Web site for links to other organizations that offer
Tcl/Tk training:
http://wiki.tcl.tk/training
9. Tracking Development
-----------------------
Tcl is developed in public. To keep an eye on how Tcl is changing, see
http://core.tcl.tk/
10. Thank You
-------------
We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.
-148
View File
@@ -1,148 +0,0 @@
# README: Tcl
This is the **Tcl 8.5.19** source distribution.
You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).
[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-5-branch)](https://travis-ci.org/tcltk/tcl)
## Contents
1. [Introduction](#intro)
2. [Documentation](#doc)
3. [Compiling and installing Tcl](#build)
4. [Development tools](#devtools)
5. [Tcl newsgroup](#complangtcl)
6. [The Tcler's Wiki](#wiki)
7. [Mailing lists](#email)
8. [Support and Training](#support)
9. [Tracking Development](#watch)
10. [Thank You](#thanks)
## <a id="intro">1.</a> Introduction
Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
takes place at [core.tcl-lang.org](https://core.tcl-lang.org/).
Tcl/Tk release and mailing list services are [hosted by
SourceForge](https://sourceforge.net/projects/tcl/)
with the Tcl Developer Xchange hosted at
[www.tcl-lang.org](https://www.tcl-lang.org).
Tcl is a freely available open source package. You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part. See the file
`license.terms` for complete information.
## <a id="doc">2.</a> Documentation
Extensive documentation is available at our website.
The home page for this release, including new features, is
[here](https://www.tcl.tk/software/tcltk/8.5.html).
Detailed release notes can be found at the
[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/)
by clicking on the relevant version.
Information about Tcl itself can be found at the [Developer
Xchange](https://www.tcl-lang.org/about/).
There have been many Tcl books on the market. Many are mentioned in
[the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206).
The complete set of reference manual entries for Tcl 8.5 is [online,
here](https://www.tcl-lang.org/man/tcl8.5/).
### <a id="doc.unix">2a.</a> Unix Documentation
The `doc` subdirectory in this release contains a complete set of
reference manual entries for Tcl. Files with extension "`.1`" are for
programs (for example, `tclsh.1`); files with extension "`.3`" are for C
library procedures; and files with extension "`.n`" describe Tcl
commands. The file "`doc/Tcl.n`" gives a quick summary of the Tcl
language syntax. To print any of the man pages on Unix, cd to the
"doc" directory and invoke your favorite variant of troff using the
normal -man macros, for example
groff -man -Tpdf Tcl.n >output.pdf
to print Tcl.n to PDF. If Tcl has been installed correctly and your "man" program
supports it, you should be able to access the Tcl manual entries using the
normal "man" mechanisms, such as
man Tcl
### <a id="doc.win">2b.</a> Windows Documentation
The "doc" subdirectory in this release contains a complete set of Windows
help files for Tcl. Once you install this Tcl release, a shortcut to the
Windows help Tcl documentation will appear in the "Start" menu:
Start | Programs | Tcl | Tcl Help
## <a id="build">3.</a> Compiling and installing Tcl
There are brief notes in the `unix/README`, `win/README`, and `macosx/README`
about compiling on these different platforms. There is additional information
about building Tcl from sources
[online](https://www.tcl-lang.org/doc/howto/compile.html).
## <a id="devtools">4.</a> Development tools
ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more. More information can be found at
http://www.ActiveState.com/Tcl
## <a id="complangtcl">5.</a> Tcl newsgroup
There is a USENET news group, "`comp.lang.tcl`", intended for the exchange of
information about Tcl, Tk, and related applications. The newsgroup is a
great place to ask general information questions. For bug reports, please
see the "Support and bug fixes" section below.
## <a id="wiki">6.</a> Tcl'ers Wiki
There is a [wiki-based open community site](https://wiki.tcl-lang.org/)
covering all aspects of Tcl/Tk.
It is dedicated to the Tcl programming language and its extensions. A
wealth of useful information can be found there. It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications. You can also recommend
additional URLs by editing the wiki yourself.
## <a id="email">7.</a> Mailing lists
Several mailing lists are hosted at SourceForge to discuss development or use
issues (like Macintosh and Windows topics). For more information and to
subscribe, visit [here](https://sourceforge.net/projects/tcl/) and go to the
Mailing Lists page.
## <a id="support">8.</a> Support and Training
We are very interested in receiving bug reports, patches, and suggestions for
improvements. We prefer that you send this information to us as tickets
entered into [our issue tracker](https://core.tcl-lang.org/tcl/reportlist).
We will log and follow-up on each bug, although we cannot promise a
specific turn-around time. Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
the size of the installed base.
The Tcl community is too large for us to provide much individual support for
users. If you need help we suggest that you post questions to `comp.lang.tcl`
or ask a question on [Stack
Overflow](https://stackoverflow.com/questions/tagged/tcl). We read the
newsgroup and will attempt to answer esoteric questions for which no one else
is likely to know the answer. In addition, see the wiki for [links to other
organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training.
## <a id="watch">9.</a> Tracking Development
Tcl is developed in public. You can keep an eye on how Tcl is changing at
[core.tcl-lang.org](https://core.tcl-lang.org/).
## <a id="thanks">10.</a> Thank You
We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.
+1 -188
View File
@@ -7678,7 +7678,7 @@ Many revisions to better support a Cygwin environment (nijtmans)
2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans)
2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows)
2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows)
=> http 2.7.10
2012-11-07 (bug fix)[3574493] hang in Windows socket finalization (fassel)
@@ -7791,190 +7791,3 @@ Many revisions to better support a Cygwin environment (nijtmans)
2013-09-13 (bug fix)[bdd91c] crash in exec stack mem management (azazel)
--- Released 8.5.15, September 16, 2013 --- http://core.tcl.tk/tcl/ for details
2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter)
2013-09-19 (bug fix) [info frame] line OBOEs in bytecode (porter)
2013-09-25 (bug fix)[d614d63] namespace matching *:: deletion fail (fellows)
2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows)
2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans)
=> http 2.7.13
2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans)
2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans)
2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans)
2013-11-20 (bug fix) Improved environment variable management (nijtmans)
=> tcltest 2.3.7
2013-11-21 (platforms) Support for Windows 8.1 (nijtmans)
2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter)
2014-02-24 (bug fix)[2413550] Win: avoid serial double open (schroeter)
2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans)
2014-03-27 (bug fix) segfault iocmd-23.11 (porter)
2014-04-02 (bug fix)[336441e] Win: async socket connect stall (oehlmann)
2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann)
2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans)
2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter)
2014-04-16 (update) Win: use Winsock 2.2 (nijtmans)
2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres)
2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter)
2014-04-22 (bug fix) segfault iogt-2.4 (porter)
2014-04-23 (bug fix)[3493120] memleak in thread exit
2014-04-30 (bug fix) segfault iocmd-21.2[34] (porter)
2014-05-01 (bug fix)[0e92c40] bytearray optimization validity (nijtmans)
2014-05-06 (bug fix) segfault iogt-2.5 (porter)
2014-05-06 (memleaks) io-29.27 io-29.34 io-33.7 (porter)
2014-05-07 (memleaks) io-53.5, cloned Tcl_ChannelTypes (porter)
2014-05-08 (memleak) iocmd-21.22 (porter)
2014-05-08 refactoring of core I/O functions (porter)
2014-05-09 (bug fix) segfault iocmd-32.1 (porter)
2014-05-15 (bug fix)[3118489] protect NUL in filenames (nijtmans)
2014-05-16 (bug fix) Fix for failing tests *io-32.11* (porter)
2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-05-22 (platforms) work around systems that fail when a shared library
is deleted after it is [load]ed (kupries)
2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter)
2014-06-04 (bug fix) socket-2.12 (porter)
2014-06-05 (bug fix) io-12.6 (kupries,porter)
2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter)
2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter)
2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans)
2014-07-04 (update) Update Unicode data to 7.0 (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-08-01 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime
of Tcl_Channel (porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries)
=> platform 1.0.13
2014-08-12 tzdata updated to Olson's tzdata2014f (kenny)
--- Released 8.5.16, August 25, 2014 --- http://core.tcl.tk/tcl/ for details
2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter)
2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans)
2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter)
2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter)
2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter)
--- Released 8.5.17, October 25, 2014 --- http://core.tcl.tk/tcl/ for details
2014-10-26 Support for Windows 10 (nijtmans)
2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans)
2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter)
2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter)
2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-12-10 tzdata updated to Olson's tzdata2014j (venkat)
2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans)
2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter)
2015-02-05 (bug) Plug stacked channel memleak (porter)
2015-02-11 tzdata updated to Olson's tzdata2015a (venkat)
--- Released 8.5.18, March 6, 2015 --- http://core.tcl.tk/tcl/ for details
2015-03-10 (bug)[3028676] Refinement in OS X notifier (steffen,walzer,lars_h)
2015-04-23 (bug)[19ea02] Win: shared read from linked dirs (bogdan,oehhar)
2015-04-24 (bug)[879a07] Incomplete chars @ buffer ends (leunissen,porter)
2015-04-29 (bug)[894da1] Hang flushing blocking channels (yorick)
2015-05-27 (enhancement) Relax memdebug constraint on extensions (kupries)
2015-06-16 (bug)[e770d9] Higher baud on serial channels (woods,nijtmans)
2015-06-18 (update) Update Unicode data to 8.0 (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2015-07-15 (bug)[b1534b][9bad63] writes beyond buffer bounds (hanno,porter)
2015-07-29 (bug)[3e7eca] Allocation overflow in expr parsing (rickyb,porter)
2015-08-12 tzdata updated to Olson's tzdata2015f (venkat)
2015-08-19 (bug)[00189c] MSVC 14: semi-static UCRT support (dower,nijtmans)
2015-08-26 (bug)[0df7a1] Tolerate getcwd() failures (cato,nijtmans)
2015-09-23 (bug)[e0a7b3] Input buffer draining & file events (griffin,porter)
2015-09-24 (bug)[57945b] lock in forking/multi-threading (neumann,mistachkin)
2015-09-29 (bug)[219866] Cygwin support error (yorick,nijtmans)
=> platform 1.0.14
2015-10-06 (bug)[b42a85] Win: [file normalize ~user] wrong dir (nadkarni)
2015-10-21 (bug)[818a1a][a3c350][d7ea9f][8f2450][1080042] Many fixes and
improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2015-11-10 (bug)[261a8a] Overflow segfault in I/O translation (brooks,porter)
2015-11-20 (bug)[3293874] let lists grow all the way to the limit (porter)
2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter)
2015-12-11 (bug)[c9eb6b] tolerate unset ::env(TZ) (gahr, nijtmans)
2016-01-29 (TIP 440) tcl_platform(engine) -- Tcl implementation (mistachkin)
--- Released 8.5.19, February 12, 2016 --- http://core.tcl.tk/tcl/ for details
+1 -1
View File
@@ -343,7 +343,7 @@ typedef struct Tcl_ChannelType {
It is not necessary to provide implementations for all channel
operations. Those which are not necessary may be set to NULL in the
struct: \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
\fIgetOptionProc\fR, \fIgetHandleProc\fR, and \fIclose2Proc\fR, in addition to
\fIgetOptionProc\fR, and \fIclose2Proc\fR, in addition to
\fIflushProc\fR, \fIhandlerProc\fR, \fIthreadActionProc\fR, and
\fItruncateProc\fR. Other functions that cannot be implemented in a
meaningful way should return \fBEINVAL\fR when called, to indicate
+3 -3
View File
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\"
.TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
@@ -94,7 +94,7 @@ Also, most Tcl values are only read and never modified.
This is especially true for procedure arguments,
which can be shared between the caller and the called procedure.
Assignment and argument binding is done by
simply assigning a pointer to the value.
simply assigning a pointer to the value.
Reference counting is used to determine when it is safe to
reclaim an object's storage.
.PP
@@ -249,7 +249,7 @@ The \fBincr\fR command first gets an integer from \fIx\fR's object
by calling \fBTcl_GetIntFromObj\fR.
This procedure checks whether the object is already an integer object.
Since it is not, it converts the object
by setting the object's internal representation
by setting the object's \fIinternalRep.longValue\fR member
to the integer \fB123\fR
and setting the object's \fItypePtr\fR
to point to the integer Tcl_ObjType structure.
+6 -5
View File
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
@@ -56,9 +56,9 @@ is called, Tcl will take care of memory management.
.PP
The second triplet stores the snapshot of only the interpreter
result (not its complete state) in memory allocated by the caller.
These routines are passed a pointer to \fBTcl_SavedResult\fR
These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
that is used to store enough information to restore the interpreter result.
\fBTcl_SavedResult\fR can be allocated on the stack of the calling
This structure can be allocated on the stack of the calling
procedure. These routines do not save the state of any error
information in the interpreter (e.g. the \fB\-errorcode\fR or
\fB\-errorinfo\fR return options, when an error is in progress).
@@ -69,7 +69,7 @@ a superset of the functions provided by the other routines,
any new code should only make use of the more powerful routines.
The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
and \fBTcl_DiscardResult\fR continue to exist only for the sake
of existing programs that may already be using them.
of existing programs that may already be using them.
.PP
\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
interpreter state that make up the full result of script evaluation.
@@ -118,6 +118,7 @@ uninitialized state and cannot be used until another call to
Once \fBTcl_SaveResult\fR is called to save the interpreter
result, either \fBTcl_RestoreResult\fR or
\fBTcl_DiscardResult\fR must be called to properly clean up the
memory associated with the saved state.
memory associated with the saved state.
.SH KEYWORDS
result, state, interp
+24 -11
View File
@@ -76,7 +76,7 @@ created. \fIClientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR is invoked.
\fIOldName\fR gives the name of the command being renamed, and
\fInewName\fR gives the name that the command is being renamed to (or
NULL when the command is being deleted.)
an empty string or NULL when the command is being deleted.)
\fIFlags\fR is an OR'ed combination of bits potentially providing
several pieces of information. One of the bits \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR will be set in \fIflags\fR to indicate which
@@ -84,14 +84,11 @@ operation is being performed on the command. 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). Because the
deletion of commands can take place as part of the deletion of the interp
that contains them, \fIproc\fR must be careful about checking what
the passed in \fIinterp\fR value can be called upon 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. The function of \fIproc\fR
in that circumstance is limited to the cleanup of its own data structures.
\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).
.PP
\fBTcl_UntraceCommand\fR may be used to remove a trace. If the
command specified by \fIinterp\fR, \fIcmdName\fR, and \fIflags\fR has
@@ -124,8 +121,7 @@ traces for a given command that have the same \fIproc\fR.
.PP
During rename traces, the command being renamed is visible with both
names simultaneously, and the command still exists during delete
traces, unless the interp that contains it is being deleted.
However, there is no
traces (if \fBTCL_INTERP_DESTROYED\fR is not set). However, there is no
mechanism for signaling that an error occurred in a trace procedure,
so great care should be taken that errors do not get silently lost.
.SH "MULTIPLE TRACES"
@@ -144,5 +140,22 @@ rename the command, the last renaming takes precedence.
In a delete callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR.
.\" Perhaps need some more comments here? - DKF
.SH "TCL_INTERP_DESTROYED"
.PP
When an interpreter is destroyed, unset traces are called for
all of its commands.
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.
.SH KEYWORDS
clientData, trace, command
+4 -4
View File
@@ -329,11 +329,11 @@ trace procedures will always be invoked.
.SH "RESTRICTIONS"
.PP
A trace procedure can be called at any time, even when there
are partially formed results stored in the interpreter. If
is a partially formed result in the interpreter's result area. If
the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR
and related routines to save and restore the original state of
the interpreter before it returns.
as calling \fBTcl_Eval\fR) then it must save the original values of
the interpreter's \fBresult\fR and \fBfreeProc\fR fields and restore
them before it returns.
.SH "UNDEFINED VARIABLES"
.PP
It is legal to set a trace on an undefined variable.
+1 -1
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
Tcl_UniChar, Tcl_UniCharCaseMatch, Tcl_UniCharNcasecmp, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, 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
+13 -13
View File
@@ -16,13 +16,13 @@ package require \fBTcl 8.5\fR
.sp
\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
.sp
\fBclock microseconds\fR
\fBclock microseconds\fR
.sp
\fBclock milliseconds\fR
\fBclock milliseconds\fR
.sp
\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...?
.sp
\fBclock seconds\fR
\fBclock seconds\fR
.sp
.BE
.SH "DESCRIPTION"
@@ -58,10 +58,10 @@ Formats a time that is expressed as an integer number of seconds into a format
intended for consumption by users or external programs.
See \fBFORMATTING TIMES\fR for a full description.
.TP
\fBclock microseconds\fR
\fBclock microseconds\fR
Returns the current time as an integer number of microseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.TP
\fBclock milliseconds\fR
\fBclock milliseconds\fR
Returns the current time as an integer number of milliseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.TP
\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...?
@@ -69,7 +69,7 @@ Scans a time that is expressed as a character string and produces an
integer number of seconds.
See \fBSCANNING TIMES\fR for a full description.
.TP
\fBclock seconds\fR
\fBclock seconds\fR
Returns the current time as an integer number of seconds.
.SS "PARAMETERS"
.TP
@@ -112,7 +112,7 @@ and their interpretation, are described under \fBFORMAT GROUPS\fR.
.PP
On \fBclock format\fR, the default format is
.CS
%a %b %d %H:%M:%S %Z %Y
%a %b %d %H:%M:%S %z %Y
.CE
.PP
On \fBclock scan\fR, the lack of a \fI\-format\fR option indicates that a
@@ -514,7 +514,7 @@ string of the same meaning in the locale, to indicate whether \fB%Y\fR refers
to years before or after Year 1 of the Common Era. On input, accepts
the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the
abbreviation appropriate to the current locale, and uses it to fix
whether \fB%Y\fR refers to years before or after Year 1 of the
whether \fB%Y\fR refers to years before or after Year 1 of the
Common Era.
.TP
\fB%Ex\fR
@@ -673,8 +673,8 @@ ISO8601 week number.
\fB%w\fR
On output, produces the ordinal number of the day of the week
(Sunday==0; Saturday==6). On input, accepts a single digit and
interprets it as the day of the week; Sunday may be represented as
either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number,
interprets it as the day of the week; Sunday may be represented as
either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number,
which is produced and accepted by \fB%u\fR.
.TP
\fB%W\fR
@@ -753,7 +753,7 @@ The local time zone from the Control Panel on Windows systems.
The C library's idea of the local time zone, as defined by the
\fBmktime\fR and \fBlocaltime\fR functions.
.PP
In case [1] \fIonly,\fR the string is tested to see if it is one
In case [1] \fIonly,\fR the string is tested to see if it is one
of the strings:
.CS
gmt ut utc bst wet wat at
@@ -769,7 +769,7 @@ of the strings:
If it is a string in the above list, it designates a known
time zone, and is interpreted as such.
.PP
For time zones in case [1] that do not match any of the above strings,
For time zones in case [1] that do not match any of the above strings,
and always for cases [2]-[6], the following rules apply.
.PP
If the time zone begins with a colon, it is one of a
@@ -876,7 +876,7 @@ giving an explicit \fI\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
A specification relative to the current time. The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR). The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
-1
View File
@@ -21,7 +21,6 @@ This command joins each of its arguments together with spaces after
trimming leading and trailing white-space from each of them. If all the
arguments are lists, this has the same effect as concatenating them
into a single list.
Arguments that are empty (after trimming) are ignored entirely.
It permits any number of arguments;
if no \fIarg\fRs are supplied, the result is an empty string.
.SH EXAMPLES
-17
View File
@@ -207,19 +207,6 @@ information is instead sent to the console, if one is present, or is
discarded.
.RS
.PP
Note that the current escape resp. quoting of arguments for windows works only
with executables using CommandLineToArgv, CRT-library or similar, as well as
with the windows batch files (excepting the newline, see below).
Although it is the common escape algorithm, but, in fact, the way how the
executable parses the command-line (resp. splits it into single arguments)
is decisive.
.PP
Unfortunately, there is currently no way to supply newline character within
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
(also the argument chain) on the first newline character.
But it works properly with an executable (using CommandLineToArgv, etc).
.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
@@ -428,10 +415,6 @@ that sometimes pop up:
.CE
With the file \fIcmp.bat\fR looking something like:
.CS
@gcc %*
.CE
or like another variant using single parameters:
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
.PP
+15 -65
View File
@@ -26,11 +26,9 @@ as the corresponding C operators.
Expressions almost always yield numeric results
(integer or floating-point values).
For example, the expression
.PP
.CS
\fBexpr 8.2 + 6\fR
.CE
.PP
evaluates to 14.2.
Tcl expressions differ from C expressions in the way that
operands are specified. Also, Tcl expressions support
@@ -105,9 +103,8 @@ For some examples of simple expressions, suppose the variable
the variable \fBb\fR has the value 6.
Then the command on the left side of each of the lines below
will produce the value on the right side of the line:
.PP
.CS
.ta 9c
.ta 6c
\fBexpr\fR 3.1 + $a \fI6.1\fR
\fBexpr\fR 2 + "$a.$b" \fI5.6\fR
\fBexpr\fR 4*[llength "6 2"] \fI8\fR
@@ -192,21 +189,16 @@ Bit-wise OR. Valid for integer operands only.
Logical AND. Produces a 1 result if both operands are non-zero,
0 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
This operator evaluates lazily; it only evaluates its right-hand side if it
must in order to determine its result.
.TP 20
\fB||\fR
Logical OR. Produces a 0 result if both operands are zero, 1 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
This operator evaluates lazily; it only evaluates its right-hand side if it
must in order to determine its result.
.TP 20
\fIx \fB? \fIy \fB: \fIz\fR
\fIx\fB?\fIy\fB:\fIz\fR
If-then-else, as in C. If \fIx\fR
evaluates to non-zero, then the result is the value of \fIy\fR.
Otherwise the result is the value of \fIz\fR.
The \fIx\fR operand must have a boolean or numeric value.
This operator evaluates lazily; it only evaluates one of \fIy\fR or \fIz\fR.
.LP
See the C manual for more details on the results
produced by each operator.
@@ -217,22 +209,18 @@ of the \fBpow\fR function (after any type conversions.)
.VE 8.5
All of the binary operators group left-to-right within the same
precedence level. For example, the command
.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
returns 0.
.PP
The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have
.QW "lazy evaluation" ,
just as in C, which means that operands are not evaluated if they are
not needed to determine the outcome. For example, in the command
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
\fBexpr {$v ? [a] : [b]}\fR
.CE
.PP
only one of
.QW \fB[a]\fR
or
@@ -250,23 +238,18 @@ before invoking the \fBexpr\fR command.
.VS 8.5
When the expression parser encounters a mathematical function
such as \fBsin($x)\fR, it replaces it with a call to an ordinary
Tcl command in the \fBtcl::mathfunc\fR namespace. The processing
Tcl function in the \fBtcl::mathfunc\fR namespace. The processing
of an expression such as:
.PP
.CS
\fBexpr\fR {sin($x+$y)}
\fBexpr {sin($x+$y)}\fR
.CE
.PP
is the same in every way as the processing of:
.PP
.CS
\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
\fBexpr {[tcl::mathfunc::sin [expr {$x+$y}]]}\fR
.CE
.PP
which in turn is the same as the processing of:
.PP
.CS
tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
\fBtcl::mathfunc::sin [expr {$x+$y}]\fR
.CE
.PP
The executor will search for \fBtcl::mathfunc::sin\fR using the usual
@@ -305,29 +288,23 @@ and string operands is done automatically as needed.
For arithmetic computations, integers are used until some
floating-point number is introduced, after which floating-point is used.
For example,
.PP
.CS
\fBexpr\fR {5 / 4}
.CE
.PP
returns 1, while
.PP
.CS
\fBexpr\fR {5 / 4.0}
\fBexpr\fR {5 / ( [string length "abcd"] + 0.0 )}
.CE
.PP
both return 1.25.
Floating-point values are always returned with a
.QW \fB.\fR
or an
.QW \fBe\fR
so that they will not look like integer values. For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SS "STRING OPERATIONS"
.PP
@@ -343,12 +320,10 @@ Canonical string representation for integer values is a decimal string
format. Canonical string representation for floating-point values
is that produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command. For example, the commands
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
\fBexpr\fR {"0y" > "0x12"}
\fBexpr {"0x03" > "2"}\fR
\fBexpr {"0y" > "0x12"}\fR
.CE
.PP
both return 1. The first comparison is done using integer
comparison, and the second is done using string comparison.
Because of Tcl's tendency to treat values as numbers whenever
@@ -365,19 +340,15 @@ This allows the Tcl bytecode compiler to generate the best code.
As mentioned above, expressions are substituted twice:
once by the Tcl parser and once by the \fBexpr\fR command.
For example, the commands
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
\fBset a 3\fR
\fBset b {$a + 2}\fR
\fBexpr $b*4\fR
.CE
.PP
return 11, not a multiple of 4.
This is because the Tcl parser will first substitute
.QW "\fB$a + 2\fR"
for the variable \fBb\fR,
then the \fBexpr\fR command will evaluate the expression
.QW "\fB$a + 2*4\fR" .
This is because the Tcl parser will first substitute \fB$a + 2\fR for
the variable \fBb\fR,
then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR.
.PP
Most expressions do not require a second round of substitutions.
Either they are enclosed in braces or, if not,
@@ -391,21 +362,6 @@ The most expensive code is required for
unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
.PP
If it is necessary to include a non-constant expression string within the
wider context of an otherwise-constant expression, the most efficient
technique is to put the varying part inside a recursive \fBexpr\fR, as this at
least allows for the compilation of the outer part, though it does mean that
the varying part must itself be evaluated as a separate expression. Thus, in
this example the result is 20 and the outer expression benefits from fully
cached bytecode compilation.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP
.VS 8.5
When the expression is unbraced to allow the substitution of a function or
operator, consider using the commands documented in the \fBmathfunc\fR(n) or
@@ -415,7 +371,6 @@ operator, consider using the commands documented in the \fBmathfunc\fR(n) or
Define a procedure that computes an
.QW interesting
mathematical function:
.PP
.CS
proc tcl::mathfunc::calc {x y} {
\fBexpr\fR { ($x**2 - $y**2) / exp($x**2 + $y**2) }
@@ -423,7 +378,6 @@ proc tcl::mathfunc::calc {x y} {
.CE
.PP
Convert polar coordinates into cartesian coordinates:
.PP
.CS
# convert from ($radius,$angle)
set x [\fBexpr\fR { $radius * cos($angle) }]
@@ -431,7 +385,6 @@ set y [\fBexpr\fR { $radius * sin($angle) }]
.CE
.PP
Convert cartesian coordinates into polar coordinates:
.PP
.CS
# convert from ($x,$y)
set radius [\fBexpr\fR { hypot($y, $x) }]
@@ -440,14 +393,12 @@ set angle [\fBexpr\fR { atan2($y, $x) }]
.PP
Print a message describing the relationship of two string values to
each other:
.PP
.CS
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
Set a variable to whether an environment variable is both defined at
all and also set to a true boolean value:
.PP
.CS
set isTrue [\fBexpr\fR {
[info exists ::env(SOME_ENV_VAR)] &&
@@ -456,7 +407,6 @@ set isTrue [\fBexpr\fR {
.CE
.PP
Generate a random integer in the range 0..99 inclusive:
.PP
.CS
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE
+1 -3
View File
@@ -156,9 +156,7 @@ returns \fB/home\fR (or something similar).
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
\fB0\fR otherwise. On Windows, which does not have an executable attribute,
the command treats all directories and any files with extensions
\fBexe\fR, \fBcom\fR, \fBcmd\fR, \fBbat\fR or \fBps1\fR as executable.
\fB0\fR otherwise.
.TP
\fBfile exists \fIname\fR
.
+1 -1
View File
@@ -48,7 +48,7 @@ expression is evaluated (before
each loop iteration), so changes in the variables will be visible.
See below for an example:
.SH EXAMPLES
Print a line for each of the integers from 0 to 9:
Print a line for each of the integers from 0 to 10:
.CS
for {set x 0} {$x<10} {incr x} {
puts "x is $x"
+1 -4
View File
@@ -369,10 +369,7 @@ set token [::http::geturl https://my.secure.site/]
.TP
\fB::http::unregister\fR \fIproto\fR
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if
there was no such handler.
registered via \fB::http::register\fR.
.SH ERRORS
The \fB::http::geturl\fR procedure will raise errors in the following cases:
invalid command line options,
+9 -11
View File
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\"
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -20,7 +20,7 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_mkindex_old, auto_qualif
\fBauto_qualify \fIcommand namespace\fR
\fBauto_reset\fR
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
\fBparray \fIarrayName\fR ?\fIpattern\fR?
\fBparray \fIarrayName\fR
\fBtcl_endOfWord \fIstr start\fR
\fBtcl_startOfNextWord \fIstr start\fR
\fBtcl_startOfPreviousWord \fIstr start\fR
@@ -133,7 +133,7 @@ as its first characters then it is assumed to be a procedure
definition and the next word of the line is taken as the
procedure's name.
Procedure definitions that do not appear in this way (e.g. they
have spaces before the \fBproc\fR) will not be indexed. If your
have spaces before the \fBproc\fR) will not be indexed. If your
script contains
.QW dangerous
code, such as global initialization
@@ -171,7 +171,7 @@ performing the actual auto-loading of functions at runtime.
This is a standard search procedure for use by extensions during
their initialization. They call this procedure to look for their
script library in several standard directories.
The last component of the name of the library directory is
The last component of the name of the library directory is
normally \fIbasenameversion\fR
(e.g., tk8.0), but it might be
.QW library
@@ -189,11 +189,9 @@ bin or bin/\fIarch\fR directory;
relative to the executable file in the current build tree;
relative to the executable file in a parallel build tree.
.TP
\fBparray \fIarrayName\fR ?\fIpattern\fR?
Prints on standard output the names and values of all the elements in the
array \fIarrayName\fR, or just the names that match \fIpattern\fR (using the
matching rules of \fBstring match\fR) and their values if \fIpattern\fR is
given.
\fBparray \fIarrayName\fR
Prints on standard output the names and values of all the elements
in the array \fIarrayName\fR.
\fBArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.
.TP
@@ -272,7 +270,7 @@ a default value is used.
.TP
\fBenv(TCLLIBPATH)\fR
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations. Directories must be specified in
search during auto-load operations. Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
@@ -297,4 +295,4 @@ Unix, words are comprised of numbers, letters or underscores.
.SH "SEE ALSO"
info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
auto-exec, auto-load, library, unknown, word, whitespace
+1 -1
View File
@@ -321,7 +321,7 @@ the package. For example, a short \fBes.msg\fR might contain:
.PP
.CS
namespace eval ::mypackage {
\fB::msgcat::mcflset\fR "Free Beer" "Cerveza Gratis"
\fB::msgcat::mcflset\fR "Free Beer!" "Cerveza Gracias!"
}
.CE
.SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
+46 -13
View File
@@ -331,27 +331,60 @@ may cause this error.
A BREAK condition has been detected by your UART (see above).
.SH "PORTABILITY ISSUES"
.TP
\fBWindows \fR
\fBWindows \fR(all versions)
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
works for serial ports from 1 to 9. An attempt to open a serial port that
\fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4.
This notation only works for serial ports from 1 to 9, if the system
happens to have more than four. An attempt to open a serial port that
does not exist or has a number greater than 9 will fail. An alternate
form of opening serial ports is to use the filename \fB//./comX\fR,
where X is any number that corresponds to a serial port.
.RS
.PP
form of opening serial ports is to use the filename \fB\e\e.\ecomX\fR,
where X is any number that corresponds to a serial port; please note
that this method is considerably slower on Windows 95 and Windows 98.
.TP
\fBWindows NT\fR
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading, some
of the lines entered at the console will be sent to the command pipeline and
some will be sent to the Tcl evaluator. If a command pipeline is opened for
writing, keystrokes entered into the console are not visible until the
pipe is closed. These problems only occur because both Tcl and the child
application are competing for the console at the same time. If the command
pipeline is started from a script, so that Tcl is not accessing the console,
or if the command pipeline does not use standard input or output, but is
redirected from or to a file, then the above problems do not occur.
pipe is closed. This behavior occurs whether the command pipeline is
executing 16-bit or 32-bit applications. These problems only occur because
both Tcl and the child application are competing for the console at
the same time. If the command pipeline is started from a script, so that Tcl
is not accessing the console, or if the command pipeline does not use
standard input or output, but is redirected from or to a file, then the
above problems do not occur.
.TP
\fBWindows 95\fR
A command pipeline that executes a 16-bit DOS application cannot be opened
for both reading and writing, since 16-bit DOS applications that receive
standard input from a pipe and send standard output to a pipe run
synchronously. Command pipelines that do not execute 16-bit DOS
applications run asynchronously and can be opened for both reading and
writing.
.RS
.PP
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading from
a 32-bit application, some of the keystrokes entered at the console will be
sent to the command pipeline and some will be sent to the Tcl evaluator. If
a command pipeline is opened for writing to a 32-bit application, no output
is visible on the console until the pipe is closed. These problems only
occur because both Tcl and the child application are competing for the
console at the same time. If the command pipeline is started from a script,
so that Tcl is not accessing the console, or if the command pipeline does
not use standard input or output, but is redirected from or to a file, then
the above problems do not occur.
.PP
Whether or not Tcl is running interactively, if a command pipeline is opened
for reading from a 16-bit DOS application, the call to \fBopen\fR will not
return until end-of-file has been received from the command pipeline's
standard output. If a command pipeline is opened for writing to a 16-bit DOS
application, no data will be sent to the command pipeline's standard output
until the pipe is actually closed. This problem occurs because 16-bit DOS
applications are run synchronously, as described above.
.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
+1 -1
View File
@@ -176,7 +176,7 @@ endpoint, so e.g.
.QW \fBa\-c\-e\fR
is illegal. Ranges in Tcl always use the
Unicode collating sequence, but other programs may use other collating
sequences and this can be a source of incompatibility between programs.
sequences and this can be a source of incompatability between programs.
.PP
To include a literal \fB]\fR or \fB\-\fR in the list, the simplest
method is to enclose it in \fB[.\fR and \fB.]\fR to make it a
-2
View File
@@ -45,8 +45,6 @@ or
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, unicode).
.PP
.VS 8.5
The \fB\-encoding\fR option is used to specify the encoding of
the data stored in \fIfileName\fR. When the \fB\-encoding\fR option
+5 -3
View File
@@ -136,7 +136,9 @@ Any Unicode control character.
Any Unicode digit character. Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
Any of the valid forms for a double in Tcl, with optional surrounding
whitespace. In case of under/overflow in the value, 0 is returned and
the \fIvarname\fR will contain \-1.
.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
@@ -144,7 +146,7 @@ false.
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for a 32-bit integer value in Tcl,
with optional surrounding whitespace. In case of overflow in
with optional surrounding whitespace. In case of under/overflow in
the value, 0 is returned and the \fIvarname\fR will contain \-1.
.IP \fBlist\fR 12
Any proper list structure, with optional surrounding whitespace. In
@@ -169,7 +171,7 @@ Any upper case alphabet character in the Unicode character set.
.VS 8.5
.IP \fBwideinteger\fR 12
Any of the valid forms for a wide integer in Tcl, with optional
surrounding whitespace. In case of overflow in the value, 0 is
surrounding whitespace. In case of under/overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
.VE 8.5
.IP \fBwordchar\fR 12
+197 -338
View File
File diff suppressed because it is too large Load Diff
-5
View File
@@ -254,11 +254,6 @@ so extension writers can specify which package to load depending on the
C run-time library that is in use. This is not an indication that this core
contains symbols.
.TP
\fBengine\fR
.
The name of the Tcl language implementation. When the interpreter is first
created, this is always set to the string \fBTcl\fR.
.TP
\fBmachine\fR
The instruction set executed by this machine, such as
\fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR. On UNIX machines, this
-146
View File
@@ -1,146 +0,0 @@
'\"
'\" Copyright (c) 2005 Sergey Brester aka sebres.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH timerate n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
timerate \- Calibrated performance measurements of script execution time
.SH SYNOPSIS
\fBtimerate \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI double\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
\fBtimerate \fR?\fB\-calibrate\fR? ?\fB\-direct\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.BE
.SH DESCRIPTION
.PP
The \fBtimerate\fR command does calibrated performance measurement of a Tcl
command or script, \fIscript\fR. The \fIscript\fR should be written so that it
can be executed multiple times during the performance measurement process.
Time is measured in elapsed time using the finest timer resolution as possible,
not CPU time; if \fIscript\fR interacts with the OS, the cost of that
interaction is included.
This command may be used to provide information as to how well a script or
Tcl command is performing, and can help determine bottlenecks and fine-tune
application performance.
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
The parameter \fImax-count\fR could additionally impose a further restriction
by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3
the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
.IP \(bu 3
the count how many times it was executed ([\fBlindex\fR $result 2])
.IP \(bu 3
the estimated rate per second ([\fBlindex\fR $result 4])
.IP \(bu 3
the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6])
.PP
The following options may be supplied to the \fBtimerate\fR command:
.TP
\fB\-calibrate\fR
.
To measure very fast scripts as exactly as possible, a calibration process
may be required.
The \fB\-calibrate\fR option is used to calibrate \fBtimerate\fR itself,
calculating the estimated overhead of the given script as the default overhead
for future invocations of the \fBtimerate\fR command. If the \fItime\fR
parameter is not specified, the calibrate procedure runs for up to 10 seconds.
.RS
.PP
Note that calibration is not thread safe in the current implementation.
.RE
.TP
\fB\-overhead \fIdouble\fR
.
The \fB\-overhead\fR parameter supplies an estimate (in microseconds) of the
measurement overhead of each iteration of the tested script. This quantity
will be subtracted from the measured time prior to reporting results. This can
be useful for removing the cost of interpreter state reset commands from the
script being measured.
.TP
\fB\-direct\fR
.
The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
.PP
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the timerate command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.
.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
operations on variable \fIi\fR) to count to ten:
.PP
.CS
\fI# calibrate\fR
\fBtimerate\fR -calibrate {}
\fI# measure\fR
\fBtimerate\fR { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop, ignoring the
overhead of the management of the variable that controls the loop:
.PP
.CS
\fI# calibrate for overhead of variable operations\fR
set i 0; \fBtimerate\fR -calibrate {expr {$i<10}; incr i} 1000
\fI# measure\fR
\fBtimerate\fR {
for {set i 0} {$i<10} {incr i} {}
} 5000
.CE
.PP
Estimate the speed of calculating the hour of the day using \fBclock format\fR only,
ignoring overhead of the portion of the script that prepares the time for it to
calculate:
.PP
.CS
\fI# calibrate\fR
\fBtimerate\fR -calibrate {}
\fI# estimate overhead\fR
set tm 0
set ovh [lindex [\fBtimerate\fR {
incr tm [expr {24*60*60}]
}] 0]
\fI# measure using estimated overhead\fR
set tm 0
\fBtimerate\fR -overhead $ovh {
clock format $tm -format %H
incr tm [expr {24*60*60}]; # overhead for this is ignored
} 5000
.CE
.SH "SEE ALSO"
time(n)
.SH KEYWORDS
performance measurement, script, time
.\" Local Variables:
.\" mode: nroff
.\" End:
+1 -1
View File
@@ -259,7 +259,7 @@ newcolor(
return COLORLESS; /* too many colors */
}
n = cm->ncds * 2;
if (n > MAX_COLOR + 1) {
if (n < MAX_COLOR + 1) {
n = MAX_COLOR + 1;
}
if (cm->cd == cm->cdspace) {
+3 -16
View File
@@ -256,33 +256,20 @@ static const chr brbacks[] = { /* \s within brackets */
CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
CHR(':'), CHR(']')
};
#define PUNCT_CONN \
CHR('_'), \
0x203f /* UNDERTIE */, \
0x2040 /* CHARACTER TIE */,\
0x2054 /* INVERTED UNDERTIE */,\
0xfe33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \
0xfe34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \
0xfe4d /* DASHED LOW LINE */, \
0xfe4e /* CENTRELINE LOW LINE */, \
0xfe4f /* WAVY LOW LINE */, \
0xff3f /* FULLWIDTH LOW LINE */
static const chr backw[] = { /* \w */
CHR('['), CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
CHR(':'), CHR(']'), CHR('_'), CHR(']')
};
static const chr backW[] = { /* \W */
CHR('['), CHR('^'), CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
CHR(':'), CHR(']'), CHR('_'), CHR(']')
};
static const chr brbackw[] = { /* \w within brackets */
CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
CHR(':'), CHR(']'), PUNCT_CONN
CHR(':'), CHR(']'), CHR('_')
};
/*
+296 -338
View File
@@ -137,112 +137,98 @@ static const crange alphaRangeTable[] = {
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588},
{0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
{0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4},
{0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
{0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
{0x9df, 0x9e1}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
{0xa59, 0xa5c}, {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
{0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c},
{0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61},
{0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
{0xbae, 0xbb9}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
{0xc2a, 0xc39}, {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c},
{0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61},
{0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
{0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe86, 0xe8a},
{0xe8c, 0xea3}, {0xea7, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf},
{0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b2}, {0x904, 0x939},
{0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, {0x993, 0x9a8},
{0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, {0xa05, 0xa0a},
{0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, {0xa72, 0xa74},
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
{0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
{0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, {0xb8e, 0xb90},
{0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xc05, 0xc0c},
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc85, 0xc8c},
{0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
{0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd7a, 0xd7f},
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
{0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97}, {0xe99, 0xe9f},
{0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf},
{0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a},
{0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081},
{0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d},
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
{0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c},
{0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8},
{0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1878},
{0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e},
{0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
{0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b},
{0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f},
{0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf},
{0x1ce9, 0x1cec}, {0x1cee, 0x1cf3}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15},
{0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
{0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4},
{0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec},
{0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113},
{0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f},
{0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4},
{0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96},
{0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe},
{0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde},
{0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa},
{0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e}, {0x31a0, 0x31ba},
{0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef}, {0xa000, 0xa48c},
{0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e},
{0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788},
{0xa78b, 0xa7bf}, {0xa7c2, 0xa7c6}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
{0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
{0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
{0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
{0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
{0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
{0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab67},
{0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
{0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
{0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
{0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
{0xffda, 0xffdc}
#if CHRBITS > 16
{0x1380, 0x138f}, {0x13a0, 0x13f4}, {0x1401, 0x166c}, {0x166f, 0x167f},
{0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, {0x1700, 0x170c},
{0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176c},
{0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8},
{0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974},
{0x1980, 0x19ab}, {0x19c1, 0x19c7}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54},
{0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5},
{0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1ce9, 0x1cec},
{0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d},
{0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
{0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc},
{0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4},
{0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d},
{0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149},
{0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee},
{0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6},
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035},
{0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff},
{0x3105, 0x312d}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff},
{0x3400, 0x4db5}, {0x4e00, 0x9fcc}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd},
{0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d},
{0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa78e},
{0xa790, 0xa7ad}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a},
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab5f}, {0xabc0, 0xabe2},
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d},
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
{0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
{0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
{0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
{0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
{0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563},
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
{0x10f30, 0x10f45}, {0x10fe0, 0x10ff6}, {0x11003, 0x11037}, {0x11083, 0x110af},
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
{0x11700, 0x1171a}, {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x119a0, 0x119a7},
{0x119aa, 0x119d0}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a89}, {0x11ac0, 0x11af8},
{0x11c00, 0x11c08}, {0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x11d00, 0x11d06},
{0x11d0b, 0x11d30}, {0x11d60, 0x11d65}, {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2},
{0x12000, 0x12399}, {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646},
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
{0x10860, 0x10876}, {0x10880, 0x1089e}, {0x10900, 0x10915}, {0x10920, 0x10939},
{0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
{0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4},
{0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91},
{0x10c00, 0x10c48}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
{0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4},
{0x11200, 0x11211}, {0x11213, 0x1122b}, {0x112b0, 0x112de}, {0x11305, 0x1130c},
{0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361},
{0x11480, 0x114af}, {0x11580, 0x115ae}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
{0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x12000, 0x12398}, {0x13000, 0x1342e},
{0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f},
{0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f},
{0x16f00, 0x16f4a}, {0x16f93, 0x16f9f}, {0x17000, 0x187f7}, {0x18800, 0x18af2},
{0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
{0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
{0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
{0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
{0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
{0x1d7c4, 0x1d7cb}, {0x1e100, 0x1e12c}, {0x1e137, 0x1e13d}, {0x1e2c0, 0x1e2eb},
{0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
{0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a},
{0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89},
{0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb},
{0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1},
{0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}
{0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44},
{0x16f93, 0x16f9f}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88},
{0x1bc90, 0x1bc99}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0},
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734},
{0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8},
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1ee00, 0x1ee03},
{0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f},
{0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c},
{0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9},
{0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
{0x2f800, 0x2fa1d}
#endif
};
@@ -253,30 +239,28 @@ static const chr alphaCharTable[] = {
0x38c, 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef,
0x6ff, 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828,
0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
0x9f0, 0x9f1, 0x9fc, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1,
0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71,
0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0,
0xc3d, 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1,
0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84,
0xea5, 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065,
0x1066, 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa,
0x1aa7, 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1cfa, 0x1f59, 0x1f5b, 0x1f5d,
0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128,
0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f,
0x3005, 0x3006, 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe,
0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e,
0x9f0, 0x9f1, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38,
0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xb0f,
0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83, 0xb99,
0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d, 0xc58,
0xc59, 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2,
0xd3d, 0xd4e, 0xd60, 0xd61, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82,
0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066,
0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7,
0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071,
0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183,
0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006,
0x303b, 0x303c, 0xa62a, 0xa62b, 0xa7b0, 0xa7b1, 0xa8fb, 0xa9cf, 0xaa7a,
0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xab64, 0xab65, 0xfb1d, 0xfb3e,
0xfb40, 0xfb41, 0xfb43, 0xfb44
#if CHRBITS > 16
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x1145f, 0x114c4, 0x114c5, 0x114c7,
0x11644, 0x116b8, 0x118ff, 0x119e1, 0x119e3, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d,
0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0,
0x16fe1, 0x16fe3, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546,
0x1e14e, 0x1e94b, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#if TCL_UTF_MAX > 4
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x109be, 0x109bf, 0x10a00,
0x11176, 0x111da, 0x1130f, 0x11310, 0x11332, 0x11333, 0x1133d, 0x114c4, 0x114c5,
0x114c7, 0x11644, 0x118ff, 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2,
0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};
@@ -290,18 +274,18 @@ static const crange controlRangeTable[] = {
{0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
{0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
{0xfff9, 0xfffb}
#if CHRBITS > 16
,{0x13430, 0x13438}, {0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f},
{0xf0000, 0xffffd}, {0x100000, 0x10fffd}
#if TCL_UTF_MAX > 4
,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
{0x100000, 0x10fffd}
#endif
};
#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
static const chr controlCharTable[] = {
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
#if CHRBITS > 16
,0x110bd, 0x110cd, 0xe0001
0xad, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff
#if TCL_UTF_MAX > 4
,0x110bd, 0xe0001
#endif
};
@@ -322,13 +306,11 @@ static const crange digitRangeTable[] = {
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
{0xff10, 0xff19}
#if CHRBITS > 16
,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
{0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
{0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
{0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
{0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e140, 0x1e149},
{0x1e2f0, 0x1e2f9}, {0x1e950, 0x1e959}
#if TCL_UTF_MAX > 4
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x114d0, 0x114d9}, {0x11650, 0x11659},
{0x116c0, 0x116c9}, {0x118e0, 0x118e9}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
{0x1d7ce, 0x1d7ff}
#endif
};
@@ -351,20 +333,17 @@ static const crange punctRangeTable[] = {
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
{0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4f},
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e42},
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
{0xff5f, 0xff65}
#if CHRBITS > 16
#if TCL_UTF_MAX > 4
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
{0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1},
{0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x111dd, 0x111df}, {0x11238, 0x1123d},
{0x1144b, 0x1144f}, {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c},
{0x1173c, 0x1173e}, {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2},
{0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x16e97, 0x16e9a},
{0x1da87, 0x1da8b}
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
{0x111c5, 0x111c8}, {0x11238, 0x1123d}, {0x115c1, 0x115c9}, {0x11641, 0x11643},
{0x12470, 0x12474}, {0x16b37, 0x16b3b}
#endif
};
@@ -375,20 +354,17 @@ static const chr punctCharTable[] = {
0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
0x9fd, 0xa76, 0xaf0, 0xc77, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b,
0xf14, 0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166e, 0x169b, 0x169c,
0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
0xff5b, 0xff5d
#if CHRBITS > 16
0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9, 0xfda,
0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736, 0x1944,
0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e, 0x208d,
0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe, 0x2cff,
0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673, 0xa67e,
0xa8ce, 0xa8cf, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade, 0xaadf,
0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a, 0xfe6b,
0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
0x119e2, 0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x11fff, 0x16a6e, 0x16a6f, 0x16af5,
0x16b44, 0x16fe2, 0x1bc9f, 0x1e95e, 0x1e95f
0x11174, 0x11175, 0x111cd, 0x114c6, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f
#endif
};
@@ -399,14 +375,14 @@ static const chr punctCharTable[] = {
*/
static const crange spaceRangeTable[] = {
{0x9, 0xd}, {0x2000, 0x200b}
{0x9, 0xd}, {0x2000, 0x200a}
};
#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
static const chr spaceCharTable[] = {
0x20, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f,
0x2060, 0x3000, 0xfeff
0x3000
};
#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))
@@ -419,25 +395,23 @@ static const crange lowerRangeTable[] = {
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa},
{0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x1d00, 0x1d2b},
{0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
{0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
{0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
{0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
{0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
{0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
{0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab67},
{0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if CHRBITS > 16
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
{0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
{0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
{0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
{0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
{0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
{0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
{0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
{0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xfb00, 0xfb06},
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
,{0x10428, 0x1044f}, {0x118c0, 0x118df}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454},
{0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
{0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b},
{0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b},
{0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1},
{0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755},
{0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}
#endif
};
@@ -507,8 +481,8 @@ static const chr lowerCharTable[] = {
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7bb, 0xa7bd, 0xa7bf, 0xa7c3, 0xa7fa
#if CHRBITS > 16
0xa7fa, 0xab64, 0xab65
#if TCL_UTF_MAX > 4
,0x1d4bb, 0x1d7cb
#endif
};
@@ -524,22 +498,20 @@ static const crange upperRangeTable[] = {
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
{0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
{0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
{0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
{0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
{0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
{0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
{0xa7b0, 0xa7b4}, {0xa7c4, 0xa7c6}, {0xff21, 0xff3a}
#if CHRBITS > 16
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
{0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
{0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
{0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
{0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
{0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8},
{0x1e900, 0x1e921}
{0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f},
{0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb},
{0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d},
{0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133},
{0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80},
{0xa7aa, 0xa7ad}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
,{0x10400, 0x10427}, {0x118a0, 0x118bf}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d},
{0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9},
{0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e},
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9},
{0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689},
{0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e},
{0x1d790, 0x1d7a8}
#endif
};
@@ -608,9 +580,9 @@ static const chr upperCharTable[] = {
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
0xa7b8, 0xa7ba, 0xa7bc, 0xa7be, 0xa7c2
#if CHRBITS > 16
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b0,
0xa7b1
#if TCL_UTF_MAX > 4
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
0x1d539, 0x1d546, 0x1d7ca
#endif
@@ -625,171 +597,157 @@ static const chr upperCharTable[] = {
static const crange graphRangeTable[] = {
{0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
{0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
{0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
{0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
{0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d},
{0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4},
{0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03},
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {0xa81, 0xa83},
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
{0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
{0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
{0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
{0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
{0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
{0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
{0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc77, 0xc8c},
{0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
{0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
{0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
{0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
{0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
{0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
{0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe86, 0xe8a},
{0xe8c, 0xea3}, {0xea7, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd},
{0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c},
{0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda},
{0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256},
{0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0},
{0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6},
{0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c},
{0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f},
{0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714},
{0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770},
{0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d},
{0x1810, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18aa}, {0x18b0, 0x18f5},
{0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d},
{0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da},
{0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89},
{0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b},
{0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49},
{0x1c4d, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cfa},
{0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
{0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
{0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
{0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
{0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
{0x2b76, 0x2b95}, {0x2b98, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
{0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4f},
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
{0x3220, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c}, {0xa490, 0xa4c6},
{0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7bf}, {0xa7c2, 0xa7c6},
{0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
{0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
{0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
{0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
{0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b2},
{0x8e4, 0x983}, {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0},
{0x9b6, 0x9b9}, {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3},
{0x9e6, 0x9fb}, {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28},
{0xa2a, 0xa30}, {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c},
{0xa66, 0xa75}, {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
{0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5},
{0xac7, 0xac9}, {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1},
{0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
{0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
{0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
{0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
{0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
{0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc60, 0xc63}, {0xc66, 0xc6f},
{0xc78, 0xc7f}, {0xc81, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4},
{0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef},
{0xd01, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a},
{0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e}, {0xd60, 0xd63},
{0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
{0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf},
{0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b},
{0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9},
{0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9},
{0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97},
{0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5},
{0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
{0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
{0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
{0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399},
{0x13a0, 0x13f4}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8},
{0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
{0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877},
{0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b},
{0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
{0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
{0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
{0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3},
{0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7},
{0x1cd0, 0x1cf6}, {0x1d00, 0x1df5}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d},
{0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
{0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb},
{0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027},
{0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bd},
{0x20d0, 0x20f0}, {0x2100, 0x2189}, {0x2190, 0x23fa}, {0x2400, 0x2426},
{0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bb9},
{0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e},
{0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96},
{0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe},
{0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde},
{0x2de0, 0x2e42}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5},
{0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff},
{0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3},
{0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fcc},
{0xa000, 0xa48c}, {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa69d},
{0xa69f, 0xa6f7}, {0xa700, 0xa78e}, {0xa790, 0xa7ad}, {0xa7f7, 0xa82b},
{0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9},
{0xa8e0, 0xa8fb}, {0xa900, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
{0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
{0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
{0xab30, 0xab67}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
{0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
{0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
{0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
{0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
{0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if CHRBITS > 16
{0xab30, 0xab5f}, {0xabc0, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e},
{0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
{0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
{0xfe20, 0xfe2d}, {0xfe30, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b},
{0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7},
{0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6},
{0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
{0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x1032d, 0x1034a},
{0x10137, 0x1018c}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
{0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a},
{0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
{0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb},
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x10500, 0x10527}, {0x10530, 0x10563},
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10857, 0x1089e}, {0x108a7, 0x108af},
{0x10900, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x10a00, 0x10a03},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
{0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x10fe0, 0x10ff6},
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146},
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
{0x11335, 0x11339}, {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x1145d, 0x1145f},
{0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd},
{0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b8},
{0x116c0, 0x116c9}, {0x11700, 0x1171a}, {0x1171d, 0x1172b}, {0x11730, 0x1173f},
{0x11800, 0x1183b}, {0x118a0, 0x118f2}, {0x119a0, 0x119a7}, {0x119aa, 0x119d7},
{0x119da, 0x119e4}, {0x11a00, 0x11a47}, {0x11a50, 0x11aa2}, {0x11ac0, 0x11af8},
{0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
{0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
{0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
{0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
{0x11fc0, 0x11ff1}, {0x11fff, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474},
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
{0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5},
{0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77},
{0x16b7d, 0x16b8f}, {0x16e40, 0x16e9a}, {0x16f00, 0x16f4a}, {0x16f4f, 0x16f87},
{0x16f8f, 0x16f9f}, {0x16fe0, 0x16fe3}, {0x17000, 0x187f7}, {0x18800, 0x18af2},
{0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
{0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
{0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
{0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
{0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e100, 0x1e12c},
{0x1e130, 0x1e13d}, {0x1e140, 0x1e149}, {0x1e2c0, 0x1e2f9}, {0x1e800, 0x1e8c4},
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94b}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
{0x1ed01, 0x1ed3d}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
{0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
{0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
{0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
{0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
{0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f16c}, {0x1f170, 0x1f1ac},
{0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265},
{0x1f300, 0x1f6d5}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6fa}, {0x1f700, 0x1f773},
{0x1f780, 0x1f7d8}, {0x1f7e0, 0x1f7eb}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
{0x1f90d, 0x1f971}, {0x1f973, 0x1f976}, {0x1f97a, 0x1f9a2}, {0x1f9a5, 0x1f9aa},
{0x1f9ae, 0x1f9ca}, {0x1f9cd, 0x1fa53}, {0x1fa60, 0x1fa6d}, {0x1fa70, 0x1fa73},
{0x1fa78, 0x1fa7a}, {0x1fa80, 0x1fa82}, {0x1fa90, 0x1fa95}, {0x20000, 0x2a6d6},
{0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0},
{0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
{0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc},
{0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134},
{0x11136, 0x11143}, {0x11150, 0x11176}, {0x11180, 0x111c8}, {0x111d0, 0x111da},
{0x111e1, 0x111f4}, {0x11200, 0x11211}, {0x11213, 0x1123d}, {0x112b0, 0x112ea},
{0x112f0, 0x112f9}, {0x11301, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328},
{0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d},
{0x1135d, 0x11363}, {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11480, 0x114c7},
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115c9}, {0x11600, 0x11644},
{0x11650, 0x11659}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x118a0, 0x118f2},
{0x11ac0, 0x11af8}, {0x12000, 0x12398}, {0x12400, 0x1246e}, {0x12470, 0x12474},
{0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16a60, 0x16a69},
{0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45}, {0x16b50, 0x16b59},
{0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44},
{0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c},
{0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5},
{0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1dd}, {0x1d200, 0x1d245},
{0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c},
{0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505},
{0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539},
{0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5},
{0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1d7ff}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6},
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
{0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
{0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f19a},
{0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, {0x1f300, 0x1f32c},
{0x1f330, 0x1f37d}, {0x1f380, 0x1f3ce}, {0x1f3d4, 0x1f3f7}, {0x1f400, 0x1f4fe},
{0x1f500, 0x1f54a}, {0x1f550, 0x1f579}, {0x1f57b, 0x1f5a3}, {0x1f5a5, 0x1f642},
{0x1f645, 0x1f6cf}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f3}, {0x1f700, 0x1f773},
{0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859},
{0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
{0x2b740, 0x2b81d}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xea5,
0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xc58, 0xc59, 0xcd5,
0xcd6, 0xcde, 0xcf1, 0xcf2, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca,
0xdd6, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5,
0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772,
0x1773, 0x1940, 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071,
0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa7b0, 0xa7b1, 0xab64, 0xab65, 0xfb3e,
0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
#if CHRBITS > 16
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x118ff, 0x11d08, 0x11d09, 0x11d3a,
0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e, 0x16a6f, 0x1d49e,
0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e14e,
0x1e14f, 0x1e2ff, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0,
0x1eef1, 0x1f250, 0x1f251
#if TCL_UTF_MAX > 4
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f,
0x109be, 0x109bf, 0x10a05, 0x10a06, 0x111cd, 0x1130f, 0x11310, 0x11332, 0x11333,
0x11347, 0x11348, 0x11357, 0x118ff, 0x16a6e, 0x16a6f, 0x1b000, 0x1b001, 0x1d49e,
0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24,
0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52,
0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64,
0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251
#endif
};
+306 -1529
View File
File diff suppressed because it is too large Load Diff
+27 -45
View File
@@ -119,22 +119,17 @@ static void dropstate(struct nfa *, struct state *);
static void freestate(struct nfa *, struct state *);
static void destroystate(struct nfa *, struct state *);
static void newarc(struct nfa *, int, pcolor, struct state *, struct state *);
static void createarc(struct nfa *, int, pcolor, struct state *, struct state *);
static struct arc *allocarc(struct nfa *, struct state *);
static void freearc(struct nfa *, struct arc *);
static void changearctarget(struct arc *, struct state *);
static int hasnonemptyout(struct state *);
static int nonemptyouts(struct state *);
static int nonemptyins(struct state *);
static struct arc *findarc(struct state *, int, pcolor);
static void cparc(struct nfa *, struct arc *, struct state *, struct state *);
static void sortins(struct nfa *, struct state *);
static int sortins_cmp(const void *, const void *);
static void sortouts(struct nfa *, struct state *);
static int sortouts_cmp(const void *, const void *);
static void moveins(struct nfa *, struct state *, struct state *);
static void copyins(struct nfa *, struct state *, struct state *);
static void mergeins(struct nfa *, struct state *, struct arc **, int);
static void copyins(struct nfa *, struct state *, struct state *, int);
static void moveouts(struct nfa *, struct state *, struct state *);
static void copyouts(struct nfa *, struct state *, struct state *);
static void copyouts(struct nfa *, struct state *, struct state *, int);
static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int);
static void delsub(struct nfa *, struct state *, struct state *);
static void deltraverse(struct nfa *, struct state *, struct state *);
@@ -144,35 +139,28 @@ static void cleartraverse(struct nfa *, struct state *);
static void specialcolors(struct nfa *);
static long optimize(struct nfa *, FILE *);
static void pullback(struct nfa *, FILE *);
static int pull(struct nfa *, struct arc *, struct state **);
static int pull(struct nfa *, struct arc *);
static void pushfwd(struct nfa *, FILE *);
static int push(struct nfa *, struct arc *, struct state **);
static int push(struct nfa *, struct arc *);
#define INCOMPATIBLE 1 /* destroys arc */
#define SATISFIED 2 /* constraint satisfied */
#define COMPATIBLE 3 /* compatible but not satisfied yet */
static int combine(struct arc *, struct arc *);
static void fixempties(struct nfa *, FILE *);
static struct state *emptyreachable(struct nfa *, struct state *,
struct state *, struct arc **);
static int isconstraintarc(struct arc *);
static int hasconstraintout(struct state *);
static void fixconstraintloops(struct nfa *, FILE *);
static int findconstraintloop(struct nfa *, struct state *);
static void breakconstraintloop(struct nfa *, struct state *);
static void clonesuccessorstates(struct nfa *, struct state *, struct state *,
struct state *, struct arc *, char *, char *, int);
static struct state *emptyreachable(struct state *, struct state *);
static void replaceempty(struct nfa *, struct state *, struct state *);
static void cleanup(struct nfa *);
static void markreachable(struct nfa *, struct state *, struct state *, struct state *);
static void markcanreach(struct nfa *, struct state *, struct state *, struct state *);
static long analyze(struct nfa *);
static void compact(struct nfa *, struct cnfa *);
static void carcsort(struct carc *, size_t);
static int carc_cmp(const void *, const void *);
static void carcsort(struct carc *, struct carc *);
static void freecnfa(struct cnfa *);
static void dumpnfa(struct nfa *, FILE *);
#ifdef REG_DEBUG
static void dumpstate(struct state *, FILE *);
static void dumparcs(struct state *, FILE *);
static int dumprarcs(struct arc *, struct state *, FILE *, int);
static void dumparc(struct arc *, struct state *, FILE *);
#endif
static void dumpcnfa(struct cnfa *, FILE *);
@@ -605,15 +593,13 @@ makesearch(
break;
}
}
/*
* We want to mark states as being in the list already by having non
* NULL tmp fields, but we can't just store the old slist value in tmp
* because that doesn't work for the first such state. Instead, the
* first list entry gets its own address in tmp.
*/
if (b != NULL && s->tmp == NULL) {
s->tmp = (slist != NULL) ? slist : s;
/*
* Must be split if not already in the list (fixes bugs 505048,
* 230589, 840258, 504785).
*/
s->tmp = slist;
slist = s;
}
}
@@ -624,9 +610,8 @@ makesearch(
for (s=slist ; s!=NULL ; s=s2) {
s2 = newstate(nfa);
NOERR();
copyouts(nfa, s, s2);
NOERR();
copyouts(nfa, s, s2, 1);
for (a=s->ins ; a!=NULL ; a=b) {
b = a->inchain;
@@ -635,7 +620,7 @@ makesearch(
freearc(nfa, a);
}
}
s2 = (s->tmp != s) ? s->tmp : NULL;
s2 = s->tmp;
s->tmp = NULL; /* clean up while we're at it */
}
}
@@ -997,7 +982,6 @@ parseqatom(
NOERR();
assert(v->nextvalue > 0);
atom = subre(v, 'b', BACKR, lp, rp);
NOERR();
subno = v->nextvalue;
atom->subno = subno;
EMPTYARC(lp, rp); /* temporarily, so there's something */
@@ -1012,13 +996,13 @@ parseqatom(
switch (v->nexttype) {
case '*':
m = 0;
n = DUPINF;
n = INFINITY;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
case '+':
m = 1;
n = DUPINF;
n = INFINITY;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
@@ -1035,7 +1019,7 @@ parseqatom(
if (SEE(DIGIT)) {
n = scannum(v);
} else {
n = DUPINF;
n = INFINITY;
}
if (m > n) {
ERR(REG_BADBR);
@@ -1145,7 +1129,6 @@ parseqatom(
*/
t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
NOERR();
t->left = atom;
atomp = &t->left;
@@ -1159,7 +1142,6 @@ parseqatom(
assert(top->op == '=' && top->left == NULL && top->right == NULL);
top->left = subre(v, '=', top->flags, top->begin, lp);
NOERR();
top->op = '.';
top->right = t;
@@ -1235,8 +1217,8 @@ parseqatom(
*/
dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
assert(m >= 1 && m != DUPINF && n >= 1);
repeat(v, s, atom->begin, m-1, (n == DUPINF) ? n : n-1);
assert(m >= 1 && m != INFINITY && n >= 1);
repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
f = COMBINE(qprefer, atom->flags);
t = subre(v, '.', f, s, atom->end); /* prefix and atom */
NOERR();
@@ -1341,7 +1323,7 @@ repeat(
#define SOME 2
#define INF 3
#define PAIR(x, y) ((x)*4 + (y))
#define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (x)) )
#define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
const int rm = REDUCE(m);
const int rn = REDUCE(n);
struct state *s, *s2;
@@ -2059,7 +2041,7 @@ dump(
dumpcolors(&g->cmap, f);
if (!NULLCNFA(g->search)) {
fprintf(f, "\nsearch:\n");
printf("\nsearch:\n");
dumpcnfa(&g->search, f);
}
for (i = 1; i < g->nlacons; i++) {
@@ -2126,7 +2108,7 @@ stdump(
}
if (t->min != 1 || t->max != 1) {
fprintf(f, " {%d,", t->min);
if (t->max != DUPINF) {
if (t->max != INFINITY) {
fprintf(f, "%d", t->max);
}
fprintf(f, "}");
+2 -2
View File
@@ -1117,7 +1117,7 @@ cbrdissect(
*/
i = 0;
for (p = begin; p <= stop && (i < max || max == DUPINF); p += len) {
for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
if ((*v->g->compare)(paren, p, len) != 0) {
break;
}
@@ -1132,7 +1132,7 @@ cbrdissect(
if (p != end) { /* didn't consume all of it */
return REG_NOMATCH;
}
if (min <= i && (i <= max || max == DUPINF)) {
if (min <= i && (i <= max || max == INFINITY)) {
return REG_OKAY;
}
return REG_NOMATCH; /* out of range */
+2 -4
View File
@@ -116,7 +116,7 @@
#define xxx 1
#define DUPMAX _POSIX2_RE_DUP_MAX
#define DUPINF (DUPMAX+1)
#define INFINITY (DUPMAX+1)
#define REMAGIC 0xfed7 /* magic number for main struct */
@@ -265,10 +265,8 @@ struct arc {
struct state *from; /* where it's from (and contained within) */
struct state *to; /* where it's to */
struct arc *outchain; /* *from's outs chain or free chain */
struct arc *outchainRev; /* back-link in *from's outs chain */
#define freechain outchain /* we do not maintain "freechainRev" */
#define freechain outchain
struct arc *inchain; /* *to's ins chain */
struct arc *inchainRev; /* back-link in *to's ins chain */
struct arc *colorchain; /* color's arc chain */
struct arc *colorchainRev; /* back-link in color's arc chain */
};
+3 -2
View File
@@ -2,8 +2,8 @@
#
# This file contains the declarations for all supported public
# functions that are exported by the Tcl library via the stubs table.
# This file is used to generate the tclDecls.h, tclPlatDecls.h
# and tclStubInit.c files.
# This file is used to generate the tclDecls.h, tclPlatDecls.h,
# tclStub.c, and tclPlatStub.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
@@ -468,6 +468,7 @@ declare 128 {
declare 129 {
int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
# This is obsolete, use Tcl_FSEvalFile
declare 130 {
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
+6 -8
View File
@@ -58,10 +58,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 5
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
#define TCL_RELEASE_SERIAL 19
#define TCL_RELEASE_SERIAL 15
#define TCL_VERSION "8.5"
#define TCL_PATCH_LEVEL "8.5.19"
#define TCL_PATCH_LEVEL "8.5.15"
/*
* The following definitions set up the proper options for Windows compilers.
@@ -69,7 +69,7 @@ extern "C" {
*/
#ifndef __WIN32__
# if defined(_WIN32) || defined(WIN32) || defined(__MSVCRT__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
# define __WIN32__
# ifndef WIN32
# define WIN32
@@ -414,7 +414,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
#if defined(__WIN32__)
# ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
# elif defined(_WIN64) || defined(__MINGW_USE_VC2005_COMPAT) || defined(_USE_64BIT_TIME_T)
# elif defined(_WIN64)
typedef struct __stat64 Tcl_StatBuf;
# elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
typedef struct _stati64 Tcl_StatBuf;
@@ -1263,9 +1263,9 @@ typedef struct Tcl_HashSearch {
* TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the
* pointer is stored in the entry.
*
* While maintaining binary compatibility the above have to be distinct values
* While maintaining binary compatability the above have to be distinct values
* as they are used to differentiate between old versions of the hash table
* which don't have a typePtr and new ones which do. Once binary compatibility
* which don't have a typePtr and new ones which do. Once binary compatability
* is discarded in favour of making more wide spread changes TCL_STRING_KEYS
* can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
* same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
@@ -2418,9 +2418,7 @@ EXTERN void Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
# define Tcl_Ckrealloc Tcl_Realloc
# define Tcl_Return Tcl_SetResult
# define Tcl_TildeSubst Tcl_TranslateFileName
#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */
# define panic Tcl_Panic
#endif
# define panicVA Tcl_PanicVA
#endif
+1 -1
View File
@@ -31,7 +31,7 @@
* until Tcl uses config.h properly.
*/
#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
#endif
+78 -148
View File
@@ -203,9 +203,6 @@ static const CmdInfo builtInCmds[] = {
{"source", Tcl_SourceObjCmd, NULL, 0},
{"tell", Tcl_TellObjCmd, NULL, 1},
{"time", Tcl_TimeObjCmd, NULL, 1},
#ifdef TCL_TIMERATE
{"timerate", Tcl_TimeRateObjCmd, NULL, 1},
#endif
{"unload", Tcl_UnloadObjCmd, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, 1},
{"vwait", Tcl_VwaitObjCmd, NULL, 1},
@@ -389,7 +386,7 @@ Tcl_CreateInterp(void)
const BuiltinFuncDef *builtinFuncPtr;
const OpCmdInfo *opcmdInfoPtr;
const CmdInfo *cmdInfoPtr;
Tcl_Namespace *nsPtr;
Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
union {
char c[sizeof(short)];
short s;
@@ -413,15 +410,7 @@ Tcl_CreateInterp(void)
Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
}
#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) \
&& !defined(__MINGW_USE_VC2005_COMPAT)
/* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T or
* -D__MINGW_USE_VC2005_COMPAT, the result is a binary incompatible
* with the 'standard' build of Tcl: All extensions using Tcl_StatBuf
* or interal functions like TclpGetDate() need to be recompiled in
* the same way. Therefore, this is not officially supported.
* In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet)
*/
#if defined(_WIN32) && !defined(_WIN64)
if (sizeof(time_t) != 4) {
/*NOTREACHED*/
Tcl_Panic("<time.h> is not compatible with MSVC");
@@ -732,17 +721,6 @@ Tcl_CreateInterp(void)
Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
Tcl_DisassembleObjCmd, NULL, NULL);
/* Create an unsupported command for timerate */
Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate",
Tcl_TimeRateObjCmd, NULL, NULL);
/* Export unsupported commands */
nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
if (nsPtr) {
Tcl_Export(interp, nsPtr, "*", 1);
}
#ifdef USE_DTRACE
/*
* Register the tcl::dtrace command.
@@ -755,8 +733,8 @@ Tcl_CreateInterp(void)
* Register the builtin math functions.
*/
nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
if (nsPtr == NULL) {
mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
if (mathfuncNSPtr == NULL) {
Tcl_Panic("Can't create math function namespace");
}
strcpy(mathFuncName, "::tcl::mathfunc::");
@@ -766,19 +744,19 @@ Tcl_CreateInterp(void)
strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
Tcl_CreateObjCommand(interp, mathFuncName,
builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0);
}
/*
* Register the mathematical "operator" commands. [TIP #174]
*/
nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
if (nsPtr == NULL) {
if (mathopNSPtr == NULL) {
Tcl_Panic("can't create math operator namespace");
}
(void) Tcl_Export(interp, nsPtr, "*", 1);
(void) Tcl_Export(interp, mathopNSPtr, "*", 1);
strcpy(mathFuncName, "::tcl::mathop::");
for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)
@@ -811,13 +789,6 @@ Tcl_CreateInterp(void)
TclInitEmbeddedConfigurationInformation(interp);
/*
* TIP #440: Declare the name of the script engine to be "Tcl".
*/
Tcl_SetVar2(interp, "tcl_platform", "engine", "Tcl",
TCL_GLOBAL_ONLY);
/*
* Compute the byte order of this machine.
*/
@@ -1873,11 +1844,11 @@ Tcl_CreateCommand(
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
Namespace *nsPtr;
Command *cmdPtr;
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
int isNew = 0, deleted = 0;
int isNew;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -1890,52 +1861,32 @@ Tcl_CreateCommand(
}
/*
* If the command name we seek to create already exists, we need to
* delete that first. That can be tricky in the presence of traces.
* Loop until we no longer find an existing command in the way, or
* until we've deleted one command and that didn't finish the job.
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace; otherwise,
* we always put it in the global namespace.
*/
while (1) {
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
*/
if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
if (strstr(cmdName, "::") != NULL) {
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* Be careful to preserve
* Command already exists. Delete the old one. Be careful to preserve
* any existing import links so we can restore them down below. That
* way, you can redefine a command and its import status will remain
* intact.
*/
cmdPtr = Tcl_GetHashValue(hPtr);
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
@@ -1948,21 +1899,18 @@ Tcl_CreateCommand(
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree((char *) Tcl_GetHashValue(hPtr));
}
if (!deleted) {
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree((char *) Tcl_GetHashValue(hPtr));
}
} else {
/*
* The list of command exported from the namespace might have changed.
* However, we do not need to recompute this just yet; next time we
@@ -1997,7 +1945,7 @@ Tcl_CreateCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2058,11 +2006,11 @@ Tcl_CreateObjCommand(
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
Namespace *nsPtr;
Command *cmdPtr;
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
int isNew = 0, deleted = 0;
int isNew;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -2075,47 +2023,31 @@ Tcl_CreateObjCommand(
}
/*
* If the command name we seek to create already exists, we need to
* delete that first. That can be tricky in the presence of traces.
* Loop until we no longer find an existing command in the way, or
* until we've deleted one command and that didn't finish the job.
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace; otherwise,
* we always put it in the global namespace.
*/
while (1) {
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
*/
if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
if (strstr(cmdName, "::") != NULL) {
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
/* An existing command conflicts. Try to delete it.. */
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
/* Command already exists. */
/*
* [***] This is wrong. See Tcl Bug a16752c252.
* [***] This is wrong. See Tcl Bug a16752c252.
* However, this buggy behavior is kept under particular
* circumstances to accommodate deployed binaries of the
* "tclcompiler" program. http://sourceforge.net/projects/tclpro/
@@ -2150,20 +2082,18 @@ Tcl_CreateObjCommand(
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
}
if (!deleted) {
ckfree(Tcl_GetHashValue(hPtr));
}
} else {
/*
* The list of command exported from the namespace might have changed.
* However, we do not need to recompute this just yet; next time we
@@ -2171,7 +2101,6 @@ Tcl_CreateObjCommand(
*/
TclInvalidateNsCmdLookup(nsPtr);
TclInvalidateNsPath(nsPtr);
}
cmdPtr = (Command *) ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2198,7 +2127,7 @@ Tcl_CreateObjCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -5196,7 +5125,7 @@ TclEvalObjEx(
TclStackAlloc(interp, sizeof(CmdFrame));
eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1
eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1
: iPtr->cmdFramePtr->level + 1);
eoFramePtr->framePtr = iPtr->framePtr;
eoFramePtr->nextPtr = iPtr->cmdFramePtr;
@@ -6354,7 +6283,7 @@ ExprIsqrtFunc(
if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
return TCL_ERROR;
}
if (mp_isneg(&big)) {
if (SIGN(&big) == MP_NEG) {
mp_clear(&big);
goto negarg;
}
@@ -6625,7 +6554,8 @@ ExprAbsFunc(
#endif
if (type == TCL_NUMBER_BIG) {
if (mp_cmp_d(ptr, 0) == MP_LT) {
/* TODO: const correctness ? */
if (mp_cmp_d((mp_int *) ptr, 0) == MP_LT) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
mp_neg(&big, &big);
@@ -6775,7 +6705,7 @@ ExprIntFunc(
mp_int big;
Tcl_GetBignumFromObj(NULL, objPtr, &big);
mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big);
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
TclGetLongFromObj(NULL, objPtr, &iResult);
@@ -6807,7 +6737,7 @@ ExprWideFunc(
mp_int big;
Tcl_GetBignumFromObj(NULL, objPtr, &big);
mp_mod_2d(&big, CHAR_BIT * sizeof(Tcl_WideInt), &big);
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
@@ -7014,7 +6944,7 @@ ExprSrandFunc(
return TCL_ERROR;
}
mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big);
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
TclGetLongFromObj(NULL, objPtr, &i);
+1 -9
View File
@@ -1528,15 +1528,7 @@ GetFormatSpec(
(*formatPtr)++;
(*countPtr) = BINARY_ALL;
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
unsigned long int count;
errno = 0;
count = strtoul(*formatPtr, formatPtr, 10);
if (errno || (count > (unsigned long) INT_MAX)) {
(*countPtr) = INT_MAX;
} else {
(*countPtr) = (int) count;
}
(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
} else {
(*countPtr) = BINARY_NOCOUNT;
}
+16 -13
View File
@@ -562,9 +562,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
|| TclGetIntFromObj(interp, fieldPtr,
&(fields.dayOfMonth)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
if (fieldPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
}
if (fieldPtr == NULL)
Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
@@ -656,9 +655,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
|| fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
if (fieldPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
}
if (fieldPtr == NULL)
Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
@@ -1739,7 +1737,9 @@ ClockClicksObjCmd(
break;
}
case CLICKS_MICROS:
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
Tcl_GetTime(&now);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
((Tcl_WideInt) now.sec * 1000000) + now.usec));
break;
}
@@ -1808,11 +1808,15 @@ ClockMicrosecondsObjCmd(
int objc, /* Parameter count */
Tcl_Obj* const* objv) /* Parameter values */
{
Tcl_Time now;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
Tcl_GetTime(&now);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
((Tcl_WideInt) now.sec * 1000000) + now.usec));
return TCL_OK;
}
@@ -1990,23 +1994,22 @@ ClockSecondsObjCmd(
static void
TzsetIfNecessary(void)
{
static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
static char* tzWas = NULL; /* Previous value of TZ, protected by
* clockMutex. */
const char* tzIsNow; /* Current value of TZ */
Tcl_MutexLock(&clockMutex);
tzIsNow = getenv("TZ");
if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
|| strcmp(tzIsNow, tzWas) != 0)) {
if (tzIsNow != NULL && (tzWas == NULL || strcmp(tzIsNow, tzWas) != 0)) {
tzset();
if (tzWas != NULL && tzWas != INT2PTR(-1)) {
if (tzWas != NULL) {
ckfree(tzWas);
}
tzWas = ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
if (tzWas != INT2PTR(-1)) ckfree(tzWas);
ckfree(tzWas);
tzWas = NULL;
}
Tcl_MutexUnlock(&clockMutex);
+16 -12
View File
@@ -25,7 +25,7 @@ static int EncodingDirsObjCmd(ClientData dummy,
Tcl_Obj *const objv[]);
static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
static const char * GetTypeFromMode(int mode);
static char * GetTypeFromMode(int mode);
static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
Tcl_StatBuf *statPtr);
@@ -870,11 +870,15 @@ Tcl_FileObjCmd(
return TCL_ERROR;
}
if (objc == 4) {
Tcl_WideInt newTime;
/*
* Need separate variable for reading longs from an object on
* 64-bit platforms. [Bug #698146]
*/
if (Tcl_GetWideIntFromObj(interp, objv[3], &newTime) != TCL_OK) {
return TCL_ERROR;
long newTime;
if (TclGetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
return TCL_ERROR;
}
if (index == FCMD_ATIME) {
@@ -904,7 +908,7 @@ Tcl_FileObjCmd(
}
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
Tcl_SetObjResult(interp, Tcl_NewLongObj((long)
(index == FCMD_ATIME ? buf.st_atime : buf.st_mtime)));
return TCL_OK;
case FCMD_ATTRIBUTES:
@@ -1285,7 +1289,7 @@ Tcl_FileObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
const char *separator = NULL; /* lint */
char *separator = NULL; /* lint */
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
@@ -1523,9 +1527,9 @@ StoreStatData(
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
#endif
STORE_ARY("atime", Tcl_NewWideIntObj(statPtr->st_atime));
STORE_ARY("mtime", Tcl_NewWideIntObj(statPtr->st_mtime));
STORE_ARY("ctime", Tcl_NewWideIntObj(statPtr->st_ctime));
STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
mode = (unsigned short) statPtr->st_mode;
STORE_ARY("mode", Tcl_NewIntObj(mode));
STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
@@ -1550,7 +1554,7 @@ StoreStatData(
*----------------------------------------------------------------------
*/
static const char *
static char *
GetTypeFromMode(
int mode)
{
@@ -1753,7 +1757,7 @@ Tcl_ForeachObjCmd(
maxj = 0;
for (i=0 ; i<numLists ; i++) {
vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
if (vCopyList[i] == NULL) {
result = TCL_ERROR;
+2 -16
View File
@@ -2025,14 +2025,6 @@ Tcl_JoinObjCmd(
resObjPtr = Tcl_NewObj();
for (i = 0; i < listLen; i++) {
if (i > 0) {
/*
* NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
* to shimmer joinObjPtr. If it did, then the case where
* objv[1] and objv[2] are the same value would not be safe.
* Accessing elemPtrs would crash.
*/
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
@@ -2241,10 +2233,7 @@ Tcl_LinsertObjCmd(
Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
} else {
if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
(objc-3), &(objv[3]))) {
return TCL_ERROR;
}
Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3]));
}
/*
@@ -2609,10 +2598,7 @@ Tcl_LreplaceObjCmd(
* optimize this case away.
*/
if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
objc-4, &(objv[4]))) {
return TCL_ERROR;
}
Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, &(objv[4]));
/*
* Set the interpreter's object result.
+14 -580
View File
@@ -17,7 +17,6 @@
*/
#include "tclInt.h"
#include "tclCompile.h"
#include "tclRegexp.h"
static int UniCharIsAscii(int character);
@@ -992,8 +991,7 @@ Tcl_SplitObjCmd(
{
Tcl_UniChar ch;
int len;
const char *splitChars;
char *stringPtr, *end;
char *splitChars, *stringPtr, *end;
int splitCharLen, stringLen;
Tcl_Obj *listPtr, *objPtr;
@@ -1071,8 +1069,7 @@ Tcl_SplitObjCmd(
TclNewStringObj(objPtr, stringPtr, end - stringPtr);
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
} else {
char *element;
const char *p, *splitEnd;
char *element, *p, *splitEnd;
int splitLen;
Tcl_UniChar splitChar;
@@ -1516,6 +1513,7 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
/* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
#ifndef NO_WIDE_TYPE
@@ -2262,7 +2260,7 @@ StringRplcCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *ustring;
int first, last, length, end;
int first, last, length;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
@@ -2270,33 +2268,20 @@ StringRplcCmd(
}
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
end = length - 1;
length--;
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
return TCL_ERROR;
}
/*
* The following test screens out most empty substrings as
* candidates for replacement. When they are detected, no
* replacement is done, and the result is the original string,
*/
if ((last < 0) || /* Range ends before start of string */
(first > end) || /* Range begins after end of string */
(last < first)) { /* Range begins after it starts */
/*
* BUT!!! when (end < 0) -- an empty original string -- we can
* have (first <= end < 0 <= last) and an empty string is permitted
* to be replaced.
*/
if ((last < first) || (last < 0) || (first > length)) {
Tcl_SetObjResult(interp, objv[1]);
} else {
Tcl_Obj *resultPtr;
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
end = length-1;
length--;
if (first < 0) {
first = 0;
@@ -2306,9 +2291,9 @@ StringRplcCmd(
if (objc == 5) {
Tcl_AppendObjToObj(resultPtr, objv[4]);
}
if (last < end) {
if (last < length) {
Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
end - last);
length - last);
}
Tcl_SetObjResult(interp, resultPtr);
}
@@ -3140,7 +3125,8 @@ StringTrimCmd(
}
string1 = TclGetStringFromObj(objv[1], &length1);
triml = TclTrim(string1, length1, string2, length2, &trimr);
triml = TclTrimLeft(string1, length1, string2, length2);
trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
@@ -3932,7 +3918,7 @@ Tcl_TimeObjCmd(
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
} else {
objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
}
@@ -3950,558 +3936,6 @@ Tcl_TimeObjCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_TimeRateObjCmd --
*
* This object-based procedure is invoked to process the "timerate" Tcl
* command.
*
* This is similar to command "time", except the execution limited by
* given time (in milliseconds) instead of repetition count.
*
* Example:
* timerate {after 5} 1000; # equivalent to: time {after 5} [expr 1000/5]
*
* Results:
* A standard Tcl object result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_TimeRateObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static double measureOverhead = 0;
/* global measure-overhead */
double overhead = -1; /* given measure-overhead */
register Tcl_Obj *objPtr;
register int result, i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
TclWideMUInt count = 0; /* Holds repetition count */
Tcl_WideInt maxms = WIDE_MIN;
/* Maximal running time (in milliseconds) */
TclWideMUInt maxcnt = WIDE_MAX;
/* Maximal count of iterations. */
TclWideMUInt threshold = 1; /* Current threshold for check time (faster
* repeat count without time check) */
TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max
* threshold, additionally avoiding divide to
* zero (i.e., never < 1) */
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
* growth of execution time. */
register Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
Tcl_Time now;
#endif /* !TCL_WIDE_CLICKS */
static const char *const options[] = {
"-direct", "-overhead", "-calibrate", "--", NULL
};
enum options {
TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
};
ByteCode *codePtr = NULL;
int codeOptimized = 0;
for (i = 1; i < objc - 1; i++) {
int index;
if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
&index) != TCL_OK) {
break;
}
if (index == TMRT_LAST) {
i++;
break;
}
switch (index) {
case TMRT_EV_DIRECT:
direct = objv[i];
break;
case TMRT_OVERHEAD:
if (++i >= objc - 1) {
goto usage;
}
if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
return TCL_ERROR;
}
break;
case TMRT_CALIBRATE:
calibrate = objv[i];
break;
}
}
if (i >= objc || i < objc - 3) {
usage:
Tcl_WrongNumArgs(interp, 1, objv,
"?-direct? ?-calibrate? ?-overhead double? "
"command ?time ?max-count??");
return TCL_ERROR;
}
objPtr = objv[i++];
if (i < objc) { /* max-time */
result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms);
if (result != TCL_OK) {
return result;
}
if (i < objc) { /* max-count*/
Tcl_WideInt v;
result = Tcl_GetWideIntFromObj(interp, objv[i], &v);
if (result != TCL_OK) {
return result;
}
maxcnt = (v > 0) ? v : 0;
}
}
/*
* If we are doing calibration.
*/
if (calibrate) {
/*
* If no time specified for the calibration.
*/
if (maxms == WIDE_MIN) {
Tcl_Obj *clobjv[6];
Tcl_WideInt maxCalTime = 5000;
double lastMeasureOverhead = measureOverhead;
clobjv[0] = objv[0];
i = 1;
if (direct) {
clobjv[i++] = direct;
}
clobjv[i++] = objPtr;
/*
* Reset last measurement overhead.
*/
measureOverhead = (double) 0;
/*
* Self-call with 100 milliseconds to warm-up, before entering the
* calibration cycle.
*/
TclNewLongObj(clobjv[i], 100);
Tcl_IncrRefCount(clobjv[i]);
result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
if (result != TCL_OK) {
return result;
}
i--;
clobjv[i++] = calibrate;
clobjv[i++] = objPtr;
/*
* Set last measurement overhead to max.
*/
measureOverhead = (double) UWIDE_MAX;
/*
* Run the calibration cycle until it is more precise.
*/
maxms = -1000;
do {
lastMeasureOverhead = measureOverhead;
TclNewLongObj(clobjv[i], (int) maxms);
Tcl_IncrRefCount(clobjv[i]);
result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
if (result != TCL_OK) {
return result;
}
maxCalTime += maxms;
/*
* Increase maxms for more precise calibration.
*/
maxms -= -maxms / 4;
/*
* As long as new value more as 0.05% better
*/
} while ((measureOverhead >= lastMeasureOverhead
|| measureOverhead / lastMeasureOverhead <= 0.9995)
&& maxCalTime > 0);
return result;
}
if (maxms == 0) {
/*
* Reset last measurement overhead
*/
measureOverhead = 0;
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
/*
* If time is negative, make current overhead more precise.
*/
if (maxms > 0) {
/*
* Set last measurement overhead to max.
*/
measureOverhead = (double) UWIDE_MAX;
} else {
maxms = -maxms;
}
}
if (maxms == WIDE_MIN) {
maxms = 1000;
}
if (overhead == -1) {
overhead = measureOverhead;
}
/*
* Ensure that resetting of result will not smudge the further
* measurement.
*/
Tcl_ResetResult(interp);
/*
* Compile object if needed.
*/
if (!direct) {
if (TclInterpReady(interp) != TCL_OK) {
return TCL_ERROR;
}
codePtr = TclCompileObj(interp, objPtr, NULL, 0);
TclPreserveByteCode(codePtr);
/*
* Replace last compiled done instruction with continue: it's a part of
* iteration, this way evaluation will be more similar to a cycle (also
* avoids extra overhead to set result to interp, etc.)
*/
if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
codeOptimized = 1;
}
}
/*
* Get start and stop time.
*/
#ifdef TCL_WIDE_CLICKS
start = middle = TclpGetWideClicks();
/*
* Time to stop execution (in wide clicks).
*/
stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
#else
Tcl_GetTime(&now);
start = now.sec;
start *= 1000000;
start += now.usec;
middle = start;
/*
* Time to stop execution (in microsecs).
*/
stop = start + maxms * 1000;
#endif /* TCL_WIDE_CLICKS */
/*
* Start measurement.
*/
if (maxcnt > 0) {
while (1) {
/*
* Evaluate a single iteration.
*/
count++;
if (!direct) { /* precompiled */
result = TclExecuteByteCode(interp, codePtr);
} else { /* eval */
result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
}
/*
* Allow break and continue from measurement cycle (used for
* conditional stop and flow control of iterations).
*/
switch (result) {
case TCL_OK:
break;
case TCL_BREAK:
/*
* Force stop immediately.
*/
threshold = 1;
maxcnt = 0;
case TCL_CONTINUE:
result = TCL_OK;
break;
default:
goto done;
}
/*
* Don't check time up to threshold.
*/
if (--threshold > 0) {
continue;
}
/*
* Check stop time reached, estimate new threshold.
*/
#ifdef TCL_WIDE_CLICKS
middle = TclpGetWideClicks();
#else
Tcl_GetTime(&now);
middle = now.sec;
middle *= 1000000;
middle += now.usec;
#endif /* TCL_WIDE_CLICKS */
if (middle >= stop || count >= maxcnt) {
break;
}
/*
* Don't calculate threshold by few iterations, because sometimes
* first iteration(s) can be too fast or slow (cached, delayed
* clean up, etc).
*/
if (count < 10) {
threshold = 1;
continue;
}
/*
* Average iteration time in microsecs.
*/
threshold = (middle - start) / count;
if (threshold > maxIterTm) {
maxIterTm = threshold;
/*
* Iterations seem to be longer.
*/
if (threshold > maxIterTm * 2) {
factor *= 2;
if (factor > 50) {
factor = 50;
}
} else {
if (factor < 50) {
factor++;
}
}
} else if (factor > 4) {
/*
* Iterations seem to be shorter.
*/
if (threshold < (maxIterTm / 2)) {
factor /= 2;
if (factor < 4) {
factor = 4;
}
} else {
factor--;
}
}
/*
* As relation between remaining time and time since last check,
* maximal some % of time (by factor), so avoid growing of the
* execution time if iterations are not consistent, e.g. was
* continuously on time).
*/
threshold = ((stop - middle) / maxIterTm) / factor + 1;
if (threshold > 100000) { /* fix for too large threshold */
threshold = 100000;
}
/*
* Consider max-count
*/
if (threshold > maxcnt - count) {
threshold = maxcnt - count;
}
}
}
{
Tcl_Obj *objarr[8], **objs = objarr;
TclWideMUInt usec, val;
int digits;
/*
* Absolute execution time in microseconds or in wide clicks.
*/
usec = (TclWideMUInt)(middle - start);
#ifdef TCL_WIDE_CLICKS
/*
* convert execution time (in wide clicks) to microsecs.
*/
usec *= TclpWideClickInMicrosec();
#endif /* TCL_WIDE_CLICKS */
if (!count) { /* no iterations - avoid divide by zero */
objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
goto retRes;
}
/*
* If not calibrating...
*/
if (!calibrate) {
/*
* Minimize influence of measurement overhead.
*/
if (overhead > 0) {
/*
* Estimate the time of overhead (microsecs).
*/
TclWideMUInt curOverhead = overhead * count;
if (usec > curOverhead) {
usec -= curOverhead;
} else {
usec = 0;
}
}
} else {
/*
* Calibration: obtaining new measurement overhead.
*/
if (measureOverhead > ((double) usec) / count) {
measureOverhead = ((double) usec) / count;
}
objs[0] = Tcl_NewDoubleObj(measureOverhead);
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
objs += 2;
}
val = usec / count; /* microsecs per iteration */
if (val >= 1000000) {
objs[0] = Tcl_NewWideIntObj(val);
} else {
if (val < 10) {
digits = 6;
} else if (val < 100) {
digits = 4;
} else if (val < 1000) {
digits = 3;
} else if (val < 10000) {
digits = 2;
} else {
digits = 1;
}
objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) usec)/count);
}
objs[2] = Tcl_NewWideIntObj(count); /* iterations */
/*
* Calculate speed as rate (count) per sec
*/
if (!usec) {
usec++; /* Avoid divide by zero. */
}
if (count < (WIDE_MAX / 1000000)) {
val = (count * 1000000) / usec;
if (val < 100000) {
if (val < 100) {
digits = 3;
} else if (val < 1000) {
digits = 2;
} else {
digits = 1;
}
objs[4] = Tcl_ObjPrintf("%.*f",
digits, ((double) (count * 1000000)) / usec);
} else {
objs[4] = Tcl_NewWideIntObj(val);
}
} else {
objs[4] = Tcl_NewWideIntObj((count / usec) * 1000000);
}
retRes:
/*
* Estimated net execution time (in millisecs).
*/
if (!calibrate) {
if (usec >= 1) {
objs[6] = Tcl_ObjPrintf("%.3f", (double)usec / 1000);
} else {
objs[6] = Tcl_NewWideIntObj(0);
}
TclNewLiteralStringObj(objs[7], "net-ms");
}
/*
* Construct the result as a list because many programs have always
* parsed as such (extracting the first element, typically).
*/
TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
TclNewLiteralStringObj(objs[3], "#");
TclNewLiteralStringObj(objs[5], "#/sec");
Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
}
done:
if (codePtr != NULL) {
if ( codeOptimized
&& codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
) {
codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
}
TclReleaseByteCode(codePtr);
}
return result;
}
/*
*----------------------------------------------------------------------
*
+294 -193
View File
@@ -152,10 +152,6 @@ static void FreeJumptableInfo(ClientData clientData);
static void PrintJumptableInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
static int LocalScalarFromToken(Tcl_Token *tokenPtr,
CompileEnv *envPtr);
static int LocalScalar(const char *bytes, int numBytes,
CompileEnv *envPtr);
static int PushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
@@ -383,7 +379,8 @@ TclCompileCatchCmd(
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
int resultIndex, optsIndex, range;
const char *name;
int resultIndex, optsIndex, nameChars, range;
int initStackDepth = envPtr->currStackDepth;
int savedStackDepth;
DefineLineInformation; /* TIP #280 */
@@ -397,6 +394,15 @@ TclCompileCatchCmd(
return TCL_ERROR;
}
/*
* If variables were specified and the catch command is at global level
* (not in a procedure), don't compile it inline: the payoff is too small.
*/
if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) {
return TCL_ERROR;
}
/*
* Make sure the variable names, if any, have no substitutions and just
* refer to local scalars.
@@ -406,14 +412,35 @@ TclCompileCatchCmd(
cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
if (parsePtr->numWords >= 3) {
resultNameTokenPtr = TokenAfter(cmdTokenPtr);
resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
/* DGP */
if (resultNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
name = resultNameTokenPtr[1].start;
nameChars = resultNameTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
resultNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
if (resultIndex < 0) {
return TCL_ERROR;
}
/* DKF */
if (parsePtr->numWords == 4) {
optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
name = optsNameTokenPtr[1].start;
nameChars = optsNameTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
optsNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
if (optsIndex < 0) {
return TCL_ERROR;
}
@@ -655,15 +682,18 @@ TclCompileDictSetCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *varTokenPtr;
int i, dictVarIndex;
Tcl_Token *tokenPtr;
Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
int i, dictVarIndex, nameChars;
const char *name;
/*
* There must be at least three arguments after the (sub-)command.
* There must be at least one argument after the command.
*/
if (parsePtr->numWords < 4) {
if (parsePtr->numWords < 4 || procPtr == NULL) {
return TCL_ERROR;
}
@@ -674,10 +704,15 @@ TclCompileDictSetCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
if (dictVarIndex < 0) {
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
name = varTokenPtr[1].start;
nameChars = varTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
/*
* Remaining words (key path and value to set) can be handled normally.
@@ -707,17 +742,49 @@ TclCompileDictIncrCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *keyTokenPtr;
int dictVarIndex, incrAmount;
Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *keyTokenPtr;
int dictVarIndex, nameChars, incrAmount;
const char *name;
/*
* There must be at least two arguments after the command.
*/
if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
if (parsePtr->numWords < 3 || parsePtr->numWords > 4 || procPtr == NULL) {
return TCL_ERROR;
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
keyTokenPtr = TokenAfter(varTokenPtr);
/*
* Parse the increment amount, if present.
*/
if (parsePtr->numWords == 4) {
const char *word;
int numBytes, code;
Tcl_Token *incrTokenPtr;
Tcl_Obj *intObj;
incrTokenPtr = TokenAfter(keyTokenPtr);
if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
word = incrTokenPtr[1].start;
numBytes = incrTokenPtr[1].size;
intObj = Tcl_NewStringObj(word, numBytes);
Tcl_IncrRefCount(intObj);
code = TclGetIntFromObj(NULL, intObj, &incrAmount);
TclDecrRefCount(intObj);
if (code != TCL_OK) {
return TCL_ERROR;
}
} else {
incrAmount = 1;
}
/*
* The dictionary variable must be a local scalar that is knowable at
@@ -725,30 +792,15 @@ TclCompileDictIncrCmd(
* discover what the index is.
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
if (dictVarIndex < 0) {
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
keyTokenPtr = TokenAfter(varTokenPtr);
/*
* Parse the increment amount, if present.
*/
if (parsePtr->numWords == 4) {
Tcl_Token *incrTokenPtr = TokenAfter(keyTokenPtr);
Tcl_Obj *intObj = Tcl_NewObj();
int fail = (!TclWordKnownAtCompileTime(incrTokenPtr, intObj)
|| TCL_ERROR == TclGetIntFromObj(NULL, intObj, &incrAmount));
Tcl_DecrRefCount(intObj);
if (fail) {
return TCL_ERROR;
}
} else {
incrAmount = 1;
name = varTokenPtr[1].start;
nameChars = varTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
/*
* Emit the key and the code to actually do the increment.
@@ -805,19 +857,19 @@ TclCompileDictForCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, loopRange, catchRange;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
int numVars, endTargetOffset, numBytes;
const char *bytes;
int numVars, endTargetOffset;
int savedStackDepth = envPtr->currStackDepth;
/* Needed because jumps confuse the stack
* space calculator. */
Tcl_Obj *varNameObj, *varListObj = NULL;
DefineLineInformation; /* TIP #280 */
const char **argv;
Tcl_DString buffer;
/*
* There must be exactly three arguments after the command.
* There must be at least three argument after the command.
*/
if (parsePtr->numWords != 4 || procPtr == NULL) {
@@ -827,8 +879,8 @@ TclCompileDictForCmd(
varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
dictTokenPtr = TokenAfter(varsTokenPtr);
bodyTokenPtr = TokenAfter(dictTokenPtr);
if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
@@ -837,31 +889,33 @@ TclCompileDictForCmd(
* Then extract their indices in the LVT.
*/
varListObj = Tcl_NewObj();
if (!TclWordKnownAtCompileTime(varsTokenPtr, varListObj) ||
TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
numVars != 2) {
Tcl_DecrRefCount(varListObj);
Tcl_DStringInit(&buffer);
Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size);
if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
&argv) != TCL_OK) {
Tcl_DStringFree(&buffer);
return TCL_ERROR;
}
Tcl_DStringFree(&buffer);
if (numVars != 2) {
ckfree((char *) argv);
return TCL_ERROR;
}
Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj);
bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
keyVarIndex = LocalScalar(bytes, numBytes, envPtr);
if (keyVarIndex < 0) {
Tcl_DecrRefCount(varListObj);
nameChars = strlen(argv[0]);
if (!TclIsLocalScalar(argv[0], nameChars)) {
ckfree((char *) argv);
return TCL_ERROR;
}
keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr);
Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj);
bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
valueVarIndex = LocalScalar(bytes, numBytes, envPtr);
if (valueVarIndex < 0) {
Tcl_DecrRefCount(varListObj);
nameChars = strlen(argv[1]);
if (!TclIsLocalScalar(argv[1], nameChars)) {
ckfree((char *) argv);
return TCL_ERROR;
}
Tcl_DecrRefCount(varListObj);
valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr);
ckfree((char *) argv);
/*
* Allocate a temporary variable to store the iterator reference. The
@@ -1001,11 +1055,21 @@ TclCompileDictUpdateCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
int i, dictIndex, numVars, range, infoIndex;
Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
const char *name;
int i, nameChars, dictIndex, numVars, range, infoIndex;
Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
DictUpdateInfo *duiPtr;
JumpFixup jumpFixup;
DefineLineInformation; /* TIP #280 */
/*
* There must be at least one argument after the command.
*/
if (parsePtr->numWords < 5 || procPtr == NULL) {
return TCL_ERROR;
}
/*
* Parse the command. Expect the following:
@@ -1016,9 +1080,6 @@ TclCompileDictUpdateCmd(
return TCL_ERROR;
}
numVars = (parsePtr->numWords - 3) / 2;
if (numVars < 1) {
return TCL_ERROR;
}
/*
* The dictionary variable must be a local scalar that is knowable at
@@ -1027,10 +1088,15 @@ TclCompileDictUpdateCmd(
*/
dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr);
if (dictIndex < 0) {
if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
name = dictVarTokenPtr[1].start;
nameChars = dictVarTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
/*
* Assemble the instruction metadata. This is complex enough that it is
@@ -1046,8 +1112,6 @@ TclCompileDictUpdateCmd(
tokenPtr = TokenAfter(dictVarTokenPtr);
for (i=0 ; i<numVars ; i++) {
int index;
/*
* Put keys to one side for later compilation to bytecode.
*/
@@ -1059,8 +1123,14 @@ TclCompileDictUpdateCmd(
*/
tokenPtr = TokenAfter(tokenPtr);
index = LocalScalarFromToken(tokenPtr, envPtr);
if (index < 0) {
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
ckfree((char *) duiPtr);
TclStackFree(interp, keyTokenPtrs);
return TCL_ERROR;
}
name = tokenPtr[1].start;
nameChars = tokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
ckfree((char *) duiPtr);
TclStackFree(interp, keyTokenPtrs);
return TCL_ERROR;
@@ -1070,7 +1140,8 @@ TclCompileDictUpdateCmd(
* Stash the index in the auxiliary data.
*/
duiPtr->varIndices[i] = index;
duiPtr->varIndices[i] =
TclFindCompiledLocal(name, nameChars, 1, procPtr);
tokenPtr = TokenAfter(tokenPtr);
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
@@ -1151,17 +1222,18 @@ TclCompileDictAppendCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i, dictVarIndex;
DefineLineInformation; /* TIP #280 */
/*
* There must be at least two argument after the command. Since we
* implement using INST_CONCAT1, make sure the number of arguments
* stays within its range.
* There must be at least two argument after the command. And we impose an
* (arbirary) safe limit; anyone exceeding it should stop worrying about
* speed quite so much. ;-)
*/
if (parsePtr->numWords<4 || parsePtr->numWords>258) {
if (parsePtr->numWords<4 || parsePtr->numWords>100 || procPtr==NULL) {
return TCL_ERROR;
}
@@ -1170,9 +1242,16 @@ TclCompileDictAppendCmd(
*/
tokenPtr = TokenAfter(parsePtr->tokenPtr);
dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
if (dictVarIndex < 0) {
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
} else {
register const char *name = tokenPtr[1].start;
register int nameChars = tokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
}
/*
@@ -1205,25 +1284,32 @@ TclCompileDictLappendCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
int dictVarIndex;
Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
int dictVarIndex, nameChars;
const char *name;
/*
* There must be three arguments after the command.
*/
if (parsePtr->numWords != 4) {
if (parsePtr->numWords != 4 || procPtr == NULL) {
return TCL_ERROR;
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
keyTokenPtr = TokenAfter(varTokenPtr);
valueTokenPtr = TokenAfter(keyTokenPtr);
dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
if (dictVarIndex < 0) {
if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
name = varTokenPtr[1].start;
nameChars = varTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
CompileWord(envPtr, keyTokenPtr, interp, 2);
CompileWord(envPtr, valueTokenPtr, interp, 3);
TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
@@ -1529,18 +1615,30 @@ TclCompileForeachCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr = NULL;/* Points to the structure describing this
ForeachInfo *infoPtr; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
int firstValueTemp; /* Index of the first temp var in the frame
* used to point to a value list. */
int loopCtTemp; /* Index of temp var holding the loop's
* iteration count. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
unsigned char *jumpPc;
JumpFixup jumpFalseFixup;
int jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, tempVar, i, j, code = TCL_OK;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
int savedStackDepth = envPtr->currStackDepth;
Tcl_Obj *varListObj = NULL;
DefineLineInformation; /* TIP #280 */
/*
* We parse the variable list argument words and create two arrays:
* varcList[i] is number of variables in i-th var list.
* varvList[i] points to array of var names in i-th var list.
*/
int *varcList;
const char ***varvList;
/*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
@@ -1569,32 +1667,51 @@ TclCompileForeachCmd(
}
/*
* Create and initialize the ForeachInfo and ForeachVarList data
* structures describing this command. Then create a AuxData record
* pointing to the ForeachInfo structure.
* Allocate storage for the varcList and varvList arrays if necessary.
*/
numLists = (numWords - 2)/2;
infoPtr = (ForeachInfo *) ckalloc((unsigned)
sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
infoPtr->numLists = 0; /* Count this up as we go */
varcList = (int *) TclStackAlloc(interp, numLists * sizeof(int));
memset(varcList, 0, numLists * sizeof(int));
varvList = (const char ***) TclStackAlloc(interp,
numLists * sizeof(const char **));
memset((char*) varvList, 0, numLists * sizeof(const char **));
/*
* Parse each var list into sequence of var names. Don't
* Break up each var list and set the varcList and varvList arrays. Don't
* compile the foreach inline if any var name needs substitutions or isn't
* a scalar, or if any var list needs substitutions.
*/
varListObj = Tcl_NewObj();
loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
ForeachVarList *varListPtr;
int numVars;
Tcl_DString varList;
if (i%2 != 1) {
continue;
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
code = TCL_ERROR;
goto done;
}
/*
* Lots of copying going on here. Need a ListObj wizard to show a
* better way.
*/
Tcl_DStringInit(&varList);
Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
if (code != TCL_OK) {
code = TCL_ERROR;
goto done;
}
numVars = varcList[loopIndex];
/*
* If the variable list is empty, we can enter an infinite loop when
@@ -1602,37 +1719,25 @@ TclCompileForeachCmd(
* not happen. [Bug 1671138]
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
numVars == 0) {
if (numVars == 0) {
code = TCL_ERROR;
goto done;
}
varListPtr = (ForeachVarList *) ckalloc((unsigned)
sizeof(ForeachVarList) + numVars*sizeof(int));
varListPtr->numVars = numVars;
infoPtr->varLists[i/2] = varListPtr;
infoPtr->numLists++;
for (j = 0; j < numVars; j++) {
Tcl_Obj *varNameObj;
int numBytes;
const char *bytes;
const char *varName = varvList[loopIndex][j];
Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
varListPtr->varIndexes[j] = LocalScalar(bytes, numBytes, envPtr);
if (varListPtr->varIndexes[j] < 0) {
if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
code = TCL_ERROR;
goto done;
}
}
Tcl_SetObjLength(varListObj, 0);
loopIndex++;
}
/*
* Reserve (numLists + 1) temporary variables:
* We will compile the foreach command. Reserve (numLists + 1) temporary
* variables:
* - numLists temps to hold each value list
* - 1 temp for the loop counter (index of next element in each list)
*
@@ -1640,13 +1745,44 @@ TclCompileForeachCmd(
* nonoverlapping foreach loops, they don't share any temps.
*/
tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr);
infoPtr->firstValueTemp = tempVar;
for (i= 1; i < numLists; i++) {
TclFindCompiledLocal(NULL, 0, 1, procPtr);
code = TCL_OK;
firstValueTemp = -1;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
/*create*/ 1, procPtr);
if (loopIndex == 0) {
firstValueTemp = tempVar;
}
}
infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr);
loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
/*create*/ 1, procPtr);
/*
* Create and initialize the ForeachInfo and ForeachVarList data
* structures describing this command. Then create a AuxData record
* pointing to the ForeachInfo structure.
*/
infoPtr = (ForeachInfo *) ckalloc((unsigned)
sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
infoPtr->numLists = numLists;
infoPtr->firstValueTemp = firstValueTemp;
infoPtr->loopCtTemp = loopCtTemp;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
ForeachVarList *varListPtr;
numVars = varcList[loopIndex];
varListPtr = (ForeachVarList *) ckalloc((unsigned)
sizeof(ForeachVarList) + numVars*sizeof(int));
varListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
const char *varName = varvList[loopIndex][j];
int nameChars = strlen(varName);
varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
nameChars, /*create*/ 1, procPtr);
}
infoPtr->varLists[loopIndex] = varListPtr;
}
infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
/*
@@ -1659,19 +1795,21 @@ TclCompileForeachCmd(
* Evaluate then store each value list in the associated temporary.
*/
loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
if ((i%2 == 0) && (i > 0)) {
SetLineInformation (i);
CompileTokens(envPtr, tokenPtr, interp);
tempVar = (firstValueTemp + loopIndex);
if (tempVar <= 255) {
TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
} else {
TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
}
TclEmitOpcode(INST_POP, envPtr);
tempVar++;
loopIndex++;
}
}
@@ -1757,14 +1895,13 @@ TclCompileForeachCmd(
envPtr->currStackDepth = savedStackDepth + 1;
done:
if (code == TCL_ERROR) {
if (infoPtr) {
FreeForeachInfo(infoPtr);
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
if (varvList[loopIndex] != NULL) {
ckfree((char *) varvList[loopIndex]);
}
}
if (varListObj) {
Tcl_DecrRefCount(varListObj);
}
TclStackFree(interp, (void *)varvList);
TclStackFree(interp, varcList);
return code;
}
@@ -4702,55 +4839,6 @@ TclCompileWhileCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* LocalScalar(FromToken) --
*
* Get the index into the table of compiled locals that corresponds
* to a local scalar variable name.
*
* Results:
* Returns the non-negative integer index value into the table of
* compiled locals corresponding to a local scalar variable name.
* If the arguments passed in do not identify a local scalar variable
* then return -1.
*
* Side effects:
* May add an entry into the table of compiled locals.
*
*----------------------------------------------------------------------
*/
static int
LocalScalarFromToken(
Tcl_Token *tokenPtr,
CompileEnv *envPtr)
{
int isSimple, isScalar, index;
PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &index,
&isSimple, &isScalar, 0 /* ignored */, NULL /* ignored */);
if (!isScalar) {
index = -1;
}
return index;
}
static int
LocalScalar(
const char *bytes,
int numBytes,
CompileEnv *envPtr)
{
Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
{TCL_TOKEN_TEXT, NULL, 0, 0}};
token[1].start = bytes;
token[1].size = numBytes;
return LocalScalarFromToken(token, envPtr);
}
/*
*----------------------------------------------------------------------
*
@@ -4802,7 +4890,16 @@ PushVarName(
nameChars = elNameChars = 0;
localIndex = -1;
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
* Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
* curly braces surround the variable name. This really matters for array
* elements to handle things like
* set {x($foo)} 5
* which raises an undefined var error if we are not careful here.
*/
if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
(varTokenPtr->start[0] != '{')) {
/*
* A simple variable name. Divide it up into "name" and "elName"
* strings. If it is not a local variable, look it up at runtime.
@@ -4826,7 +4923,7 @@ PushVarName(
}
}
if (interp && (elName != NULL) && elNameChars) {
if ((elName != NULL) && elNameChars) {
/*
* An array element, the element name is a simple string:
* assemble the corresponding token.
@@ -4842,7 +4939,7 @@ PushVarName(
elemTokenCount = 1;
}
}
} else if (interp && ((n = varTokenPtr->numComponents) > 1)
} else if (((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
@@ -4879,7 +4976,7 @@ PushVarName(
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
if (remainingChars) {
/*
@@ -4944,7 +5041,7 @@ PushVarName(
localIndex = -1;
}
}
if (interp && localIndex < 0) {
if (localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
@@ -4952,7 +5049,7 @@ PushVarName(
* Compile the element script, if any.
*/
if (interp && elName != NULL) {
if (elName != NULL) {
if (elNameChars) {
envPtr->line = line;
envPtr->clNext = clNext;
@@ -4961,7 +5058,7 @@ PushVarName(
PushLiteral(envPtr, "", 0);
}
}
} else if (interp) {
} else {
/*
* The var name isn't simple: compile and push it.
*/
@@ -5682,7 +5779,7 @@ TclCompileUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
int simpleVarName, isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
Tcl_Obj *objPtr;
@@ -5745,8 +5842,10 @@ TclCompileUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
if (localIndex < 0) {
PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar, i+1);
if((localIndex < 0) || !isScalar) {
return TCL_ERROR;
}
TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
@@ -5790,7 +5889,7 @@ TclCompileNamespaceCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
int simpleVarName, isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
@@ -5835,8 +5934,10 @@ TclCompileNamespaceCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
if (localIndex < 0) {
PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar, i+1);
if((localIndex < 0) || !isScalar) {
return TCL_ERROR;
}
TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
@@ -5913,7 +6014,7 @@ TclCompileGlobalCmd(
return TCL_ERROR;
}
/* TODO: Consider what values can pass through the
/* TODO: Consider what values can pass through the
* IndexTailVarIfKnown() screen. Full CompileWord()
* likely does not apply here. Push known value instead. */
CompileWord(envPtr, varTokenPtr, interp, i);
@@ -5988,7 +6089,7 @@ TclCompileVariableCmd(
return TCL_ERROR;
}
/* TODO: Consider what values can pass through the
/* TODO: Consider what values can pass through the
* IndexTailVarIfKnown() screen. Full CompileWord()
* likely does not apply here. Push known value instead. */
CompileWord(envPtr, varTokenPtr, interp, i);
+30 -30
View File
@@ -574,12 +574,12 @@ ParseExpr(
{
OpNode *nodes = NULL; /* Pointer to the OpNode storage array where
* we build the parse tree. */
unsigned nodesAvailable = 64; /* Initial size of the storage array. This
int nodesAvailable = 64; /* Initial size of the storage array. This
* value establishes a minimum tree memory cost
* of only about 1 kibyte, and is large enough
* for most expressions to parse with no need
* for array growth and reallocation. */
unsigned nodesUsed = 0; /* Number of OpNodes filled. */
int nodesUsed = 0; /* Number of OpNodes filled. */
int scanned = 0; /* Capture number of byte scanned by
* parsing routines. */
int lastParsed; /* Stores info about what the lexeme parsed
@@ -658,14 +658,12 @@ ParseExpr(
*/
if (nodesUsed >= nodesAvailable) {
unsigned size = nodesUsed * 2;
OpNode *newPtr = NULL;
int size = nodesUsed * 2;
OpNode *newPtr;
do {
if (size <= UINT_MAX/sizeof(OpNode)) {
newPtr = (OpNode *) attemptckrealloc((char *) nodes,
(unsigned int) size * sizeof(OpNode));
}
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
@@ -1885,7 +1883,7 @@ ParseLexeme(
case 'i':
if ((numBytes > 1) && (start[1] == 'n')
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
/*
* Must make this check so we can tell the difference between
@@ -1900,15 +1898,14 @@ ParseLexeme(
case 'e':
if ((numBytes > 1) && (start[1] == 'q')
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
*lexemePtr = STREQ;
return 2;
}
break;
case 'n':
if ((numBytes > 1)
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
switch (start[1]) {
case 'e':
*lexemePtr = STRNEQ;
@@ -1923,7 +1920,8 @@ ParseLexeme(
literal = Tcl_NewObj();
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
if (end < start + numBytes && !TclIsBareword(*end)) {
if (end < start + numBytes && !isalnum(UCHAR(*end))
&& UCHAR(*end) != '_') {
number:
TclInitStringRep(literal, start, end-start);
@@ -1947,7 +1945,7 @@ ParseLexeme(
if (literal->typePtr == &tclDoubleType) {
const char *p = start;
while (p < end) {
if (!TclIsBareword(*p++)) {
if (!isalnum(UCHAR(*p++))) {
/*
* The number has non-bareword characters, so we
* must treat it as a number.
@@ -1971,29 +1969,31 @@ ParseLexeme(
}
}
/*
* We reject leading underscores in bareword. No sensible reason why.
* Might be inspired by reserved identifier rules in C, which of course
* have no direct relevance here.
*/
if (!TclIsBareword(*start) || *start == '_') {
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
if (!isalnum(UCHAR(ch))) {
*lexemePtr = INVALID;
Tcl_DecrRefCount(literal);
return scanned;
}
end = start;
while (numBytes && TclIsBareword(*end)) {
end += 1;
numBytes -= 1;
while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
end += scanned;
numBytes -= scanned;
if (Tcl_UtfCharComplete(end, numBytes)) {
scanned = Tcl_UtfToUniChar(end, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, end, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
}
*lexemePtr = BAREWORD;
if (literalPtr) {
+3 -5
View File
@@ -2288,8 +2288,8 @@ TclFindCompiledLocal(
* scalar or array variable. If NULL, a
* temporary var should be created. */
int nameBytes, /* Number of bytes in the name. */
int create, /* If non-zero, allocate a local frame entry
* for the variable if it is new. */
int create, /* If 1, allocate a local frame entry for the
* variable if it is new. */
register Proc *procPtr) /* Points to structure describing procedure
* containing the variable reference. */
{
@@ -2602,10 +2602,8 @@ EnterCmdWordData(
TclAdvanceLines (&wordLine, last, tokenPtr->start);
TclAdvanceContinuations (&wordLine, &wordNext,
tokenPtr->start - envPtr->source);
/* See Ticket 4b61afd660 */
wwlines[wordIdx] =
((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
? wordLine : -1;
(TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
ePtr->line[wordIdx] = wordLine;
ePtr->next[wordIdx] = wordNext;
last = tokenPtr->start;
-22
View File
@@ -859,9 +859,6 @@ MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp,
*----------------------------------------------------------------
*/
MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
const CmdFrame *invoker, int word);
MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
const CmdFrame *invoker, int word);
@@ -940,25 +937,6 @@ MODULE_SCOPE void TclPrintSource(FILE *outFile,
CONST char *string, int maxChars);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
static inline void
TclPreserveByteCode(
register ByteCode *codePtr)
{
codePtr->refCount++;
}
static inline void
TclReleaseByteCode(
register ByteCode *codePtr)
{
if (codePtr->refCount-- > 1) {
return;
}
/* Just dropped to refcount==0. Clean up. */
TclCleanupByteCode(codePtr);
}
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
+8 -2
View File
@@ -359,8 +359,14 @@ typedef short int yytype_int16;
#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
# define YYSIZE_T __SIZE_TYPE__
# else
# elif defined size_t
# define YYSIZE_T size_t
# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
# define YYSIZE_T size_t
# else
# define YYSIZE_T unsigned int
# endif
#endif
@@ -1348,7 +1354,7 @@ yyparse (info)
int yychar;
/* The semantic value of the look-ahead symbol. */
YYSTYPE yylval = {0};
YYSTYPE yylval;
/* Number of syntax errors so far. */
int yynerrs;
+1 -1
View File
@@ -593,7 +593,7 @@ SetDictFromAny(
}
for (i=0 ; i<objc ; i+=2) {
/* Store key and value in the hash table we're building. */
hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
+2 -3
View File
@@ -979,7 +979,7 @@ Tcl_GetEncodingNames(
* Side effects:
* The reference count of the new system encoding is incremented. The
* reference count of the old system encoding is decremented and it may
* be freed. All VFS cached information is invalidated.
* be freed.
*
*------------------------------------------------------------------------
*/
@@ -1010,7 +1010,6 @@ Tcl_SetSystemEncoding(
FreeEncoding(systemEncoding);
systemEncoding = encoding;
Tcl_MutexUnlock(&encodingMutex);
Tcl_FSMountsChanged(NULL);
return TCL_OK;
}
@@ -2284,7 +2283,7 @@ UtfToUtfProc(
*dst++ = *src++;
} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
UCHAR(*(src+1)) == 0x80) {
/*
* Convert 0xc080 to real nulls when we are in output mode.
*/
+99 -1
View File
@@ -43,6 +43,11 @@ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
static void ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
#if defined(__CYGWIN__)
static void TclCygwinPutenv(char *string);
# define putenv TclCygwinPutenv
#endif
/*
*----------------------------------------------------------------------
@@ -389,7 +394,7 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
#if defined(__WIN32__)
#if defined(__WIN32__) || defined(__CYGWIN__)
string = ckalloc((unsigned) length+2);
memcpy(string, name, (size_t) length);
string[length] = '=';
@@ -683,6 +688,99 @@ TclFinalizeEnvironment(void)
}
}
#if defined(__CYGWIN__)
/*
* When using cygwin, when an environment variable changes, we need to synch
* with both the cygwin environment (in case the application C code calls
* fork) and the Windows environment (in case the application TCL code calls
* exec, which calls the Windows CreateProcess function).
*/
DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
static void
TclCygwinPutenv(
char *str)
{
char *name, *value;
/*
* Get the name and value, so that we can change the environment variable
* for Windows.
*/
name = alloca(strlen(str) + 1);
strcpy(name, str);
for (value=name ; *value!='=' && *value!='\0' ; ++value) {
/* Empty body */
}
if (*value == '\0') {
/* Can't happen. */
return;
}
*value = '\0';
++value;
if (*value == '\0') {
value = NULL;
}
/*
* Set the cygwin environment variable.
*/
#undef putenv
if (value == NULL) {
unsetenv(name);
} else {
putenv(str);
}
/*
* Before changing the environment variable in Windows, if this is PATH,
* we need to convert the value back to a Windows style path.
*
* FIXME: The calling program may know it is running under windows, and
* may have set the path to a Windows path, or, worse, appended or
* prepended a Windows path to PATH.
*/
if (strcmp(name, "PATH") != 0) {
/*
* If this is Path, eliminate any PATH variable, to prevent any
* confusion.
*/
if (strcmp(name, "Path") == 0) {
SetEnvironmentVariableA("PATH", NULL);
unsetenv("PATH");
}
SetEnvironmentVariableA(name, value);
} else {
char *buf;
/*
* Eliminate any Path variable, to prevent any confusion.
*/
SetEnvironmentVariableA("Path", NULL);
unsetenv("Path");
if (value == NULL) {
buf = NULL;
} else {
int size;
size = cygwin_conv_path_list(0, value, NULL, 0);
buf = alloca(size + 1);
cygwin_conv_path_list(0, value, buf, size);
}
SetEnvironmentVariableA(name, buf);
}
}
#endif /* __CYGWIN__ */
/*
* Local Variables:
* mode: c
+11 -13
View File
@@ -259,7 +259,7 @@ HandleBgErrors(
if (errChannel != (Tcl_Channel) NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
Tcl_Obj *keyPtr, *valuePtr = NULL;
Tcl_Obj *keyPtr, *valuePtr;
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
@@ -311,7 +311,7 @@ TclDefaultBgErrorHandlerObjCmd(
{
Tcl_Obj *keyPtr, *valuePtr;
Tcl_Obj *tempObjv[2];
int result, code, level;
int code, level;
Tcl_InterpState saved;
if (objc != 3) {
@@ -325,9 +325,9 @@ TclDefaultBgErrorHandlerObjCmd(
TclNewLiteralStringObj(keyPtr, "-level");
Tcl_IncrRefCount(keyPtr);
result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (result != TCL_OK || valuePtr == NULL) {
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
return TCL_ERROR;
@@ -337,9 +337,9 @@ TclDefaultBgErrorHandlerObjCmd(
}
TclNewLiteralStringObj(keyPtr, "-code");
Tcl_IncrRefCount(keyPtr);
result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (result != TCL_OK || valuePtr == NULL) {
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
return TCL_ERROR;
@@ -394,17 +394,17 @@ TclDefaultBgErrorHandlerObjCmd(
TclNewLiteralStringObj(keyPtr, "-errorcode");
Tcl_IncrRefCount(keyPtr);
result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (result == TCL_OK && valuePtr != NULL) {
if (valuePtr) {
Tcl_SetObjErrorCode(interp, valuePtr);
}
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (result == TCL_OK && valuePtr != NULL) {
if (valuePtr) {
Tcl_AppendObjToErrorInfo(interp, valuePtr);
}
@@ -418,7 +418,7 @@ TclDefaultBgErrorHandlerObjCmd(
*/
saved = Tcl_SaveInterpState(interp, code);
/* Invoke the bgerror command. */
Tcl_AllowExceptions(interp);
code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL);
@@ -1379,8 +1379,6 @@ VwaitVarProc(
int *donePtr = (int *) clientData;
*donePtr = 1;
Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, clientData);
return NULL;
}
+310 -220
View File
@@ -75,7 +75,9 @@ int tclTraceExec = 0;
static const char *const operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!"
"+", "-", "*", "/", "%", "+", "-", "~", "!",
"BUILTIN FUNCTION", "FUNCTION",
"", "", "", "", "", "", "", "", "eq", "ne"
};
/*
@@ -280,8 +282,6 @@ VarHashCreateVar(
#define CURR_DEPTH (tosPtr - initTosPtr)
#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
/*
* Macros used to trace instruction execution. The macros TRACE,
* TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
@@ -363,7 +363,9 @@ VarHashCreateVar(
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))? TCL_ERROR : \
((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#else
@@ -383,7 +385,9 @@ VarHashCreateVar(
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))? TCL_ERROR : \
((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#endif
@@ -613,7 +617,7 @@ static void DeleteExecStack(ExecStack *esPtr);
static void DupExprCodeInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
static void FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int searchMode,
static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int catchOnly,
ByteCode *codePtr);
static const char * GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr,
int *lengthPtr);
@@ -720,7 +724,7 @@ TclCreateExecEnv(
esPtr->nextPtr = NULL;
esPtr->markerPtr = NULL;
esPtr->endPtr = &esPtr->stackWords[TCL_STACK_INITIAL_SIZE-1];
esPtr->tosPtr = STACK_BASE(esPtr);
esPtr->tosPtr = &esPtr->stackWords[-1];
Tcl_MutexLock(&execMutex);
if (!execInitialized) {
@@ -820,12 +824,12 @@ TclFinalizeExecution(void)
}
/*
* Auxiliary code to insure that GrowEvaluationStack always returns correctly
* Auxiliary code to insure that GrowEvaluationStack always returns correctly
* aligned memory.
*
* WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
* represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
* multiple of the wordsize 'sizeof(Tcl_Obj *)'.
* multiple of the wordsize 'sizeof(Tcl_Obj *)'.
*/
#define WALLOCALIGN \
@@ -847,7 +851,7 @@ wordSkip(
}
/*
* Given a marker, compute where the following aligned memory starts.
* Given a marker, compute where the following aligned memory starts.
*/
#define MEMSTART(markerPtr) \
@@ -900,13 +904,13 @@ GrowEvaluationStack(
if (needed + offset < 0) {
/*
* Put a marker pointing to the previous marker in this stack, and
* Put a marker pointing to the previous marker in this stack, and
* store it in esPtr as the current marker. Return a pointer to
* the start of aligned memory.
*/
esPtr->markerPtr = tmpMarkerPtr;
memStart = tmpMarkerPtr + offset;
memStart = tmpMarkerPtr + offset;
esPtr->tosPtr = memStart - 1;
*esPtr->markerPtr = (Tcl_Obj *) markerPtr;
return memStart;
@@ -932,8 +936,8 @@ GrowEvaluationStack(
if (esPtr->nextPtr) {
oldPtr = esPtr;
esPtr = oldPtr->nextPtr;
currElems = esPtr->endPtr - STACK_BASE(esPtr);
if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) {
currElems = esPtr->endPtr - &esPtr->stackWords[-1];
if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
Tcl_Panic("STACK: Stack after current is in use");
}
if (esPtr->nextPtr) {
@@ -945,7 +949,7 @@ GrowEvaluationStack(
DeleteExecStack(esPtr);
esPtr = oldPtr;
} else {
currElems = esPtr->endPtr - STACK_BASE(esPtr);
currElems = esPtr->endPtr - &esPtr->stackWords[-1];
}
/*
@@ -980,7 +984,7 @@ GrowEvaluationStack(
esPtr->markerPtr = &esPtr->stackWords[0];
memStart = MEMSTART(esPtr->markerPtr);
esPtr->tosPtr = memStart - 1;
if (move) {
memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
esPtr->tosPtr += moveWords;
@@ -1087,7 +1091,7 @@ TclStackFree(
* Return to previous stack.
*/
esPtr->tosPtr = STACK_BASE(esPtr);
esPtr->tosPtr = &esPtr->stackWords[-1];
if (esPtr->prevPtr) {
eePtr->execStackPtr = esPtr->prevPtr;
}
@@ -1346,21 +1350,24 @@ FreeExprCodeInternalRep(
/*
*----------------------------------------------------------------------
*
* TclCompileObj --
* TclCompEvalObj --
*
* This procedure compiles the script contained in a Tcl_Obj.
* This procedure evaluates the script contained in a Tcl_Obj by first
* compiling it and then passing it to TclExecuteByteCode.
*
* Results:
* A pointer to the corresponding ByteCode, never NULL.
* The return value is one of the return codes defined in tcl.h (such as
* TCL_OK), and interp->objResultPtr refers to a Tcl object that either
* contains the result of executing the code or an error message.
*
* Side effects:
* The object is shimmered to bytecode type.
* Almost certainly, depending on the ByteCode's instructions.
*
*----------------------------------------------------------------------
*/
ByteCode *
TclCompileObj(
int
TclCompEvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
const CmdFrame *invoker,
@@ -1368,7 +1375,23 @@ TclCompileObj(
{
register Interp *iPtr = (Interp *) interp;
register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
int result;
Namespace *namespacePtr;
/*
* Check that the interpreter is ready to execute scripts. Note that we
* manage the interp's runlevel here: it is a small white lie (maybe), but
* saves a ++/-- pair at each invocation. Amazingly enough, the impact on
* performance is noticeable.
*/
iPtr->numLevels++;
if (TclInterpReady(interp) == TCL_ERROR) {
result = TCL_ERROR;
goto done;
}
namespacePtr = iPtr->varFramePtr->nsPtr;
/*
* If the object is not already of tclByteCodeType, compile it (and reset
@@ -1399,24 +1422,19 @@ TclCompileObj(
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
if ((Interp *) *codePtr->interpHandle != iPtr) {
Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
}
codePtr->compileEpoch = iPtr->compileEpoch;
} else {
/*
* This byteCode is invalid: free it and recompile.
*/
objPtr->typePtr->freeIntRepProc(objPtr);
goto recompileObj;
}
if ((Interp *) *codePtr->interpHandle != iPtr) {
Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
}
codePtr->compileEpoch = iPtr->compileEpoch;
}
/*
* Check that any compiled locals do refer to the current proc
* environment! If not, recompile.
*/
if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
(codePtr->procPtr == NULL) &&
(codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
goto recompileObj;
}
/*
@@ -1454,68 +1472,77 @@ TclCompileObj(
* information.
*/
if (invoker == NULL) {
return codePtr;
} else {
if (invoker) {
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
ExtCmdLoc *eclPtr;
CmdFrame *ctxCopyPtr;
int redo;
if (hePtr) {
ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
int redo = 0;
CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
if (!hePtr) {
return codePtr;
}
*ctxPtr = *invoker;
eclPtr = Tcl_GetHashValue(hePtr);
redo = 0;
ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
*ctxCopyPtr = *invoker;
if (invoker->type == TCL_LOCATION_BC) {
/*
* Note: Type BC => ctx.data.eval.path is not used.
* ctx.data.tebc.codePtr used instead
*/
TclGetSrcInfoForPc(ctxCopyPtr);
if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
if (invoker->type == TCL_LOCATION_BC) {
/*
* The reference made by 'TclGetSrcInfoForPc' is dead.
* Note: Type BC => ctx.data.eval.path is not used.
* ctx.data.tebc.codePtr used instead
*/
Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
ctxCopyPtr->data.eval.path = NULL;
TclGetSrcInfoForPc(ctxPtr);
if (ctxPtr->type == TCL_LOCATION_SOURCE) {
/*
* The reference made by 'TclGetSrcInfoForPc' is
* dead.
*/
Tcl_DecrRefCount(ctxPtr->data.eval.path);
ctxPtr->data.eval.path = NULL;
}
}
if (word < ctxPtr->nline) {
/*
* Note: We do not care if the line[word] is -1. This
* is a difference and requires a recompile (location
* changed from absolute to relative, literal is used
* fixed and through variable)
*
* Example:
* test info-32.0 using literal of info-24.8
* (dict with ... vs set body ...).
*/
redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
&& (eclPtr->start != ctxPtr->line[word]))
|| ((eclPtr->type == TCL_LOCATION_BC)
&& (ctxPtr->type == TCL_LOCATION_SOURCE));
}
TclStackFree(interp, ctxPtr);
if (redo) {
goto recompileObj;
}
}
if (word < ctxCopyPtr->nline) {
/*
* Note: We do not care if the line[word] is -1. This is a
* difference and requires a recompile (location changed from
* absolute to relative, literal is used fixed and through
* variable)
*
* Example:
* test info-32.0 using literal of info-24.8
* (dict with ... vs set body ...).
*/
redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
&& (eclPtr->start != ctxCopyPtr->line[word]))
|| ((eclPtr->type == TCL_LOCATION_BC)
&& (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
}
TclStackFree(interp, ctxCopyPtr);
if (!redo) {
return codePtr;
}
}
/*
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
*/
runCompiledObj:
codePtr->refCount++;
result = TclExecuteByteCode(interp, codePtr);
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
goto done;
}
recompileObj:
recompileObj:
iPtr->errorLine = 1;
/*
@@ -1527,75 +1554,12 @@ TclCompileObj(
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
tclByteCodeType.setFromAnyProc(interp, objPtr);
iPtr->invokeCmdFramePtr = NULL;
codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
return codePtr;
}
/*
*----------------------------------------------------------------------
*
* TclCompEvalObj --
*
* This procedure evaluates the script contained in a Tcl_Obj by first
* compiling it and then passing it to TclExecuteByteCode.
*
* Results:
* The return value is one of the return codes defined in tcl.h (such as
* TCL_OK), and interp->objResultPtr refers to a Tcl object that either
* contains the result of executing the code or an error message.
*
* Side effects:
* Almost certainly, depending on the ByteCode's instructions.
*
*----------------------------------------------------------------------
*/
goto runCompiledObj;
int
TclCompEvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
const CmdFrame *invoker,
int word)
{
register Interp *iPtr = (Interp *) interp;
register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
int result;
/*
* Check that the interpreter is ready to execute scripts. Note that we
* manage the interp's runlevel here: it is a small white lie (maybe), but
* saves a ++/-- pair at each invocation. Amazingly enough, the impact on
* performance is noticeable.
*/
iPtr->numLevels++;
if (TclInterpReady(interp) == TCL_ERROR) {
result = TCL_ERROR;
goto done;
}
/* Compile objPtr to the byte code */
codePtr = TclCompileObj(interp, objPtr, invoker, word);
/*
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
*/
codePtr->refCount++;
result = TclExecuteByteCode(interp, codePtr);
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
done:
done:
iPtr->numLevels--;
return result;
}
@@ -1816,7 +1780,7 @@ TclExecuteByteCode(
int traceInstructions = (tclTraceExec == 3);
char cmdNameBuf[21];
#endif
const char *curInstName = NULL;
char *curInstName = NULL;
/*
* The execution uses a unified stack: first the catch stack, immediately
@@ -4532,17 +4496,16 @@ TclExecuteByteCode(
Tcl_WideInt w1, w2;
#endif
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
/*
* At least one non-numeric argument - compare as strings.
*/
goto stringCompare;
}
if (type1 == TCL_NUMBER_NAN || type2 == TCL_NUMBER_NAN) {
if (type1 == TCL_NUMBER_NAN) {
/*
* NaN arg: NaN != to everything, other compares are false.
* NaN first arg: NaN != to everything, other compares are false.
*/
iResult = (*pc == INST_NEQ);
@@ -4552,6 +4515,21 @@ TclExecuteByteCode(
compare = MP_EQ;
goto convertComparison;
}
if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
/*
* At least one non-numeric argument - compare as strings.
*/
goto stringCompare;
}
if (type2 == TCL_NUMBER_NAN) {
/*
* NaN 2nd arg: NaN != to everything, other compares are false.
*/
iResult = (*pc == INST_NEQ);
goto foundResult;
}
switch (type1) {
case TCL_NUMBER_LONG:
l1 = *((const long *)ptr1);
@@ -4938,30 +4916,33 @@ TclExecuteByteCode(
}
#endif
{
mp_int big1, big2;
mp_int big2;
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if ((l1 > 0) ^ mp_isneg(&big2)) {
/* TODO: internals intrusion */
if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
/*
* Arguments are same sign; remainder is first operand.
* Arguments are opposite sign; remainder is sum.
*/
mp_clear(&big2);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
mp_int big1;
TclBNInitBignumFromLong(&big1, l1);
mp_add(&big2, &big1, &big2);
mp_clear(&big1);
objResultPtr = Tcl_NewBignumObj(&big2);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
/*
* Arguments are opposite sign; remainder is sum.
* Arguments are same sign; remainder is first operand.
*/
TclBNInitBignumFromLong(&big1, l1);
mp_add(&big2, &big1, &big2);
mp_clear(&big1);
objResultPtr = Tcl_NewBignumObj(&big2);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
mp_clear(&big2);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
}
}
#ifndef NO_WIDE_TYPE
@@ -4992,31 +4973,32 @@ TclExecuteByteCode(
NEXT_INST_F(1, 2, 1);
}
{
mp_int big1, big2;
mp_int big2;
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
/* TODO: internals intrusion */
if ((w1 > ((Tcl_WideInt) 0)) ^ mp_isneg(&big2)) {
if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
/*
* Arguments are same sign; remainder is first operand.
* Arguments are opposite sign; remainder is sum.
*/
mp_clear(&big2);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
mp_int big1;
TclBNInitBignumFromWideInt(&big1, w1);
mp_add(&big2, &big1, &big2);
mp_clear(&big1);
objResultPtr = Tcl_NewBignumObj(&big2);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
/*
* Arguments are opposite sign; remainder is sum.
* Arguments are same sign; remainder is first operand.
*/
TclBNInitBignumFromWideInt(&big1, w1);
mp_add(&big2, &big1, &big2);
mp_clear(&big1);
objResultPtr = Tcl_NewBignumObj(&big2);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
mp_clear(&big2);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
}
}
#endif
@@ -5029,7 +5011,7 @@ TclExecuteByteCode(
mp_init(&bigRemainder);
mp_div(&big1, &big2, &bigResult, &bigRemainder);
if (!mp_iszero(&bigRemainder)
&& (mp_isneg(&bigRemainder) != mp_isneg(&big2))) {
&& (bigRemainder.sign != big2.sign)) {
/*
* Convert to Tcl's integer division rules.
*/
@@ -5312,24 +5294,139 @@ TclExecuteByteCode(
}
if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
mp_int big1, big2, bigResult;
mp_int big1, big2, bigResult, *First, *Second;
int numPos;
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
/*
* Count how many positive arguments we have. If only one of the
* arguments is negative, store it in 'Second'.
*/
if (mp_cmp_d(&big1, 0) != MP_LT) {
numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
First = &big1;
Second = &big2;
} else {
First = &big2;
Second = &big1;
numPos = (mp_cmp_d(First, 0) != MP_LT);
}
mp_init(&bigResult);
switch (*pc) {
case INST_BITAND:
mp_and(&big1, &big2, &bigResult);
switch (numPos) {
case 2:
/*
* Both arguments positive, base case.
*/
mp_and(First, Second, &bigResult);
break;
case 1:
/*
* First is positive; second negative:
* P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
*/
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
mp_and(First, &bigResult, &bigResult);
break;
case 0:
/*
* Both arguments negative:
* a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
*/
mp_neg(First, First);
mp_sub_d(First, 1, First);
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_or(First, Second, &bigResult);
mp_neg(&bigResult, &bigResult);
mp_sub_d(&bigResult, 1, &bigResult);
break;
}
break;
case INST_BITOR:
mp_or(&big1, &big2, &bigResult);
switch (numPos) {
case 2:
/*
* Both arguments positive, base case.
*/
mp_or(First, Second, &bigResult);
break;
case 1:
/*
* First is positive; second negative:
* N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
*/
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
mp_and(Second, &bigResult, &bigResult);
mp_neg(&bigResult, &bigResult);
mp_sub_d(&bigResult, 1, &bigResult);
break;
case 0:
/*
* Both arguments negative:
* a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
*/
mp_neg(First, First);
mp_sub_d(First, 1, First);
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_and(First, Second, &bigResult);
mp_neg(&bigResult, &bigResult);
mp_sub_d(&bigResult, 1, &bigResult);
break;
}
break;
case INST_BITXOR:
mp_xor(&big1, &big2, &bigResult);
switch (numPos) {
case 2:
/*
* Both arguments positive, base case.
*/
mp_xor(First, Second, &bigResult);
break;
case 1:
/*
* First is positive; second negative:
* P^N = ~(P^~N) = -(P^(-N-1))-1
*/
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
mp_neg(&bigResult, &bigResult);
mp_sub_d(&bigResult, 1, &bigResult);
break;
case 0:
/*
* Both arguments negative:
* a ^ b = (~a ^ ~b) = (-a-1^-b-1)
*/
mp_neg(First, First);
mp_sub_d(First, 1, First);
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
break;
}
break;
}
@@ -5707,9 +5804,9 @@ TclExecuteByteCode(
/*
* We refuse to accept exponent arguments that exceed
* one mp_digit which means the max exponent value is
* 2**28-1 = 0x0fffffff = 268435455, which fits into
* 2**28-1 = 0x0fffffff = 268435455, which fits into
* a signed 32 bit int which is within the range of the
* long int type. This means any numeric Tcl_Obj value
* long int type. This means any numeric Tcl_Obj value
* not using TCL_NUMBER_LONG type must hold a value larger
* than we accept.
*/
@@ -6137,8 +6234,9 @@ TclExecuteByteCode(
}
mp_init(&bigRemainder);
mp_div(&big1, &big2, &bigResult, &bigRemainder);
/* TODO: internals intrusion */
if (!mp_iszero(&bigRemainder)
&& (mp_isneg(&bigRemainder) != mp_isneg(&big2))) {
&& (bigRemainder.sign != big2.sign)) {
/*
* Convert to Tcl's integer division rules.
*/
@@ -7251,7 +7349,7 @@ TclExecuteByteCode(
}
#endif
if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
rangePtr = GetExceptRangeForPc(pc, result, codePtr);
rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
if (rangePtr == NULL) {
TRACE_APPEND(("no encl. loop or catch, returning %s\n",
StringForResultCode(result)));
@@ -7357,7 +7455,7 @@ TclExecuteByteCode(
#endif
goto abnormalReturn;
}
rangePtr = GetExceptRangeForPc(pc, TCL_ERROR, codePtr);
rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
if (rangePtr == NULL) {
/*
* This is only possible when compiling a [catch] that sends its
@@ -7616,7 +7714,7 @@ IllegalExprOperandType(
if (opcode == INST_EXPON) {
operator = "**";
} else if (opcode <= INST_LNOT) {
} else if (opcode <= INST_STR_NEQ) {
operator = operatorStrings[opcode - INST_LOR];
}
@@ -7848,14 +7946,13 @@ GetSrcInfoForPc(
* ExceptionRange.
*
* Results:
* If the searchMode is TCL_ERROR, this procedure ignores loop exception
* ranges and returns a pointer to the closest catch range. If the
* searchMode is TCL_BREAK, this procedure returns a pointer to the most
* closely enclosing ExceptionRange regardless of whether it is a loop or
* catch exception range. If the searchMode is TCL_CONTINUE, this
* procedure returns a pointer to the most closely enclosing
* ExceptionRange (of any type) skipping only loop exception ranges if
* they don't have a sensible continueOffset defined. If no matching
* In the normal case, catchOnly is 0 (false) and this procedure returns
* a pointer to the most closely enclosing ExceptionRange structure
* regardless of whether it is a loop or catch exception range. This is
* appropriate when processing a TCL_BREAK or TCL_CONTINUE, which will be
* "handled" either by a loop exception range or a closer catch range. If
* catchOnly is nonzero, this procedure ignores loop exception ranges and
* returns a pointer to the closest catch range. If no matching
* ExceptionRange is found that encloses pc, a NULL is returned.
*
* Side effects:
@@ -7870,12 +7967,10 @@ GetExceptRangeForPc(
* search for a closest enclosing exception
* range. This points to a bytecode
* instruction in codePtr's code. */
int searchMode, /* If TCL_BREAK, consider either loop or catch
* ExceptionRanges in search. If TCL_ERROR
int catchOnly, /* If 0, consider either loop or catch
* ExceptionRanges in search. If nonzero
* consider only catch ranges (and ignore any
* closer loop ranges). If TCL_CONTINUE, look
* for loop ranges that define a continue
* point or a catch range. */
* closer loop ranges). */
ByteCode *codePtr) /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
@@ -7901,13 +7996,8 @@ GetExceptRangeForPc(
start = rangePtr->codeOffset;
if ((start <= pcOffset) &&
(pcOffset < (start + rangePtr->numCodeBytes))) {
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
return rangePtr;
}
if (searchMode == TCL_BREAK) {
return rangePtr;
}
if (searchMode == TCL_CONTINUE && rangePtr->continueOffset != -1){
if ((!catchOnly)
|| (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
return rangePtr;
}
}
+26 -30
View File
@@ -243,13 +243,9 @@ TclFileMakeDirsCmd(
break;
}
for (j = 0; j < pobjc; j++) {
int errCount = 2;
target = Tcl_FSJoinPath(split, j + 1);
Tcl_IncrRefCount(target);
createDir:
/*
* Call Tcl_FSStat() so that if target is a symlink that points to
* a directory we will create subdirectories in that directory.
@@ -277,24 +273,24 @@ TclFileMakeDirsCmd(
*/
if (errno == EEXIST) {
/* Be aware other workers could delete it immediately after
* creation, so give this worker still one chance (repeat once),
* see [270f78ca95] for description of the race-condition.
* Don't repeat the create always (to avoid endless loop). */
if (--errCount > 0) {
goto createDir;
}
/* Already tried, with delete in-between directly after
* creation, so just continue (assume created successful). */
goto nextPart;
}
if ((Tcl_FSStat(target, &statBuf) == 0)
&& S_ISDIR(statBuf.st_mode)) {
/*
* It is a directory that wasn't there before, so keep
* going without error.
*/
/* return with error */
errfile = target;
goto done;
Tcl_ResetResult(interp);
} else {
errfile = target;
goto done;
}
} else {
errfile = target;
goto done;
}
}
nextPart:
/*
* Forget about this sub-path.
*/
@@ -377,7 +373,14 @@ TclFileDeleteCmd(
*/
if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
result = TCL_ERROR;
/*
* Trying to delete a file that does not exist is not considered
* an error, just a no-op
*/
if (errno != ENOENT) {
result = TCL_ERROR;
}
} else if (S_ISDIR(statBuf.st_mode)) {
/*
* We own a reference count on errorBuffer, if it was set as a
@@ -413,20 +416,13 @@ TclFileDeleteCmd(
}
if (result != TCL_OK) {
result = TCL_ERROR;
/*
* Avoid possible race condition (file/directory deleted after call
* of lstat), so bypass ENOENT because not an error, just a no-op
*/
if (errno == ENOENT) {
result = TCL_OK;
continue;
}
/*
* It is important that we break on error, otherwise we might end
* up owning reference counts on numerous errorBuffers.
*/
result = TCL_ERROR;
break;
}
}
@@ -747,7 +743,7 @@ CopyRenameOneFile(
errfile = target;
}
/*
/*
* We now need to reset the result, because the above call,
* may have left set it. (Ideally we would prefer not to pass
* an interpreter in above, but the channel IO code used by
+4 -4
View File
@@ -225,9 +225,9 @@ ExtractWinRoot(
if ((path[0] == 'c' || path[0] == 'C')
&& (path[1] == 'o' || path[1] == 'O')) {
if ((path[2] == 'm' || path[2] == 'M')
&& path[3] >= '1' && path[3] <= '9') {
&& path[3] >= '1' && path[3] <= '4') {
/*
* May have match for 'com[1-9]:?', which is a serial port.
* May have match for 'com[1-4]:?', which is a serial port.
*/
if (path[4] == '\0') {
@@ -247,9 +247,9 @@ ExtractWinRoot(
} else if ((path[0] == 'l' || path[0] == 'L')
&& (path[1] == 'p' || path[1] == 'P')
&& (path[2] == 't' || path[2] == 'T')) {
if (path[3] >= '1' && path[3] <= '9') {
if (path[3] >= '1' && path[3] <= '3') {
/*
* May have match for 'lpt[1-9]:?'
* May have match for 'lpt[1-3]:?'
*/
if (path[4] == '\0') {
+6 -13
View File
@@ -324,10 +324,7 @@ CreateHashEntry(
continue;
}
#endif
/* if keys pointers or values are equal */
if ((key == hPtr->key.oneWordValue)
|| compareKeysProc((VOID *) key, hPtr)
) {
if (compareKeysProc((VOID *) key, hPtr)) {
if (newPtr) {
*newPtr = 0;
}
@@ -853,7 +850,6 @@ AllocStringEntry(
allocsize = sizeof(hPtr->key);
}
hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
memcpy(hPtr->key.string, string, size);
hPtr->clientData = 0;
return hPtr;
@@ -1017,18 +1013,12 @@ static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
int count, index, oldSize = tablePtr->numBuckets;
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
int oldSize, count, index;
Tcl_HashEntry **oldBuckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
/* Avoid outgrowing capability of the memory allocators */
if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
tablePtr->rebuildSize = INT_MAX;
return;
}
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
@@ -1040,6 +1030,9 @@ RebuildTable(
typePtr = &tclArrayHashKeyType;
}
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
/*
* Allocate and initialize the new bucket array, and set up hashing
* constants for new array size.
+4 -4
View File
@@ -129,22 +129,22 @@ Tcl_RecordAndEvalObj(
if (call) {
/*
* Do recording by eval'ing a tcl history command: history add $cmd.
* Do recording by eval'ing a tcl history command: history add $cmd.
*/
TclNewLiteralStringObj(list[0], "history");
TclNewLiteralStringObj(list[1], "add");
list[2] = cmdPtr;
objPtr = Tcl_NewListObj(3, list);
Tcl_IncrRefCount(objPtr);
(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objPtr);
/*
* One possible failure mode above: exceeding a resource limit.
*/
if (Tcl_LimitExceeded(interp)) {
return TCL_ERROR;
}
+290 -393
View File
File diff suppressed because it is too large Load Diff
+5 -3
View File
@@ -126,7 +126,7 @@ typedef struct Channel {
*/
typedef struct ChannelState {
char *channelName; /* The name of the channel instance in Tcl
CONST char *channelName; /* The name of the channel instance in Tcl
* commands. Storage is owned by the generic
* IO code, is dynamically allocated. */
int flags; /* ORed combination of the flags defined
@@ -214,8 +214,6 @@ typedef struct ChannelState {
* because it happened in the background. The
* value is the chanMg, if any. #219's
* companion to 'unreportedError'. */
int epoch; /* Used to test validity of stored channelname
* lookup results. */
} ChannelState;
/*
@@ -277,6 +275,10 @@ typedef struct ChannelState {
* usable, but it may not be closed
* again from within the close
* handler. */
#define CHANNEL_TAINTED (1<<20) /* Channel stack structure has changed.
* Used by Channel Tcl_Obj type to
* determine if we have to revalidate
* the channel. */
/*
* Local Variables:
+10 -21
View File
@@ -187,7 +187,6 @@ struct TransformChannelData {
Tcl_Channel self; /* Our own Channel handle. */
int readIsFlushed; /* Flag to note whether in.flushProc was
* called or not. */
int eofPending; /* Flag: EOF seen down, not raised up */
int flags; /* Currently CHANNEL_ASYNC or zero. */
int watchMask; /* Current watch/event/interest mask. */
int mode; /* Mode of parent channel, OR'ed combination
@@ -293,7 +292,6 @@ TclChannelTransform(
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
dataPtr->flags = 0;
if (ds.string[0] == '0') {
dataPtr->flags |= CHANNEL_ASYNC;
@@ -626,7 +624,7 @@ TransformInputProc(
if (toRead == 0 || dataPtr->self == NULL) {
/*
* Catch a no-op. TODO: Is this a panic()?
* Catch a no-op.
*/
return 0;
}
@@ -678,17 +676,6 @@ TransformInputProc(
if (toRead <= 0) {
break;
}
if (dataPtr->eofPending) {
/*
* Already saw EOF from downChan; don't ask again.
* NOTE: Could move this up to avoid the last maxRead
* execution. Believe this would still be correct behavior,
* but the test suite tests the whole command callback
* sequence, so leave it unchanged for now.
*/
break;
}
/*
* Get bytes from the underlying channel.
@@ -725,7 +712,14 @@ TransformInputProc(
* on the down channel.
*/
dataPtr->eofPending = 1;
if (dataPtr->readIsFlushed) {
/*
* Already flushed, nothing to do anymore.
*/
break;
}
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
@@ -753,11 +747,8 @@ TransformInputProc(
break;
}
} /* while toRead > 0 */
if (gotBytes == 0) {
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
return gotBytes;
}
@@ -868,7 +859,6 @@ TransformSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
@@ -942,7 +932,6 @@ TransformWideSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
+7 -6
View File
@@ -516,6 +516,7 @@ TclChanCreateObjCmd(
* Expect at least one list element. Abbreviations are ok.
*/
modeObj = objv[MODE];
if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
return TCL_ERROR;
}
@@ -1108,7 +1109,7 @@ ReflectClose(
if (rcPtr->interp) {
rcmPtr = GetReflectedChannelMap (rcPtr->interp);
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
Tcl_GetChannelName (rcPtr->chan));
if (hPtr) {
Tcl_DeleteHashEntry (hPtr);
@@ -1116,7 +1117,7 @@ ReflectClose(
}
#ifdef TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
Tcl_GetChannelName (rcPtr->chan));
if (hPtr) {
Tcl_DeleteHashEntry (hPtr);
@@ -1515,6 +1516,8 @@ ReflectWatch(
return;
}
rcPtr->interest = mask;
/*
* Are we in the correct thread?
*/
@@ -1537,7 +1540,6 @@ ReflectWatch(
Tcl_Preserve(rcPtr);
rcPtr->interest = mask;
maskObj = DecodeEventMask(mask);
/* assert maskObj.refCount == 1 */
(void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
@@ -2748,12 +2750,12 @@ ForwardProc(
*/
rcmPtr = GetReflectedChannelMap (interp);
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
Tcl_GetChannelName (rcPtr->chan));
Tcl_DeleteHashEntry (hPtr);
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
hPtr = Tcl_FindHashEntry (&rcmPtr->map,
Tcl_GetChannelName (rcPtr->chan));
Tcl_DeleteHashEntry (hPtr);
@@ -2886,7 +2888,6 @@ ForwardProc(
/* assert maskObj.refCount == 1 */
Tcl_Preserve(rcPtr);
rcPtr->interest = paramPtr->watch.mask;
(void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
+4 -3
View File
@@ -254,6 +254,7 @@ Tcl_GetCwd(
}
}
/* Obsolete */
int
Tcl_EvalFile(
Tcl_Interp *interp, /* Interpreter in which to process file. */
@@ -698,8 +699,8 @@ FsGetFirstFilesystem(void)
}
/*
* The epoch can be changed by filesystems being added or removed, by changing
* the "system encoding" and by env(HOME) changing.
* The epoch can be changed both by filesystems being added or removed and by
* env(HOME) changing.
*/
int
@@ -1804,7 +1805,7 @@ Tcl_FSEvalFileEx(
* this cross-platform to allow for scripted documents. [Bug: 2040]
*/
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
/*
* If the encoding is specified, set it for the channel. Else don't touch
+5 -4
View File
@@ -2,8 +2,9 @@
#
# This file contains the declarations for all unsupported
# functions that are exported by the Tcl library. This file
# is used to generate the tclIntDecls.h, tclIntPlatDecls.h
# and tclStubInit.c files
# is used to generate the tclIntDecls.h, tclIntPlatDecls.h,
# tclIntStub.c, tclPlatStub.c, tclCompileDecls.h and tclCompileStub.c
# files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
@@ -995,7 +996,7 @@ declare 9 win {
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 10 win {
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Removed in 8.3.1 (for Win32s only)
#declare 10 win {
@@ -1135,7 +1136,7 @@ declare 9 unix {
# Added in 8.4:
declare 10 unix {
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
+21 -30
View File
@@ -48,8 +48,7 @@
#else
#include <string.h>
#endif
#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
|| defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC)
#ifdef STDC_HEADERS
#include <stddef.h>
#else
typedef int ptrdiff_t;
@@ -2607,8 +2606,8 @@ MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int TclIsLocalScalar(const char *src, int len);
MODULE_SCOPE int TclIsSpaceProc(char byte);
MODULE_SCOPE int TclIsBareword(char byte);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
@@ -2638,8 +2637,6 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
int *codePtr, int *levelPtr);
MODULE_SCOPE int TclNokia770Doubles();
MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, const char *operation,
const char *reason, int index);
@@ -2749,8 +2746,6 @@ MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int *clNextOuter, CONST char *outerScript);
MODULE_SCOPE void TclTransferResult(Tcl_Interp *sourceInterp, int result,
Tcl_Interp *targetInterp);
MODULE_SCOPE int TclTrim(const char *bytes, int numBytes,
const char *trim, int numTrim, int *trimRight);
MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
const char *trim, int numTrim);
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
@@ -2772,29 +2767,10 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclpFinalizeThreadDataThread(void);
MODULE_SCOPE void TclFinalizeThreadStorage(void);
/* TclWideMUInt -- wide integer used for measurement calculations: */
#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400))
# define TclWideMUInt Tcl_WideUInt
#else
/* older MSVS may not allow conversions between unsigned __int64 and double) */
# define TclWideMUInt Tcl_WideInt
#endif
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
MODULE_SCOPE double TclpWideClickInMicrosec(void);
#else
# ifdef _WIN32
# define TCL_WIDE_CLICKS 1
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClickInMicrosec(void);
# define TclpWideClicksToNanoseconds(clicks) \
((double)(clicks) * TclpWideClickInMicrosec() * 1000)
# endif
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);
@@ -3037,9 +3013,6 @@ MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3294,21 +3267,39 @@ MODULE_SCOPE int TclDivOpCmd(ClientData clientData,
MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclLessOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclLeqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclGeqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclEqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3678,7 +3669,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
#define TclUtfToUniChar(str, chPtr) \
((((unsigned char) *(str)) < 0xC0) ? \
((*(chPtr) = (unsigned char) *(str)), 1) \
((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
: Tcl_UtfToUniChar(str, chPtr))
/*
+11 -6
View File
@@ -13,6 +13,11 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
#ifdef __WIN32__
# define Tcl_DirEntry void
# define DIR void
#endif
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -96,7 +101,7 @@ EXTERN TclFile TclpCreateTempFile(CONST char *contents);
#ifndef TclpReaddir_TCL_DECLARED
#define TclpReaddir_TCL_DECLARED
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
#endif
#ifndef TclpLocaltime_unix_TCL_DECLARED
#define TclpLocaltime_unix_TCL_DECLARED
@@ -197,7 +202,7 @@ EXTERN int TclWinGetPlatformId(void);
#ifndef TclpReaddir_TCL_DECLARED
#define TclpReaddir_TCL_DECLARED
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
#endif
#ifndef TclGetAndDetachPids_TCL_DECLARED
#define TclGetAndDetachPids_TCL_DECLARED
@@ -355,7 +360,7 @@ EXTERN TclFile TclpCreateTempFile(CONST char *contents);
#ifndef TclpReaddir_TCL_DECLARED
#define TclpReaddir_TCL_DECLARED
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
#endif
#ifndef TclpLocaltime_unix_TCL_DECLARED
#define TclpLocaltime_unix_TCL_DECLARED
@@ -445,7 +450,7 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
@@ -477,7 +482,7 @@ typedef struct TclIntPlatStubs {
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, CONST char *optval, int optlen); /* 7 */
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
@@ -509,7 +514,7 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
+1
View File
@@ -1748,6 +1748,7 @@ AliasObjCmd(
cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
}
prefv = &aliasPtr->objPtr;
memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+48 -204
View File
@@ -23,7 +23,6 @@
typedef struct Link {
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
Namespace *nsPtr; /* Namespace containing Tcl variable */
Tcl_Obj *varName; /* Name of variable (must be global). This is
* needed during trace callbacks, since the
* actual variable may be aliased at that time
@@ -68,10 +67,6 @@ typedef struct Link {
static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
CONST char *name1, CONST char *name2, int flags);
static Tcl_Obj * ObjValue(Link *linkPtr);
static int GetInvalidIntFromObj(Tcl_Obj *objPtr,
int *intPtr);
static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
double *doublePtr);
/*
* Convenience macro for accessing the value of the C variable pointed to by a
@@ -115,8 +110,6 @@ Tcl_LinkVar(
{
Tcl_Obj *objPtr;
Link *linkPtr;
Namespace *dummy;
const char *name;
int code;
linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
@@ -129,7 +122,6 @@ Tcl_LinkVar(
linkPtr = (Link *) ckalloc(sizeof(Link));
linkPtr->interp = interp;
linkPtr->nsPtr = NULL;
linkPtr->varName = Tcl_NewStringObj(varName, -1);
Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
@@ -146,17 +138,11 @@ Tcl_LinkVar(
ckfree((char *) linkPtr);
return TCL_ERROR;
}
TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
&(linkPtr->nsPtr), &dummy, &dummy, &name);
linkPtr->nsPtr->refCount++;
code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
(ClientData) linkPtr);
if (code != TCL_OK) {
Tcl_DecrRefCount(linkPtr->varName);
TclNsDecrRefCount(linkPtr->nsPtr);
ckfree((char *) linkPtr);
}
return code;
@@ -196,9 +182,6 @@ Tcl_UnlinkVar(
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
LinkTraceProc, (ClientData) linkPtr);
Tcl_DecrRefCount(linkPtr->varName);
if (linkPtr->nsPtr) {
TclNsDecrRefCount(linkPtr->nsPtr);
}
ckfree((char *) linkPtr);
}
@@ -292,11 +275,8 @@ LinkTraceProc(
*/
if (flags & TCL_TRACE_UNSETS) {
if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
if (Tcl_InterpDeleted(interp)) {
Tcl_DecrRefCount(linkPtr->varName);
if (linkPtr->nsPtr) {
TclNsDecrRefCount(linkPtr->nsPtr);
}
ckfree((char *) linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -402,12 +382,9 @@ LinkTraceProc(
case TCL_LINK_INT:
if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have integer value";
}
return "variable must have integer value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
@@ -415,13 +392,9 @@ LinkTraceProc(
case TCL_LINK_WIDE_INT:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
!= TCL_OK) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have integer value";
}
linkPtr->lastValue.w = (Tcl_WideInt) valueInt;
return "variable must have integer value";
}
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
@@ -432,12 +405,9 @@ LinkTraceProc(
#ifdef ACCEPT_NAN
if (valueObj->typePtr != &tclDoubleType) {
#endif
if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have real value";
}
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return "variable must have real value";
#ifdef ACCEPT_NAN
}
linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
@@ -457,106 +427,79 @@ LinkTraceProc(
break;
case TCL_LINK_CHAR:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have char value";
}
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have char value";
}
linkPtr->lastValue.c = (char)valueInt;
LinkedVar(char) = linkPtr->lastValue.c;
break;
case TCL_LINK_UCHAR:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > UCHAR_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned char value";
}
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned char value";
}
linkPtr->lastValue.uc = (unsigned char) valueInt;
LinkedVar(unsigned char) = linkPtr->lastValue.uc;
break;
case TCL_LINK_SHORT:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have short value";
}
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have short value";
}
linkPtr->lastValue.s = (short)valueInt;
LinkedVar(short) = linkPtr->lastValue.s;
break;
case TCL_LINK_USHORT:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > USHRT_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned short value";
}
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned short value";
}
linkPtr->lastValue.us = (unsigned short)valueInt;
LinkedVar(unsigned short) = linkPtr->lastValue.us;
break;
case TCL_LINK_UINT:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || valueWide > UINT_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned int value";
}
linkPtr->lastValue.ui = (unsigned int)valueInt;
} else {
linkPtr->lastValue.ui = (unsigned int)valueWide;
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned int value";
}
linkPtr->lastValue.ui = (unsigned int)valueWide;
LinkedVar(unsigned int) = linkPtr->lastValue.ui;
break;
case TCL_LINK_LONG:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have long value";
}
linkPtr->lastValue.l = (long)valueInt;
} else {
linkPtr->lastValue.l = (long)valueWide;
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have long value";
}
linkPtr->lastValue.l = (long)valueWide;
LinkedVar(long) = linkPtr->lastValue.l;
break;
case TCL_LINK_ULONG:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned long value";
}
linkPtr->lastValue.ul = (unsigned long)valueInt;
} else {
linkPtr->lastValue.ul = (unsigned long)valueWide;
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned long value";
}
linkPtr->lastValue.ul = (unsigned long)valueWide;
LinkedVar(unsigned long) = linkPtr->lastValue.ul;
break;
@@ -564,29 +507,21 @@ LinkTraceProc(
/*
* FIXME: represent as a bignum.
*/
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
if (GetInvalidIntFromObj(valueObj, &valueInt)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned wide int value";
}
linkPtr->lastValue.uw = (Tcl_WideUInt)valueInt;
} else {
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have unsigned wide int value";
}
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
break;
case TCL_LINK_FLOAT:
if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
if (GetInvalidDoubleFromObj(valueObj, &valueDouble)
!= TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have float value";
}
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "variable must have float value";
}
linkPtr->lastValue.f = (float)valueDouble;
LinkedVar(float) = linkPtr->lastValue.f;
@@ -693,97 +628,6 @@ ObjValue(
return resultObj;
}
}
static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_ObjType invalidRealType = {
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
SetInvalidRealFromAny /* setFromAnyProc */
};
static int
SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
int length;
const char *str;
const char *endPtr;
str = TclGetStringFromObj(objPtr, &length);
if ((length == 1) && (str[0] == '.')){
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = 0.0;
return TCL_OK;
}
if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
/* If number is followed by [eE][+-]?, then it is an invalid
* double, but it could be the start of a valid double. */
if (*endPtr == 'e' || *endPtr == 'E') {
++endPtr;
if (*endPtr == '+' || *endPtr == '-') ++endPtr;
if (*endPtr == 0) {
double doubleValue = 0.0;
Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr);
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = doubleValue;
return TCL_OK;
}
}
}
return TCL_ERROR;
}
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
* contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o"
* (upperand lowercase). See bug [39f6304c2e].
*/
int
GetInvalidIntFromObj(Tcl_Obj *objPtr,
int *intPtr)
{
int length;
const char *str = TclGetStringFromObj(objPtr, &length);
if ((length == 1) && strchr("+-", str[0])) {
*intPtr = (str[0] == '+');
return TCL_OK;
} else if ((length == 0) ||
((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
*intPtr = 0;
return TCL_OK;
}
return TCL_ERROR;
}
/*
* This function checks for double representations, which are valid
* when linking with C variables, but which are invalid in other
* contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o"
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
double *doublePtr)
{
int intValue, result;
if ((objPtr->typePtr == &invalidRealType) ||
(SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) {
*doublePtr = objPtr->internalRep.doubleValue;
return TCL_OK;
}
result = GetInvalidIntFromObj(objPtr, &intValue);
if (result == TCL_OK) {
*doublePtr = (double) intValue;
}
return result;
}
/*
* Local Variables:
+7 -32
View File
@@ -846,21 +846,16 @@ Tcl_ListObjReplace(
}
if (count < 0) {
count = 0;
} else if (first > INT_MAX - count /* Handle integer overflow */
|| numElems < first+count) {
} else if (numElems < first+count || first+count < 0) {
/*
* The 'first+count < 0' condition here guards agains integer
* overflow in determining 'first+count'
*/
count = numElems - first;
}
if (objc > LIST_MAX - (numElems - count)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded",
LIST_MAX));
}
return TCL_ERROR;
}
isShared = (listRepPtr->refCount > 1);
numRequired = numElems - count + objc; /* Known <= LIST_MAX */
numRequired = numElems - count + objc;
for (i = 0; i < objc; i++) {
Tcl_IncrRefCount(objv[i]);
@@ -910,8 +905,6 @@ Tcl_ListObjReplace(
}
listRepPtr = AttemptNewList(interp, newMax, NULL);
if (listRepPtr == NULL) {
listRepPtr = AttemptNewList(interp, numRequired, NULL);
if (listRepPtr == NULL) {
for (i = 0; i < objc; i++) {
/* See bug 3598580 */
@@ -923,7 +916,6 @@ Tcl_ListObjReplace(
}
return TCL_ERROR;
}
}
listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
listRepPtr->refCount++;
@@ -1872,21 +1864,7 @@ UpdateStringOfList(
* Pass 2: copy into string rep buffer.
*/
/*
* We used to set the string length here, relying on a presumed
* guarantee that the number of bytes TclScanElement() calls reported
* to be needed was a precise count and not an over-estimate, so long
* as the same flag values were passed to TclConvertElement().
*
* Then we saw [35a8f1c04a], where a bug in TclScanElement() caused
* that guarantee to fail. Rather than trust there are no more bugs,
* we set the length after the loop based on what was actually written,
* an not on what was predicted.
*
listPtr->length = bytesNeeded - 1;
*
*/
listPtr->bytes = ckalloc((unsigned) bytesNeeded);
dst = listPtr->bytes;
for (i = 0; i < numElems; i++) {
@@ -1895,10 +1873,7 @@ UpdateStringOfList(
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
*dst++ = ' ';
}
dst[-1] = '\0';
/* Here is the safe setting of the string length. */
listPtr->length = dst - 1 - listPtr->bytes;
listPtr->bytes[listPtr->length] = '\0';
if (flagPtr != localFlags) {
ckfree((char *) flagPtr);
+23 -51
View File
@@ -153,7 +153,7 @@ TclDeleteLiteralTable(
* Find, or if necessary create, an object in the interpreter's literal
* table that has a string representation matching the argument
* string. If nsPtr!=NULL then only literals stored for the namespace are
* considered.
* considered.
*
* Results:
* The literal object. If it was created in this call *newPtr is set to
@@ -161,7 +161,7 @@ TclDeleteLiteralTable(
*
* Side effects:
* Increments the ref count of the global LiteralEntry since the caller
* now holds a reference.
* now holds a reference.
* If LITERAL_ON_HEAP is set in flags, this function is given ownership
* of the string: if an object is created then its string representation
* is set directly from string, otherwise the string is freed. Typically,
@@ -186,7 +186,7 @@ TclCreateLiteral(
LiteralEntry *globalPtr;
int globalHash;
Tcl_Obj *objPtr;
/*
* Is it in the interpreter's global literal table?
*/
@@ -198,36 +198,25 @@ TclCreateLiteral(
for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
if (globalPtr->nsPtr == nsPtr) {
if ((globalPtr->nsPtr == nsPtr)
&& (objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
/*
* Literals should always have UTF-8 representations... but this
* is not guaranteed so we need to be careful anyway.
*
* https://stackoverflow.com/q/54337750/301832
* A literal was found: return it
*/
int objLength;
char *objBytes = TclGetStringFromObj(objPtr, &objLength);
if ((objLength == length) && ((length == 0)
|| ((objBytes[0] == bytes[0])
&& (memcmp(objBytes, bytes, (unsigned) length) == 0)))) {
/*
* A literal was found: return it
*/
if (newPtr) {
*newPtr = 0;
}
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
globalPtr->refCount++;
return objPtr;
if (newPtr) {
*newPtr = 0;
}
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
globalPtr->refCount++;
return objPtr;
}
}
if (!newPtr) {
@@ -693,22 +682,16 @@ ExpandLocalLiteralArray(
LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
LiteralEntry *newArrayPtr;
int i;
unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;
if (currBytes == newSize) {
Tcl_Panic("max size of Tcl literal array (%d literals) exceeded",
currElems);
}
if (envPtr->mallocedLiteralArray) {
newArrayPtr = (LiteralEntry *) ckrealloc(
(char *)currArrayPtr, newSize);
(char *)currArrayPtr, 2 * currBytes);
} else {
/*
* envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
* code a ckrealloc equivalent for ourselves
*/
newArrayPtr = (LiteralEntry *) ckalloc(newSize);
newArrayPtr = (LiteralEntry *) ckalloc(2 * currBytes);
memcpy(newArrayPtr, currArrayPtr, currBytes);
envPtr->mallocedLiteralArray = 1;
}
@@ -720,7 +703,7 @@ ExpandLocalLiteralArray(
if (currArrayPtr != newArrayPtr) {
for (i=0 ; i<currElems ; i++) {
if (newArrayPtr[i].nextPtr != NULL) {
newArrayPtr[i].nextPtr = newArrayPtr
newArrayPtr[i].nextPtr = newArrayPtr
+ (newArrayPtr[i].nextPtr - currArrayPtr);
}
}
@@ -733,7 +716,7 @@ ExpandLocalLiteralArray(
}
envPtr->literalArrayPtr = newArrayPtr;
envPtr->literalArrayEnd = newSize / sizeof(LiteralEntry);
envPtr->literalArrayEnd = (2 * currElems);
}
/*
@@ -893,8 +876,7 @@ RebuildLiteralTable(
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
char *bytes;
unsigned int oldSize;
int count, index, length;
int oldSize, count, index, length;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -904,16 +886,6 @@ RebuildLiteralTable(
* constants for new array size.
*/
if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) {
/*
* Memory allocator limitations will not let us create the
* next larger table size. Best option is to limp along
* with what we have.
*/
return;
}
tablePtr->numBuckets *= 4;
tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
(tablePtr->numBuckets * sizeof(LiteralEntry *)));
-3
View File
@@ -28,10 +28,7 @@
* source directory to make their own modified versions).
*/
#if defined _MSC_VER && _MSC_VER < 1900
/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
extern CRTIMPORT int isatty(int fd);
#endif
static Tcl_Obj *tclStartupScriptPath = NULL;
static Tcl_Obj *tclStartupScriptEncoding = NULL;
+91 -144
View File
@@ -1060,13 +1060,6 @@ Tcl_DeleteNamespace(
}
}
}
int
TclNamespaceDeleted(
Namespace *nsPtr)
{
return (nsPtr->flags & NS_DYING) ? 1 : 0;
}
/*
*----------------------------------------------------------------------
@@ -1244,33 +1237,6 @@ NamespaceFree(
ckfree((char *) nsPtr);
}
/*
*----------------------------------------------------------------------
*
* TclNsDecrRefCount --
*
* Drops a reference to a namespace and frees it if the namespace has
* been deleted and the last reference has just been dropped.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclNsDecrRefCount(
Namespace *nsPtr)
{
nsPtr->refCount--;
if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
NamespaceFree(nsPtr);
}
}
/*
*----------------------------------------------------------------------
*
@@ -6513,32 +6479,14 @@ MakeCachedEnsembleCommand(
*----------------------------------------------------------------------
*/
static void
ClearTable(
EnsembleConfig *ensemblePtr)
{
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
if (hash->numEntries != 0) {
Tcl_HashSearch search;
Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);
while (hPtr != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
Tcl_DecrRefCount(prefixObj);
hPtr = Tcl_NextHashEntry(&search);
}
ckfree((char *) ensemblePtr->subcommandArrayPtr);
}
Tcl_DeleteHashTable(hash);
}
static void
DeleteEnsembleConfig(
ClientData clientData)
{
EnsembleConfig *ensemblePtr = clientData;
Namespace *nsPtr = ensemblePtr->nsPtr;
Tcl_HashSearch search;
Tcl_HashEntry *hEnt;
/*
* Unlink from the ensemble chain if it has not been marked as having been
@@ -6571,8 +6519,17 @@ DeleteEnsembleConfig(
* Kill the pointer-containing fields.
*/
ClearTable(ensemblePtr);
if (ensemblePtr->subcommandTable.numEntries != 0) {
ckfree((char *) ensemblePtr->subcommandArrayPtr);
}
hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
while (hEnt != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
Tcl_DecrRefCount(prefixObj);
hEnt = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
if (ensemblePtr->subcmdList != NULL) {
Tcl_DecrRefCount(ensemblePtr->subcmdList);
}
@@ -6625,111 +6582,101 @@ BuildEnsembleConfig(
int i, j, isNew;
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
Tcl_HashEntry *hPtr;
Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
Tcl_Obj *subList = ensemblePtr->subcmdList;
ClearTable(ensemblePtr);
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
if (subList) {
int subc;
Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
char *name;
if (hash->numEntries != 0) {
/*
* There is a list of exactly what subcommands go in the table.
* Must determine the target for each.
* Remove pre-existing table.
*/
Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
if (subList == mapDict) {
Tcl_HashSearch search;
ckfree((char *) ensemblePtr->subcommandArrayPtr);
hPtr = Tcl_FirstHashEntry(hash, &search);
while (hPtr != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
Tcl_DecrRefCount(prefixObj);
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(hash);
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
}
/*
* See if we've got an export list. If so, we will only export exactly
* those commands, which may be either implemented by the prefix in the
* subcommandDict or mapped directly onto the namespace's commands.
*/
if (ensemblePtr->subcmdList != NULL) {
Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
int subcmdc;
TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
&subcmdv);
for (i=0 ; i<subcmdc ; i++) {
char *name = TclGetString(subcmdv[i]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
/*
* Strange case where explicit list of subcommands is same value
* as the dict mapping to targets.
* Skip non-unique cases.
*/
for (i = 0; i < subc; i += 2) {
name = TclGetString(subv[i]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
if (!isNew) {
cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
Tcl_DecrRefCount(cmdObj);
}
Tcl_SetHashValue(hPtr, subv[i+1]);
Tcl_IncrRefCount(subv[i+1]);
name = TclGetString(subv[i+1]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
if (isNew) {
cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
if (ensemblePtr->nsPtr->parentPtr != NULL) {
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
} else {
Tcl_AppendStringsToObj(cmdObj, name, NULL);
}
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
}
if (!isNew) {
continue;
}
} else {
/* Usual case where we can freely act on the list and dict. */
for (i = 0; i < subc; i++) {
name = TclGetString(subv[i]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
if (!isNew) {
/*
* Look in our dictionary (if present) for the command.
*/
if (ensemblePtr->subcommandDict != NULL) {
Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
&target);
if (target != NULL) {
Tcl_SetHashValue(hPtr, target);
Tcl_IncrRefCount(target);
continue;
}
/* Lookup target in the dictionary */
if (mapDict) {
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
if (target) {
Tcl_SetHashValue(hPtr, target);
Tcl_IncrRefCount(target);
continue;
}
}
/*
* target was not in the dictionary so map onto the namespace.
* Note in this case that we do not guarantee that the
* command is actually there; that is the programmer's
* responsibility (or [::unknown] of course).
*/
cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
if (ensemblePtr->nsPtr->parentPtr != NULL) {
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
} else {
Tcl_AppendStringsToObj(cmdObj, name, NULL);
}
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
}
/*
* Not there, so map onto the namespace. Note in this case that we
* do not guarantee that the command is actually there; that is
* the programmer's responsibility (or [::unknown] of course).
*/
cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
if (ensemblePtr->nsPtr->parentPtr != NULL) {
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
} else {
Tcl_AppendStringsToObj(cmdObj, name, NULL);
}
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
}
} else if (mapDict) {
/*
* No subcmd list, but we do have a mapping dictionary so we should
* use the keys of that. Convert the dictionary's contents into the
* form required for the ensemble's internal hashtable.
*/
} else if (ensemblePtr->subcommandDict != NULL) {
/*
* No subcmd list, but we do have a mapping dictionary so we should
* use the keys of that. Convert the dictionary's contents into the
* form required for the ensemble's internal hashtable.
*/
Tcl_DictSearch dictSearch;
Tcl_Obj *keyObj, *valueObj;
int done;
Tcl_DictSearch dictSearch;
Tcl_Obj *keyObj, *valueObj;
int done;
Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
&keyObj, &valueObj, &done);
while (!done) {
char *name = TclGetString(keyObj);
Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
&keyObj, &valueObj, &done);
while (!done) {
char *name = TclGetString(keyObj);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
Tcl_SetHashValue(hPtr, valueObj);
Tcl_IncrRefCount(valueObj);
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
}
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
Tcl_SetHashValue(hPtr, valueObj);
Tcl_IncrRefCount(valueObj);
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
}
} else {
/*
* Discover what commands are actually exported by the namespace.
+56 -72
View File
@@ -189,7 +189,7 @@ static Tcl_ThreadDataKey pendingObjDataKey;
mp_shrink(&(bignum)); \
} \
(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) (bignum).dp; \
(objPtr)->internalRep.ptrAndLongRep.value = ( (mp_isneg(&bignum) << 30) \
(objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
| ((bignum).alloc << 15) | ((bignum).used)); \
}
@@ -569,7 +569,7 @@ TclContinuationsEnter(Tcl_Obj* objPtr,
Tcl_HashEntry* hPtr =
Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
ContLineLoc* clLocPtr =
ContLineLoc* clLocPtr =
(ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
if (!newEntry) {
@@ -675,7 +675,7 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
num = wordCLLast - clNext;
if (num) {
int i;
ContLineLoc* clLocPtr =
ContLineLoc* clLocPtr =
TclContinuationsEnter(objPtr, num, clNext);
/*
@@ -1322,39 +1322,6 @@ TclFreeObj(
ObjInitDeletionContext(context);
# ifdef TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
* storage can be finalized before the last Tcl_Obj is freed.
*/
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("TclFreeObj: object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
if (hPtr) {
/*
* As the Tcl_Obj is going to be deleted we remove the entry.
*/
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
ckfree((char *) objData);
}
Tcl_DeleteHashEntry(hPtr);
}
}
# endif
/*
* Check for a double free of the same value. This is slightly tricky
* because it is customary to free a Tcl_Obj when its refcount falls
@@ -1371,10 +1338,10 @@ TclFreeObj(
*/
objPtr->refCount = -1;
/* Invalidate the string rep first so we can use the bytes value
/* Invalidate the string rep first so we can use the bytes value
* for our pointer chain, and signal an obj deletion (as opposed
* to shimmering) with 'length == -1' */
* to shimmering) with 'length == -1' */
TclInvalidateStringRep(objPtr);
objPtr->length = -1;
@@ -1436,13 +1403,13 @@ void
TclFreeObj(
register Tcl_Obj *objPtr) /* The object to be freed. */
{
/* Invalidate the string rep first so we can use the bytes value
/* Invalidate the string rep first so we can use the bytes value
* for our pointer chain, and signal an obj deletion (as opposed
* to shimmering) with 'length == -1' */
* to shimmering) with 'length == -1' */
TclInvalidateStringRep(objPtr);
objPtr->length = -1;
if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
/*
* objPtr can be freed safely, as it will not attempt to free any
@@ -2778,8 +2745,8 @@ Tcl_GetLongFromObj(
mp_int big;
UNPACK_BIGNUM(objPtr, big);
if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1)
/ MP_DIGIT_BIT) {
if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
/ DIGIT_BIT) {
unsigned long value = 0, numBytes = sizeof(long);
long scratch;
unsigned char *bytes = (unsigned char *)&scratch;
@@ -2787,7 +2754,7 @@ Tcl_GetLongFromObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (mp_isneg(&big)) {
if (big.sign) {
*longPtr = - (long) value;
} else {
*longPtr = (long) value;
@@ -2799,7 +2766,7 @@ Tcl_GetLongFromObj(
tooLarge:
#endif
if (interp != NULL) {
const char *s = "integer value too large to represent";
char *s = "integer value too large to represent";
Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
Tcl_SetObjResult(interp, msg);
@@ -3079,7 +3046,7 @@ Tcl_GetWideIntFromObj(
UNPACK_BIGNUM(objPtr, big);
if ((size_t)(big.used) <= (CHAR_BIT * sizeof(Tcl_WideInt)
+ MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) {
+ DIGIT_BIT - 1) / DIGIT_BIT) {
Tcl_WideUInt value = 0;
unsigned long numBytes = sizeof(Tcl_WideInt);
Tcl_WideInt scratch;
@@ -3089,7 +3056,7 @@ Tcl_GetWideIntFromObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (mp_isneg(&big)) {
if (big.sign) {
*wideIntPtr = - (Tcl_WideInt) value;
} else {
*wideIntPtr = (Tcl_WideInt) value;
@@ -3098,7 +3065,7 @@ Tcl_GetWideIntFromObj(
}
}
if (interp != NULL) {
const char *s = "integer value too large to represent";
char *s = "integer value too large to represent";
Tcl_Obj* msg = Tcl_NewStringObj(s, -1);
Tcl_SetObjResult(interp, msg);
@@ -3230,11 +3197,13 @@ UpdateStringOfBignum(
if (status != MP_OKAY) {
Tcl_Panic("radix size failure in UpdateStringOfBignum");
}
if (size < 2) {
if (size == 3) {
/*
* mp_radix_size() returns < 2 when more than INT_MAX bytes would be
* mp_radix_size() returns 3 when more than INT_MAX bytes would be
* needed to hold the string rep (because mp_radix_size ignores
* integer overflow issues).
* integer overflow issues). When we know the string rep will be more
* than 3, we can conclude the string rep would overflow our string
* length limits.
*
* Note that so long as we enforce our bignums to the size that fits
* in a packed bignum, this branch will never be taken.
@@ -3498,7 +3467,7 @@ Tcl_SetBignumObj(
Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
}
if ((size_t)(bignumValue->used)
<= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) {
<= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
unsigned long value = 0, numBytes = sizeof(long);
long scratch;
unsigned char *bytes = (unsigned char *)&scratch;
@@ -3508,10 +3477,10 @@ Tcl_SetBignumObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (value > (((~(unsigned long)0) >> 1) + mp_isneg(bignumValue))) {
if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
goto tooLargeForLong;
}
if (mp_isneg(bignumValue)) {
if (bignumValue->sign) {
TclSetLongObj(objPtr, -(long)value);
} else {
TclSetLongObj(objPtr, (long)value);
@@ -3522,7 +3491,7 @@ Tcl_SetBignumObj(
tooLargeForLong:
#ifndef NO_WIDE_TYPE
if ((size_t)(bignumValue->used)
<= (CHAR_BIT * sizeof(Tcl_WideInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) {
<= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
Tcl_WideUInt value = 0;
unsigned long numBytes = sizeof(Tcl_WideInt);
Tcl_WideInt scratch;
@@ -3533,10 +3502,10 @@ Tcl_SetBignumObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (value > (((~(Tcl_WideUInt)0) >> 1) + mp_isneg(bignumValue))) {
if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
goto tooLargeForWide;
}
if (mp_isneg(bignumValue)) {
if (bignumValue->sign) {
TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
} else {
TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
@@ -3748,6 +3717,20 @@ Tcl_DbDecrRefCount(
"Trying to decr ref count of "
"Tcl_Obj allocated in another thread");
}
/*
* If the Tcl_Obj is going to be deleted, remove the entry.
*/
if ((objPtr->refCount - 1) <= 0) {
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
ckfree((char *) objData);
}
Tcl_DeleteHashEntry(hPtr);
}
}
# endif
#endif
@@ -3921,10 +3904,11 @@ TclCompareObjKeys(
/*
* If the object pointers are the same then they match.
* OPT: this comparison was moved to the caller
*/
if (objPtr1 == objPtr2) return 1;
*/
if (objPtr1 == objPtr2) {
return 1;
}
/*
* Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
@@ -4081,7 +4065,7 @@ Tcl_GetCommandFromObj(
* is not deleted.
*
* If any check fails, then force another conversion to the command type,
* to discard the old rep and create a new one.
* to discard the old rep and create a new one.
*/
resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -4091,15 +4075,15 @@ Tcl_GetCommandFromObj(
|| (cmdPtr->flags & CMD_IS_DELETED)
|| (interp != cmdPtr->nsPtr->interp)
|| (cmdPtr->nsPtr->flags & NS_DYING)
|| ((resPtr->refNsPtr != NULL) &&
|| ((resPtr->refNsPtr != NULL) &&
(((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp))
!= resPtr->refNsPtr)
|| (resPtr->refNsId != refNsPtr->nsId)
|| (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch)))
) {
result = tclCmdNameType.setFromAnyProc(interp, objPtr);
resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
if ((result == TCL_OK) && resPtr) {
cmdPtr = resPtr->cmdPtr;
@@ -4107,7 +4091,7 @@ Tcl_GetCommandFromObj(
cmdPtr = NULL;
}
}
return (Tcl_Command) cmdPtr;
}
@@ -4159,7 +4143,7 @@ TclSetCmdNameObj(
if ((*name++ == ':') && (*name == ':')) {
/*
* The name is fully qualified: set the referring namespace to
* NULL.
* NULL.
*/
resPtr->refNsPtr = NULL;
@@ -4169,7 +4153,7 @@ TclSetCmdNameObj(
*/
currNsPtr = iPtr->varFramePtr->nsPtr;
resPtr->refNsPtr = currNsPtr;
resPtr->refNsId = currNsPtr->nsId;
resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
@@ -4329,7 +4313,7 @@ SetCmdNameFromAny(
/*
* Reuse the old ResolvedCmdName struct instead of freeing it
*/
Command *oldCmdPtr = resPtr->cmdPtr;
if (--oldCmdPtr->refCount == 0) {
TclCleanupCommandMacro(oldCmdPtr);
@@ -4346,8 +4330,8 @@ SetCmdNameFromAny(
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
if ((*name++ == ':') && (*name == ':')) {
/*
* The name is fully qualified: set the referring namespace to
* NULL.
* The name is fully qualified: set the referring namespace to
* NULL.
*/
resPtr->refNsPtr = NULL;
@@ -4357,7 +4341,7 @@ SetCmdNameFromAny(
*/
currNsPtr = iPtr->varFramePtr->nsPtr;
resPtr->refNsPtr = currNsPtr;
resPtr->refNsId = currNsPtr->nsId;
resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+69 -51
View File
@@ -518,7 +518,7 @@ Tcl_ParseCommand(
listStart = nextElem = tokenPtr[1].start;
while (nextElem < listEnd) {
int quoted;
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
tokenPtr->numComponents = 1;
@@ -625,47 +625,6 @@ TclIsSpaceProc(
return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
}
/*
*----------------------------------------------------------------------
*
* TclIsBareword--
*
* Report whether byte is one that can be part of a "bareword".
* This concept is named in expression parsing, where it determines
* what can be a legal function name, but is the same definition used
* in determining what variable names can be parsed as variable
* substitutions without the benefit of enclosing braces. The set of
* ASCII chars that are accepted are the numeric chars ('0'-'9'),
* the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_').
*
* Results:
* Returns 1, if byte is in the accepted set of chars, 0 otherwise.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclIsBareword(
char byte)
{
if (byte < '0' || byte > 'z') {
return 0;
}
if (byte <= '9' || byte >= 'a') {
return 1;
}
if (byte == '_') {
return 1;
}
if (byte < 'A' || byte > 'Z') {
return 0;
}
return 1;
}
/*
*----------------------------------------------------------------------
*
@@ -1190,8 +1149,6 @@ ParseTokens(
nestedPtr = (Tcl_Parse *)
TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
while (1) {
const char *curEnd;
if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
nestedPtr) != TCL_OK) {
parsePtr->errorType = nestedPtr->errorType;
@@ -1200,9 +1157,8 @@ ParseTokens(
TclStackFree(parsePtr->interp, nestedPtr);
return TCL_ERROR;
}
curEnd = src + numBytes;
src = nestedPtr->commandStart + nestedPtr->commandSize;
numBytes = curEnd - src;
numBytes = parsePtr->end - src;
Tcl_FreeParse(nestedPtr);
/*
@@ -1387,7 +1343,9 @@ Tcl_ParseVarName(
{
Tcl_Token *tokenPtr;
register const char *src;
int varIndex;
unsigned char c;
int varIndex, offset;
Tcl_UniChar ch;
unsigned array;
if ((numBytes == 0) || (start == NULL)) {
@@ -1470,12 +1428,22 @@ Tcl_ParseVarName(
tokenPtr->numComponents = 0;
while (numBytes) {
if (TclIsBareword(*src)) {
src += 1;
numBytes -= 1;
if (Tcl_UtfCharComplete(src, numBytes)) {
offset = Tcl_UtfToUniChar(src, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, src, (size_t) numBytes);
utfBytes[numBytes] = '\0';
offset = Tcl_UtfToUniChar(utfBytes, &ch);
}
c = UCHAR(ch);
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
src += offset;
numBytes -= offset;
continue;
}
if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) {
if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
src += 2;
numBytes -= 2;
while (numBytes && (*src == ':')) {
@@ -2565,6 +2533,56 @@ TclObjCommandComplete(
return CommandComplete(script, length);
}
/*
*----------------------------------------------------------------------
*
* TclIsLocalScalar --
*
* Check to see if a given string is a legal scalar variable name with no
* namespace qualifiers or substitutions.
*
* Results:
* Returns 1 if the variable is a local scalar.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclIsLocalScalar(
const char *src,
int len)
{
const char *p;
const char *lastChar = src + (len - 1);
for (p=src ; p<=lastChar ; p++) {
if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
(CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
/*
* TCL_COMMAND_END is returned for the last character of the
* string. By this point we know it isn't an array or namespace
* reference.
*/
return 0;
}
if (*p == '(') {
if (*lastChar == ')') { /* We have an array element */
return 0;
}
} else if (*p == ':') {
if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
return 0;
}
}
}
return 1;
}
/*
* Local Variables:
* mode: c
+107 -112
View File
@@ -29,9 +29,6 @@ static int IsSeparatorOrNull(int ch);
static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr);
static int MakePathFromNormalized(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
static Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[],
int forceRelative);
/*
* Define the 'path' object type, which Tcl uses to represent file paths
@@ -831,38 +828,43 @@ Tcl_FSJoinPath(
int elements) /* Number of elements to use (-1 = all) */
{
Tcl_Obj *res;
int objc;
Tcl_Obj **objv;
if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv, 0);
return res;
}
static Tcl_Obj *
TclJoinPath(
int elements, /* Number of elements to use (-1 = all) */
Tcl_Obj * const objv[], /* Path elements to join */
int forceRelative) /* If non-zero, assume all more paths are
* relative (e. g. simple normalization) */
{
Tcl_Obj *res = NULL; /* Resulting path object (container of join) */
Tcl_Obj *elt; /* Path part (result if returns part of path) */
int i;
Tcl_Filesystem *fsPtr = NULL;
if (elements < 0) {
if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
return NULL;
}
} else {
/*
* Just make sure it is a valid list.
*/
int listTest;
if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
return NULL;
}
/*
* Correct this if it is too large, otherwise we will waste our time
* joining null elements to the path.
*/
if (elements > listTest) {
elements = listTest;
}
}
res = NULL;
for (i = 0; i < elements; i++) {
Tcl_Obj *elt, *driveName = NULL;
int driveNameLength, strEltLen, length;
Tcl_PathType type;
char *strElt, *ptr;
Tcl_Obj *driveName = NULL;
elt = objv[i];
Tcl_ListObjIndex(NULL, listObj, i, &elt);
/*
* This is a special case where we can be much more efficient, where
@@ -871,24 +873,19 @@ TclJoinPath(
* object which can be normalized more efficiently. Currently we only
* use the special case when we have exactly two elements, but we
* could expand that in the future.
*
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
* to be an absolute path. Added a check for that elt is absolute.
*/
if ((i == 0) && (elements == 2)
&& (elt->typePtr == &tclFsPathType)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[i+1];
/* if forceRelative - second path is relative */
type = forceRelative ? TCL_PATH_RELATIVE :
TclGetPathType(tailObj, NULL, NULL, NULL);
if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
&& !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
Tcl_Obj *tail;
Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
type = TclGetPathType(tail, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
int len;
str = Tcl_GetStringFromObj(tailObj, &len);
str = Tcl_GetStringFromObj(tail, &len);
if (len == 0) {
/*
* This happens if we try to handle the root volume '/'.
@@ -896,7 +893,10 @@ TclJoinPath(
* the base itself is just fine!
*/
goto partReturn; /* return elt; */
if (res != NULL) {
TclDecrRefCount(res);
}
return elt;
}
/*
@@ -917,21 +917,11 @@ TclJoinPath(
*/
if ((tclPlatform != TCL_PLATFORM_WINDOWS)
|| (strchr(Tcl_GetString(elt), '\\') == NULL)
) {
if (PATHFLAGS(elt)) {
elt = TclNewFSPathObj(elt, str, len);
goto partReturn; /* return elt; */
}
if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
elt = TclNewFSPathObj(elt, str, len);
goto partReturn; /* return elt; */
}
(void) Tcl_FSGetNormalizedPath(NULL, elt);
if (elt == PATHOBJ(elt)->normPathPtr) {
elt = TclNewFSPathObj(elt, str, len);
goto partReturn; /* return elt; */
|| (strchr(Tcl_GetString(elt), '\\') == NULL)) {
if (res != NULL) {
TclDecrRefCount(res);
}
return TclNewFSPathObj(elt, str, len);
}
}
@@ -940,24 +930,25 @@ TclJoinPath(
* more general code below handle things.
*/
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
elt = tailObj;
goto partReturn; /* return elt; */
if (res != NULL) {
TclDecrRefCount(res);
}
return tail;
} else {
const char *str = TclGetString(tailObj);
const char *str = TclGetString(tail);
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
if (strchr(str, '\\') == NULL) {
elt = tailObj;
goto partReturn; /* return elt; */
if (res != NULL) {
TclDecrRefCount(res);
}
return tail;
}
}
}
}
strElt = Tcl_GetStringFromObj(elt, &strEltLen);
driveNameLength = 0;
/* if forceRelative - all paths excepting first one are relative */
type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
if (type != TCL_PATH_RELATIVE) {
/*
* Zero out the current result.
@@ -1012,12 +1003,6 @@ TclJoinPath(
}
}
ptr = strElt;
/* [Bug f34cf83dd0] */
if (driveNameLength > 0) {
if (ptr[0] == '/' && ptr[-1] == '/') {
goto noQuickReturn;
}
}
while (*ptr != '\0') {
if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) {
/*
@@ -1029,12 +1014,16 @@ TclJoinPath(
}
ptr++;
}
if (res != NULL) {
TclDecrRefCount(res);
}
/*
* This element is just what we want to return already; no further
* manipulation is requred.
* This element is just what we want to return already - no
* further manipulation is requred.
*/
goto partReturn; /* return elt; */
return elt;
}
/*
@@ -1045,8 +1034,10 @@ TclJoinPath(
noQuickReturn:
if (res == NULL) {
res = Tcl_NewObj();
ptr = Tcl_GetStringFromObj(res, &length);
} else {
ptr = Tcl_GetStringFromObj(res, &length);
}
ptr = Tcl_GetStringFromObj(res, &length);
/*
* Strip off any './' before a tilde, unless this is the beginning of
@@ -1075,11 +1066,10 @@ TclJoinPath(
int needsSep = 0;
if (fsPtr->filesystemSeparatorProc != NULL) {
Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res);
Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
if (sep != NULL) {
separator = TclGetString(sep)[0];
TclDecrRefCount(sep);
}
/* Safety check in case the VFS driver caused sharing */
if (Tcl_IsShared(res)) {
@@ -1119,12 +1109,6 @@ TclJoinPath(
res = Tcl_NewObj();
}
return res;
partReturn:
if (res != NULL) {
TclDecrRefCount(res);
}
return elt;
}
/*
@@ -1873,6 +1857,7 @@ Tcl_FSGetNormalizedPath(
*/
(void) Tcl_GetStringFromObj(dir, &cwdLen);
cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
/* Normalize the combined string. */
@@ -1893,13 +1878,13 @@ Tcl_FSGetNormalizedPath(
* to a normalized head, we can more efficiently normalize the
* combined path by passing over only the unnormalized tail
* portion. When this is sufficient, prior developers claim
* this should be much faster. We use 'cwdLen' so that we are
* this should be much faster. We use 'cwdLen-1' so that we are
* already pointing at the dir-separator that we know about.
* The normalization code will actually start off directly
* after that separator.
*/
TclFSNormalizeToUniquePath(interp, copy, cwdLen);
TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
}
/* Now we need to construct the new path object. */
@@ -2417,30 +2402,37 @@ SetFsPathFromAny(
* Handle tilde substitutions, if needed.
*/
if (len && name[0] == '~') {
if (name[0] == '~') {
char *expandedUser;
Tcl_DString temp;
int split;
char separator = '/';
/*
* We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
* split becomes value 1 for '~/...' as well as for '~'.
*/
split = FindSplitPos(name, separator);
if (split != len) {
/*
* We have multiple pieces '~user/foo/bar...'
*/
name[split] = '\0';
}
/*
* Do some tilde substitution.
*/
if (split == 1) {
if (name[1] == '\0') {
/*
* We have just '~' (or '~/...')
* We have just '~'
*/
const char *dir;
Tcl_DString dirString;
if (split != len) {
name[split] = separator;
}
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
@@ -2458,24 +2450,22 @@ SetFsPathFromAny(
* We have a user name '~user'
*/
Tcl_DString userName;
Tcl_DStringInit(&userName);
Tcl_DStringAppend(&userName, name+1, split-1);
expandedUser = Tcl_DStringValue(&userName);
Tcl_DStringInit(&temp);
if (TclpGetUserHome(expandedUser, &temp) == NULL) {
if (TclpGetUserHome(name+1, &temp) == NULL) {
if (interp != NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "user \"", expandedUser,
Tcl_AppendResult(interp, "user \"", name+1,
"\" doesn't exist", NULL);
}
Tcl_DStringFree(&userName);
Tcl_DStringFree(&temp);
if (split != len) {
name[split] = separator;
}
return TCL_ERROR;
}
Tcl_DStringFree(&userName);
if (split != len) {
name[split] = separator;
}
}
expandedUser = Tcl_DStringValue(&temp);
@@ -2509,22 +2499,27 @@ SetFsPathFromAny(
}
TclDecrRefCount(parts);
} else {
Tcl_Obj *pair[2];
/*
* Simple case. "rest" is relative path. Just join it. The
* "rest" object will be freed when Tcl_FSJoinToPath returns
* (unless something else claims a refCount on it).
*/
pair[0] = transPtr;
pair[1] = Tcl_NewStringObj(name+split+1, -1);
transPtr = TclJoinPath(2, pair, 1);
if (transPtr != pair[0]) {
TclDecrRefCount(pair[0]);
}
if (transPtr != pair[1]) {
TclDecrRefCount(pair[1]);
}
Tcl_Obj *joined;
Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1);
Tcl_IncrRefCount(transPtr);
joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
TclDecrRefCount(transPtr);
transPtr = joined;
}
}
Tcl_DStringFree(&temp);
} else {
transPtr = TclJoinPath(1, &pathPtr, 1);
/* Bug 3479689: protect 0-refcount pathPth from getting freed */
pathPtr->refCount++;
transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
pathPtr->refCount--;
}
/*
+36 -65
View File
@@ -349,7 +349,7 @@ PkgRequireCore(
Interp *iPtr = (Interp *) interp;
Package *pkgPtr;
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
char *availVersion, *bestVersion, *bestStableVersion;
char *availVersion, *bestVersion;
/* Internal rep. of versions */
int availStable, code, satisfies, pass;
char *script, *pkgVersionI;
@@ -395,7 +395,6 @@ PkgRequireCore(
bestPtr = NULL;
bestStablePtr = NULL;
bestVersion = NULL;
bestStableVersion = NULL;
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
@@ -409,9 +408,31 @@ PkgRequireCore(
continue;
}
/* Check satisfaction of requirements before considering the current version further. */
if (bestPtr != NULL) {
int res = CompareVersions(availVersion, bestVersion, NULL);
/*
* Note: Use internal reps!
*/
if (res <= 0) {
/*
* The version of the package sought is not as good as the
* currently selected version. Ignore it.
*/
ckfree(availVersion);
availVersion = NULL;
continue;
}
}
/* We have found a version which is better than our max. */
if (reqc > 0) {
/* Check satisfaction of requirements. */
satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
if (!satisfies) {
ckfree(availVersion);
@@ -419,76 +440,26 @@ PkgRequireCore(
continue;
}
}
if (bestPtr != NULL) {
int res = CompareVersions(availVersion, bestVersion, NULL);
/*
* Note: Used internal reps in the comparison!
*/
bestPtr = availPtr;
if (res > 0) {
/*
* The version of the package sought is better than the
* currently selected version.
*/
ckfree(bestVersion);
bestVersion = NULL;
goto newbest;
}
} else {
newbest:
/* We have found a version which is better than our max. */
bestPtr = availPtr;
CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
if (bestVersion != NULL) {
ckfree(bestVersion);
}
bestVersion = availVersion;
if (!availStable) {
ckfree(availVersion);
availVersion = NULL;
continue;
}
/*
* If this new best version is stable then it also has to be
* better than the max stable version found so far.
*/
if (bestStablePtr != NULL) {
int res = CompareVersions(availVersion, bestStableVersion, NULL);
/*
* Note: Used internal reps in the comparison!
*/
if (res > 0) {
/*
* This stable version of the package sought is better
* than the currently selected stable version.
*/
ckfree(bestStableVersion);
bestStableVersion = NULL;
goto newstable;
}
} else {
newstable:
/* We have found a stable version which is better than our max stable. */
if (availStable) {
bestStablePtr = availPtr;
CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
}
ckfree(availVersion);
availVersion = NULL;
} /* end for */
/*
* Clean up memorized internal reps, if any.
*/
if (bestVersion != NULL) {
ckfree(bestVersion);
bestVersion = NULL;
}
if (bestStableVersion != NULL) {
ckfree(bestStableVersion);
bestStableVersion = NULL;
if (bestVersion != NULL) {
ckfree(bestVersion);
}
/*
-3
View File
@@ -39,8 +39,5 @@
# define LLONG_MAX (~LLONG_MIN)
#endif
#define UWIDE_MAX ((Tcl_WideUInt)-1)
#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))
#endif /* _TCLPORT */
+148 -178
View File
@@ -64,7 +64,7 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
/*
* MIPS floating-point units need special settings in control registers
* to use gradual underflow as we expect. This fix is for the MIPSpro
* compiler.
* compiler.
*/
#if defined(__sgi) && defined(_COMPILER_VERSION)
#include <sys/fpu.h>
@@ -102,7 +102,7 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
/* Mask for the exponent field in the
* first word of a double */
#define EXP_SHIFT 20
/* Shift count to make the exponent an
/* Shift count to make the exponent an
* integer */
#define HIDDEN_BIT (((Tcl_WideUInt) 0x00100000) << 32)
/* Hidden 1 bit for the significand */
@@ -129,7 +129,7 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
/* Highest power of two that is greater than
* DBL_MAX_10_EXP, divided by 16 */
#define DIGIT_GROUP 8
/* floor(MP_DIGIT_BIT*log(2)/log(10)) */
/* floor(DIGIT_BIT*log(2)/log(10)) */
/* Union used to dismantle floating point numbers. */
@@ -263,7 +263,7 @@ static const Tcl_WideUInt wuipow5[27] = {
* Static functions defined in this file.
*/
static int AccumulateDecimalDigit(unsigned, int,
static int AccumulateDecimalDigit(unsigned, int,
Tcl_WideUInt *, mp_int *, int);
static double MakeHighPrecisionDouble(int signum,
mp_int *significand, int nSigDigs, int exponent);
@@ -286,7 +286,7 @@ static void ComputeScale(int, int, int*, int*, int*, int*);
static void SetPrecisionLimits(int, int, int*, int*, int*, int*);
static char* BumpUp(char*, char*, int*);
static int AdjustRange(double*, int);
static char* ShorteningQuickFormat(double, int, int, double,
static char* ShorteningQuickFormat(double, int, int, double,
char*, int*);
static char* StrictQuickFormat(double, int, int, double,
char*, int*);
@@ -302,15 +302,15 @@ static char* StrictInt64Conversion(Double*, int, Tcl_WideUInt,
static int ShouldBankerRoundUpPowD(mp_int*, int, int);
static int ShouldBankerRoundUpToNextPowD(mp_int*, mp_int*,
int, int, int, mp_int*);
static char* ShorteningBignumConversionPowD(Double* dPtr,
static char* ShorteningBignumConversionPowD(Double* dPtr,
int convType, Tcl_WideUInt bw, int b2, int b5,
int m2plus, int m2minus, int m5,
int sd, int k, int len,
int sd, int k, int len,
int ilim, int ilim1, int* decpt,
char** endPtr);
static char* StrictBignumConversionPowD(Double* dPtr, int convType,
Tcl_WideUInt bw, int b2, int b5,
int sd, int k, int len,
int sd, int k, int len,
int ilim, int ilim1, int* decpt,
char** endPtr);
static int ShouldBankerRoundUp(mp_int*, mp_int*, int);
@@ -319,12 +319,12 @@ static int ShouldBankerRoundUpToNext(mp_int*, mp_int*, mp_int*,
static char* ShorteningBignumConversion(Double* dPtr, int convType,
Tcl_WideUInt bw, int b2,
int m2plus, int m2minus,
int s2, int s5, int k, int len,
int s2, int s5, int k, int len,
int ilim, int ilim1, int* decpt,
char** endPtr);
static char* StrictBignumConversion(Double* dPtr, int convType,
Tcl_WideUInt bw, int b2,
int s2, int s5, int k, int len,
int s2, int s5, int k, int len,
int ilim, int ilim1, int* decpt,
char** endPtr);
static double BignumToBiasedFrExp(mp_int *big, int *machexp);
@@ -589,9 +589,6 @@ TclParseNumber(
acceptPoint = p;
acceptLen = len;
if (c == 'x' || c == 'X') {
if (flags & TCL_PARSE_OCTAL_ONLY) {
goto endgame;
}
state = ZERO_X;
break;
}
@@ -602,9 +599,6 @@ TclParseNumber(
goto zeroo;
}
if (c == 'b' || c == 'B') {
if (flags & TCL_PARSE_OCTAL_ONLY) {
goto endgame;
}
state = ZERO_B;
break;
}
@@ -1447,9 +1441,9 @@ AccumulateDecimalDigit(
* More than single digit multiplication. Multiply by the appropriate
* small powers of 5, and then shift. Large strings of zeroes are
* eaten 256 at a time; this is less efficient than it could be, but
* seems implausible. We presume that MP_DIGIT_BIT is at least 27. The
* seems implausible. We presume that DIGIT_BIT is at least 27. The
* first multiplication, by up to 10**7, is done with a one-DIGIT
* multiply (this presumes that MP_DIGIT_BIT >= 24).
* multiply (this presumes that DIGIT_BIT >= 24).
*/
n = numZeros + 1;
@@ -1521,7 +1515,7 @@ MakeLowPrecisionDouble(
* Test for the easy cases.
*/
if (numSigDigs <= QUICK_MAX) {
if (numSigDigs <= DBL_DIG) {
if (exponent >= 0) {
if (exponent <= mmaxpow) {
/*
@@ -1533,7 +1527,7 @@ MakeLowPrecisionDouble(
retval = (double)(Tcl_WideInt)significand * pow10vals[exponent];
goto returnValue;
} else {
int diff = QUICK_MAX - numSigDigs;
int diff = DBL_DIG - numSigDigs;
if (exponent-diff <= mmaxpow) {
/*
* 10**exponent is not an exact integer, but
@@ -1785,12 +1779,6 @@ RefineApproximation(
double quot; /* Correction term */
double minincr; /* Lower bound on the absolute value of the
* correction term. */
int roundToEven = 0; /* Flag == TRUE if we need to invoke
* "round to even" functionality */
double rteSignificand; /* Significand of the round-to-even result */
int rteExponent; /* Exponent of the round-to-even result */
Tcl_WideInt rteSigWide; /* Wide integer version of the significand
* for testing evenness */
int i;
/*
@@ -1833,15 +1821,15 @@ RefineApproximation(
*/
msb = binExponent + M2; /* 1008 */
nDigits = msb / MP_DIGIT_BIT + 1;
nDigits = msb / DIGIT_BIT + 1;
mp_init_size(&twoMv, nDigits);
i = (msb % MP_DIGIT_BIT + 1);
i = (msb % DIGIT_BIT + 1);
twoMv.used = nDigits;
significand *= SafeLdExp(1.0, i);
while (--nDigits >= 0) {
twoMv.dp[nDigits] = (mp_digit) significand;
significand -= (mp_digit) significand;
significand = SafeLdExp(significand, MP_DIGIT_BIT);
significand = SafeLdExp(significand, DIGIT_BIT);
}
for (i = 0; i <= 8; ++i) {
if (M5 & (1 << i)) {
@@ -1886,33 +1874,15 @@ RefineApproximation(
mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
}
switch (mp_cmp_mag(&twoMd, &twoMv)) {
case MP_LT:
/*
* If the result is less than unity, the error is less than 1/2 unit in
* the last place, so there's no correction to make.
*/
/*
* If the result is less than unity, the error is less than 1/2 unit in
* the last place, so there's no correction to make.
*/
if (mp_cmp_mag(&twoMd, &twoMv) == MP_LT) {
mp_clear(&twoMd);
mp_clear(&twoMv);
return approxResult;
case MP_EQ:
/*
* If the result is exactly unity, we need to round to even.
*/
roundToEven = 1;
break;
case MP_GT:
break;
}
if (roundToEven) {
rteSignificand = frexp(approxResult, &rteExponent);
rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION);
if ((rteSigWide & 1) == 0) {
mp_clear(&twoMd);
mp_clear(&twoMv);
return approxResult;
}
}
/*
@@ -2002,7 +1972,7 @@ NormalizeRightward(Tcl_WideUInt* wPtr)
Tcl_WideUInt w = *wPtr;
if (!(w & (Tcl_WideUInt) 0xffffffff)) {
w >>= 32; rv += 32;
}
}
if (!(w & (Tcl_WideUInt) 0xffff)) {
w >>= 16; rv += 16;
}
@@ -2153,7 +2123,7 @@ TakeAbsoluteValue(Double* d, /* Number to replace with absolute value */
*
* Side effects:
* Stores 9999 in *decpt, and sets '*endPtr' to designate the
* terminating NUL byte of the string if 'endPtr' is not NULL.
* terminating NUL byte of the string if 'endPtr' is not NULL.
*
* The string returned must be freed by the caller using 'ckfree'.
*
@@ -2241,8 +2211,8 @@ ApproximateLog10(Tcl_WideUInt bw,
/*
* Compute i and d2 such that d = d2*2**i, and 1 < d2 < 2.
* Compute an approximation to log10(d),
* log10(d) ~ log10(2) * i + log10(1.5)
* Compute an approximation to log10(d),
* log10(d) ~ log10(2) * i + log10(1.5)
* + (significand-1.5)/(1.5 * log(10))
*/
@@ -2282,7 +2252,7 @@ BetterLog10(double d, /* Original number to format */
int k, /* Characteristic(Log base 10) of the number */
int* k_check) /* Flag == 1 if k is inexact */
{
/*
/*
* Performance hack. If k is in the range 0..TEN_PMAX, then we can
* use a powers-of-ten table to check it.
*/
@@ -2326,7 +2296,7 @@ ComputeScale(int be, /* Exponent part of number: d = bw * 2**be */
int* s5) /* OUTPUT: Power of 5 in the denominator */
{
/*
/*
* Scale numerator and denominator powers of 2 so that the
* input binary number is the ratio of integers
*/
@@ -2338,7 +2308,7 @@ ComputeScale(int be, /* Exponent part of number: d = bw * 2**be */
*s2 = 0;
}
/*
/*
* Scale numerator and denominator so that the output decimal number
* is the ratio of integers
*/
@@ -2446,7 +2416,7 @@ SetPrecisionLimits(int convType,
inline static char*
BumpUp(char* s, /* Cursor pointing one past the end of the
* string */
* string */
char* retval, /* Start of the string of digits */
int* kPtr) /* Position of the decimal point */
{
@@ -2535,7 +2505,7 @@ AdjustRange(double* dPtr, /* INOUT: Number to adjust */
*
* Returns a 'quick' format of a double precision number to a string
* of digits, preferring a shorter string of digits if the shorter
* string is still within 1/2 ulp of the number.
* string is still within 1/2 ulp of the number.
*
* Results:
* Returns the string of digits. Returns NULL if the 'quick' method
@@ -2646,7 +2616,7 @@ StrictQuickFormat(double d, /* Number to convert */
}
*s++ = '0' + digit;
/*
/*
* When the given digit count is reached, handle trailing strings
* of 0 and 9.
*/
@@ -2860,13 +2830,13 @@ ShorteningInt64Conversion(Double* dPtr,
/* OUTPUT: Position of the terminal '\0'
* at the end of the returned string */
{
char* retval = ckalloc(len + 1);
/* Output buffer */
Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
/* Numerator of the fraction being converted */
Tcl_WideUInt S = wuipow5[s5] << s2;
/* Denominator of the fraction being
/* Denominator of the fraction being
* converted */
Tcl_WideUInt mplus, mminus; /* Ranges for testing whether the result
* is within roundoff of being exact */
@@ -2898,7 +2868,7 @@ ShorteningInt64Conversion(Double* dPtr,
}
b = b % S;
/*
/*
* Does the current digit put us on the low side of the exact value
* but within within roundoff of being exact?
*/
@@ -2956,16 +2926,16 @@ ShorteningInt64Conversion(Double* dPtr,
}
break;
}
/* Advance to the next digit */
b = 10 * b;
mplus = 10 * mplus;
mminus = 10 * mminus;
++i;
}
/*
/*
* Endgame - store the location of the decimal point and the end of the
* string.
*/
@@ -3028,13 +2998,13 @@ StrictInt64Conversion(Double* dPtr,
/* OUTPUT: Position of the terminal '\0'
* at the end of the returned string */
{
char* retval = ckalloc(len + 1);
/* Output buffer */
Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
/* Numerator of the fraction being converted */
Tcl_WideUInt S = wuipow5[s5] << s2;
/* Denominator of the fraction being
/* Denominator of the fraction being
* converted */
int digit; /* Current output digit */
char* s = retval; /* Cursor in the output buffer */
@@ -3074,14 +3044,14 @@ StrictInt64Conversion(Double* dPtr,
}
break;
}
/* Advance to the next digit */
b = 10 * b;
++i;
}
/*
/*
* Endgame - store the location of the decimal point and the end of the
* string.
*/
@@ -3100,7 +3070,7 @@ StrictInt64Conversion(Double* dPtr,
*
* Test whether bankers' rounding should round a digit up. Assumption
* is made that the denominator of the fraction being tested is
* a power of 2**MP_DIGIT_BIT.
* a power of 2**DIGIT_BIT.
*
* Results:
* Returns 1 iff the fraction is more than 1/2, or if the fraction
@@ -3112,12 +3082,12 @@ StrictInt64Conversion(Double* dPtr,
inline static int
ShouldBankerRoundUpPowD(mp_int* b,
/* Numerator of the fraction */
int sd, /* Denominator is 2**(sd*MP_DIGIT_BIT) */
int sd, /* Denominator is 2**(sd*DIGIT_BIT) */
int isodd)
/* 1 if the digit is odd, 0 if even */
{
int i;
static const mp_digit topbit = (1<<(MP_DIGIT_BIT-1));
static const mp_digit topbit = (1<<(DIGIT_BIT-1));
if (b->used < sd || (b->dp[sd-1] & topbit) == 0) {
return 0;
}
@@ -3152,10 +3122,10 @@ ShouldBankerRoundUpToNextPowD(mp_int* b,
/* Numerator of the fraction */
mp_int* m,
/* Numerator of the rounding tolerance */
int sd,
/* Common denominator is 2**(sd*MP_DIGIT_BIT) */
int sd,
/* Common denominator is 2**(sd*DIGIT_BIT) */
int convType,
/* Conversion type: STEELE defeats
/* Conversion type: STEELE defeats
* round-to-even (Not sure why one wants to
* do this; I copied it from Gay) FIXME */
int isodd,
@@ -3165,10 +3135,10 @@ ShouldBankerRoundUpToNextPowD(mp_int* b,
{
int i;
/*
/*
* Compare B and S-m -- which is the same as comparing B+m and S --
* which we do by computing b+m and doing a bitwhack compare against
* 2**(MP_DIGIT_BIT*sd)
* 2**(DIGIT_BIT*sd)
*/
mp_add(b, m, temp);
if (temp->used <= sd) { /* too few digits to be > S */
@@ -3200,7 +3170,7 @@ ShouldBankerRoundUpToNextPowD(mp_int* b,
* digits that reconverts exactly to the given number, or to
* 'ilim' digits if that will yield a shorter result. The denominator
* in David Gay's conversion algorithm is known to be a power of
* 2**MP_DIGIT_BIT, and hence the division in the main loop may be replaced
* 2**DIGIT_BIT, and hence the division in the main loop may be replaced
* by a digit shift and mask.
*
* Results:
@@ -3246,7 +3216,7 @@ ShorteningBignumConversionPowD(Double* dPtr,
/* OUTPUT: Position of the terminal '\0'
* at the end of the returned string */
{
char* retval = ckalloc(len + 1);
/* Output buffer */
mp_int b; /* Numerator of the fraction being converted */
@@ -3257,13 +3227,13 @@ ShorteningBignumConversionPowD(Double* dPtr,
mp_int temp;
int r1;
/*
/*
* b = bw * 2**b2 * 5**b5
* mminus = 5**m5
*/
TclBNInitBignumFromWideUInt(&b, bw);
mp_init_set(&mminus, 1);
mp_init_set_int(&mminus, 1);
MulPow5(&b, b5, &b);
mp_mul_2d(&b, b2, &b);
@@ -3289,7 +3259,7 @@ ShorteningBignumConversionPowD(Double* dPtr,
}
mp_init(&temp);
/* Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
/* Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
* by mp_digit extraction */
i = 0;
@@ -3304,11 +3274,11 @@ ShorteningBignumConversionPowD(Double* dPtr,
--b.used; mp_clamp(&b);
}
/*
/*
* Does the current digit put us on the low side of the exact value
* but within within roundoff of being exact?
*/
r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
if (r1 == MP_LT
|| (r1 == MP_EQ
@@ -3337,8 +3307,8 @@ ShorteningBignumConversionPowD(Double* dPtr,
* Does one plus the current digit put us within roundoff of the
* number?
*/
if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd,
if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd,
convType, dPtr->w.word1 & 1,
&temp)) {
if (digit == 9) {
@@ -3361,9 +3331,9 @@ ShorteningBignumConversionPowD(Double* dPtr,
}
break;
}
/* Advance to the next digit */
mp_mul_d(&b, 10, &b);
mp_mul_d(&mminus, 10, &mminus);
if (m2plus > m2minus) {
@@ -3372,7 +3342,7 @@ ShorteningBignumConversionPowD(Double* dPtr,
++i;
}
/*
/*
* Endgame - store the location of the decimal point and the end of the
* string.
*/
@@ -3396,7 +3366,7 @@ ShorteningBignumConversionPowD(Double* dPtr,
* Converts a double-precision number to a fixed-lengt string of
* 'ilim' digits (or 'ilim1' if log10(d) has been overestimated.)
* The denominator in David Gay's conversion algorithm is known to
* be a power of 2**MP_DIGIT_BIT, and hence the division in the main
* be a power of 2**DIGIT_BIT, and hence the division in the main
* loop may be replaced by a digit shift and mask.
*
* Results:
@@ -3438,7 +3408,7 @@ StrictBignumConversionPowD(Double* dPtr,
/* OUTPUT: Position of the terminal '\0'
* at the end of the returned string */
{
char* retval = ckalloc(len + 1);
/* Output buffer */
mp_int b; /* Numerator of the fraction being converted */
@@ -3447,7 +3417,7 @@ StrictBignumConversionPowD(Double* dPtr,
int i; /* Index in the output buffer */
mp_int temp;
/*
/*
* b = bw * 2**b2 * 5**b5
*/
@@ -3464,9 +3434,9 @@ StrictBignumConversionPowD(Double* dPtr,
}
mp_init(&temp);
/*
* Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
* by mp_digit extraction
/*
* Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
* by mp_digit extraction
*/
i = 1;
@@ -3496,14 +3466,14 @@ StrictBignumConversionPowD(Double* dPtr,
}
break;
}
/* Advance to the next digit */
mp_mul_d(&b, 10, &b);
++i;
}
/*
/*
* Endgame - store the location of the decimal point and the end of the
* string.
*/
@@ -3600,7 +3570,7 @@ ShouldBankerRoundUpToNext(mp_int* b,
Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!");
return 0;
}
/*
*-----------------------------------------------------------------------------
*
@@ -3666,14 +3636,14 @@ ShorteningBignumConversion(Double* dPtr,
TclBNInitBignumFromWideUInt(&b, bw);
mp_mul_2d(&b, b2, &b);
mp_init_set(&S, 1);
mp_init_set_int(&S, 1);
MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
/*
* Handle the case where we guess the position of the decimal point
* wrong.
* 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);
minit = 10;
@@ -3683,7 +3653,7 @@ ShorteningBignumConversion(Double* dPtr,
/* mminus = 2**m2minus * 5**m5 */
mp_init_set(&mminus, minit);
mp_init_set_int(&mminus, minit);
mp_mul_2d(&mminus, m2minus, &mminus);
if (m2plus > m2minus) {
mp_init_copy(&mplus, &mminus);
@@ -3702,7 +3672,7 @@ ShorteningBignumConversion(Double* dPtr,
}
digit = dig.dp[0];
/*
/*
* Does the current digit leave us with a remainder small enough to
* round to it?
*/
@@ -3748,7 +3718,7 @@ ShorteningBignumConversion(Double* dPtr,
if (i == ilim) {
mp_mul_2d(&b, 1, &b);
if (ShouldBankerRoundUp(&b, &S, digit&1)) {
s = BumpUp(s, retval, &k);
s = BumpUp(s, retval, &k);
}
break;
}
@@ -3765,7 +3735,7 @@ ShorteningBignumConversion(Double* dPtr,
}
mp_div_d(&S, 5, &S, NULL);
--s5;
/*
/*
* IDEA: It might possibly be a win to fall back to
* int64 arithmetic here if S < 2**64/10. But it's
* a win only for a fairly narrow range of magnitudes
@@ -3775,7 +3745,7 @@ ShorteningBignumConversion(Double* dPtr,
* Possible savings:
* 10**26 1 trip through loop before fallback possible
* 10**27 1 trip
* 10**28 2 trips
* 10**28 2 trips
* 10**29 3 trips
* 10**30 4 trips
* 10**31 5 trips
@@ -3804,7 +3774,7 @@ ShorteningBignumConversion(Double* dPtr,
}
/*
/*
* Endgame - store the location of the decimal point and the end of the
* string.
*/
@@ -3820,7 +3790,7 @@ ShorteningBignumConversion(Double* dPtr,
return retval;
}
/*
*-----------------------------------------------------------------------------
*
@@ -3870,7 +3840,7 @@ StrictBignumConversion(Double* dPtr,
mp_int temp; /* Work area */
int g; /* Size of the current digit groun */
int i, j;
/*
* b = bw * 2**b2 * 5**b5
* S = 2**s2 * 5*s5
@@ -3879,14 +3849,14 @@ StrictBignumConversion(Double* dPtr,
mp_init_multi(&temp, &dig, NULL);
TclBNInitBignumFromWideUInt(&b, bw);
mp_mul_2d(&b, b2, &b);
mp_init_set(&S, 1);
mp_init_set_int(&S, 1);
MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
/*
* Handle the case where we guess the position of the decimal point
* wrong.
* 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);
ilim =ilim1;
@@ -3908,7 +3878,7 @@ StrictBignumConversion(Double* dPtr,
if (++i >= ilim) {
mp_mul_2d(&b, 1, &b);
if (ShouldBankerRoundUp(&b, &S, digit&1)) {
s = BumpUp(s, retval, &k);
s = BumpUp(s, retval, &k);
}
} else {
@@ -3931,7 +3901,7 @@ StrictBignumConversion(Double* dPtr,
mp_mul_d(&b, dpow5[g], &b);
}
mp_mul_2d(&b, g, &b);
/*
* As with the shortening bignum conversion, it's possible at
* this point that we will have reduced the denominator to
@@ -3944,7 +3914,7 @@ StrictBignumConversion(Double* dPtr,
*/
/* Extract the next group of digits */
mp_div(&b, &S, &dig, &b);
if (dig.used > 1) {
Tcl_Panic("wrong digit!");
@@ -3956,24 +3926,24 @@ StrictBignumConversion(Double* dPtr,
digit %= t;
}
i += g;
/* Have we converted all the requested digits? */
if (i == ilim) {
mp_mul_2d(&b, 1, &b);
if (ShouldBankerRoundUp(&b, &S, digit&1)) {
s = BumpUp(s, retval, &k);
s = BumpUp(s, retval, &k);
} else {
while (*--s == '0') {
/* do nothing */
}
++s;
}
}
break;
}
}
}
/*
/*
* Endgame - store the location of the decimal point and the end of the
* string.
*/
@@ -4017,7 +3987,7 @@ StrictBignumConversion(Double* dPtr,
* TCL_DD_STEELE - This value is not recommended and may be removed
* in the future. It follows the conversion algorithm outlined
* in "How to Print Floating-Point Numbers Accurately" by
* Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90,
* Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90,
* pp. 112-126]. This rule has the effect of rendering 1e23
* as 9.9999999999999999e22 - which is a 'better' approximation
* in the sense that it will reconvert correctly even if
@@ -4029,14 +3999,14 @@ StrictBignumConversion(Double* dPtr,
* 'ndigits' digits, choosing the one that is closest to the
* given number (and resolving ties with 'round to even').
* It is allowed to return fewer than 'ndigits' if the number
* converts exactly; if the TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG
* is supplied instead, it also returns fewer digits if the
* converts exactly; if the TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG
* is supplied instead, it also returns fewer digits if the
* shorter string will still reconvert to the given input number.
* In any case, strings of trailing zeroes are suppressed.
* TCL_DD_F_FORMAT - This value is used to prepare numbers for %f
* format conversion. It requests that conversion proceed until
* 'ndigits' digits after the decimal point have been converted.
* It is possible for this format to result in a zero-length
* It is possible for this format to result in a zero-length
* string if the number is sufficiently small. Again, it
* is permissible for TCL_DD_F_FORMAT to return fewer digits
* for a number that converts exactly, and changing the
@@ -4053,12 +4023,12 @@ StrictBignumConversion(Double* dPtr,
* midpoint between two decimal strings that more precision is needed
* to resolve which string is correct.
*
* The value stored in the 'decpt' argument on return may be negative
* (indicating that the decimal point falls to the left of the string)
* The value stored in the 'decpt' argument on return may be negative
* (indicating that the decimal point falls to the left of the string)
* or greater than the length of the string. In addition, the value -9999
* is used as a sentinel to indicate that the string is one of the special
* values "Infinity" and "NaN", and that no decimal point should be inserted.
*
*
*-----------------------------------------------------------------------------
*/
char*
@@ -4084,12 +4054,12 @@ TclDoubleDigits(double dv, /* Number to convert */
int denorm; /* Flag == 1 iff the input number was
* denormalized */
int k; /* Estimate of floor(log10(d)) */
int k_check; /* Flag == 1 if d is near enough to a
int k_check; /* Flag == 1 if d is near enough to a
* power of ten that k must be checked */
int b2, b5, s2, s5; /* Powers of 2 and 5 in the numerator and
* denominator of intermediate results */
int ilim = -1, ilim1 = -1; /* Number of digits to convert, and number
* to convert if log10(d) has been
* to convert if log10(d) has been
* overestimated */
char* retval; /* Return value from this function */
int i = -1;
@@ -4098,7 +4068,7 @@ TclDoubleDigits(double dv, /* Number to convert */
d.d = dv;
/*
/*
* Handle the cases of negative numbers (by taking the absolute value:
* this includes -Inf and -NaN!), infinity, Not a Number, and zero.
*/
@@ -4111,7 +4081,7 @@ TclDoubleDigits(double dv, /* Number to convert */
return FormatZero(decpt, endPtr);
}
/*
/*
* Unpack the floating point into a wide integer and an exponent.
* Determine the number of bits that the big integer requires, and
* compute a quick approximation (which may be one too high) of
@@ -4124,12 +4094,12 @@ TclDoubleDigits(double dv, /* Number to convert */
/* At this point, we have:
* d is the number to convert.
* bw are significand and exponent: d == bw*2**be,
* bw are significand and exponent: d == bw*2**be,
* bbits is the length of bw: 2**bbits-1 <= bw < 2**bbits
* k is either ceil(log10(d)) or ceil(log10(d))+1. k_check is 0
* if we know that k is exactly ceil(log10(d)) and 1 if we need to
* check.
* We want a rational number
* We want a rational number
* r = b * 10**(1-k) = bw * 2**b2 * 5**b5 / (2**s2 / 5**s5),
* with b2, b5, s2, s5 >= 0. Note that the most significant decimal
* digit is floor(r) and that successive digits can be obtained
@@ -4157,7 +4127,7 @@ TclDoubleDigits(double dv, /* Number to convert */
SetPrecisionLimits(convType, k, &ndigits, &i, &ilim, &ilim1);
/*
/*
* Try to do low-precision conversion in floating point rather
* than resorting to expensive multiprecision arithmetic
*/
@@ -4169,7 +4139,7 @@ TclDoubleDigits(double dv, /* Number to convert */
}
}
/*
/*
* For shortening conversions, determine the upper and lower bounds
* for the remainder at which we can stop.
* m+ = (2**m2plus * 5**m5) / (2**s2 * 5**s5) is the limit on the
@@ -4186,9 +4156,9 @@ TclDoubleDigits(double dv, /* Number to convert */
int m5 = b5;
int len = i;
/*
/*
* Find the quantity i so that (2**i*5**b5)/(2**s2*5**s5)
* is 1/2 unit in the least significant place of the floating
* is 1/2 unit in the least significant place of the floating
* point number.
*/
if (denorm) {
@@ -4199,7 +4169,7 @@ TclDoubleDigits(double dv, /* Number to convert */
b2 += i;
s2 += i;
/*
/*
* Reduce the fractions to lowest terms, since the above calculation
* may have left excess powers of 2 in numerator and denominator
*/
@@ -4228,18 +4198,18 @@ TclDoubleDigits(double dv, /* Number to convert */
return ShorteningInt64Conversion(&d, convType, bw, b2, b5,
m2plus, m2minus, m5,
s2, s5, k, len, ilim, ilim1,
s2, s5, k, len, ilim, ilim1,
decpt, endPtr);
} else if (s5 == 0) {
/*
* The denominator is a power of 2, so we can replace division
* by digit shifts. First we round up s2 to a multiple of
* MP_DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch
* DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch
* into a version of the comparison that's specialized for
* the 'power of mp_digit in the denominator' case.
*/
if (s2 % MP_DIGIT_BIT != 0) {
int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT);
if (s2 % DIGIT_BIT != 0) {
int delta = DIGIT_BIT - (s2 % DIGIT_BIT);
b2 += delta;
m2plus += delta;
m2minus += delta;
@@ -4247,11 +4217,11 @@ TclDoubleDigits(double dv, /* Number to convert */
}
return ShorteningBignumConversionPowD(&d, convType, bw, b2, b5,
m2plus, m2minus, m5,
s2/MP_DIGIT_BIT, k, len,
s2/DIGIT_BIT, k, len,
ilim, ilim1, decpt, endPtr);
} else {
/*
/*
* Alas, there's no helpful special case; use full-up
* bignum arithmetic for the conversion
*/
@@ -4287,24 +4257,24 @@ TclDoubleDigits(double dv, /* Number to convert */
*/
return StrictInt64Conversion(&d, convType, bw, b2, b5,
s2, s5, k, len, ilim, ilim1,
s2, s5, k, len, ilim, ilim1,
decpt, endPtr);
} else if (s5 == 0) {
/*
* The denominator is a power of 2, so we can replace division
* by digit shifts. First we round up s2 to a multiple of
* MP_DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch
* DIGIT_BIT, and adjust m2 and b2 accordingly. Then we launch
* into a version of the comparison that's specialized for
* the 'power of mp_digit in the denominator' case.
*/
if (s2 % MP_DIGIT_BIT != 0) {
int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT);
if (s2 % DIGIT_BIT != 0) {
int delta = DIGIT_BIT - (s2 % DIGIT_BIT);
b2 += delta;
s2 += delta;
}
return StrictBignumConversionPowD(&d, convType, bw, b2, b5,
s2/MP_DIGIT_BIT, k, len,
s2/DIGIT_BIT, k, len,
ilim, ilim1, decpt, endPtr);
} else {
/*
@@ -4316,7 +4286,7 @@ TclDoubleDigits(double dv, /* Number to convert */
return StrictBignumConversion(&d, convType, bw, b2, s2, s5,
k, len, ilim, ilim1, decpt, endPtr);
}
}
}
}
@@ -4433,7 +4403,7 @@ TclInitDoubleConversion(void)
+ 0.5 * log(10.)) / log(10.));
minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG)
* log((double) FLT_RADIX) / log(10.));
log10_DIGIT_MAX = (int) floor(MP_DIGIT_BIT * log(2.) / log(10.));
log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.));
/*
* Nokia 770's software-emulated floating point is "middle endian": the
@@ -4566,22 +4536,22 @@ TclBignumToDouble(
/*
* We need a 'mantBits'-bit significand. Determine what shift will
* We need a 'mantBits'-bit significand. Determine what shift will
* give us that.
*/
bits = mp_count_bits(a);
if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
errno = ERANGE;
if (mp_isneg(a)) {
return -HUGE_VAL;
} else {
if (a->sign == MP_ZPOS) {
return HUGE_VAL;
} else {
return -HUGE_VAL;
}
}
shift = mantBits - bits;
/*
/*
* If shift > 0, shift the significand left by the requisite number of
* bits. If shift == 0, the significand is already exactly 'mantBits'
* in length. If shift < 0, we will need to shift the significand right
@@ -4606,10 +4576,10 @@ TclBignumToDouble(
mp_div_2d(a, -shift, &b, NULL);
if (mp_isodd(&b)) {
if (mp_isneg(&b)) {
mp_sub_d(&b, 1, &b);
} else {
if (b.sign == MP_ZPOS) {
mp_add_d(&b, 1, &b);
} else {
mp_sub_d(&b, 1, &b);
}
}
} else {
@@ -4619,10 +4589,10 @@ TclBignumToDouble(
*/
mp_div_2d(a, -1-shift, &b, NULL);
if (mp_isneg(&b)) {
mp_sub_d(&b, 1, &b);
} else {
if (b.sign == MP_ZPOS) {
mp_add_d(&b, 1, &b);
} else {
mp_sub_d(&b, 1, &b);
}
mp_div_2d(&b, 1, &b, NULL);
}
@@ -4634,7 +4604,7 @@ TclBignumToDouble(
r = 0.0;
for (i=b.used-1 ; i>=0 ; --i) {
r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
r = ldexp(r, DIGIT_BIT) + b.dp[i];
}
mp_clear(&b);
@@ -4648,10 +4618,10 @@ TclBignumToDouble(
* Return the result with the appropriate sign.
*/
if (mp_isneg(a)) {
return -r;
} else {
if (a->sign == MP_ZPOS) {
return r;
} else {
return -r;
}
}
@@ -4703,7 +4673,7 @@ TclCeil(
mp_add_d(&b, 1, &b);
}
for (i=b.used-1 ; i>=0 ; --i) {
r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
r = ldexp(r, DIGIT_BIT) + b.dp[i];
}
r = ldexp(r, bits - mantBits);
}
@@ -4753,7 +4723,7 @@ TclFloor(
mp_copy(a, &b);
}
for (i=b.used-1 ; i>=0 ; --i) {
r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
r = ldexp(r, DIGIT_BIT) + b.dp[i];
}
r = ldexp(r, bits - mantBits);
}
@@ -4815,7 +4785,7 @@ BignumToBiasedFrExp(
r = 0.0;
for (i=b.used-1; i>=0; --i) {
r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
r = ldexp(r, DIGIT_BIT) + b.dp[i];
}
mp_clear(&b);
@@ -4824,7 +4794,7 @@ BignumToBiasedFrExp(
*/
*machexp = bits - mantBits + 2;
return (mp_isneg(a) ? -r : r);
return ((a->sign == MP_ZPOS) ? r : -r);
}
/*
+10 -16
View File
@@ -113,7 +113,7 @@ typedef struct String {
#define STRING_UALLOC(numChars) \
((numChars) * sizeof(Tcl_UniChar))
#define STRING_SIZE(ualloc) \
((unsigned) ((ualloc != 0) \
((unsigned) ((ualloc) \
? (sizeof(String) - sizeof(Tcl_UniChar) + (ualloc)) \
: sizeof(String)))
#define stringCheckLimits(numChars) \
@@ -1261,8 +1261,6 @@ Tcl_AppendUnicodeToObj(
* Side effects:
* The string rep of appendObjPtr is appended to the string
* representation of objPtr.
* IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr.
* Callers are counting on that.
*
*----------------------------------------------------------------------
*/
@@ -1394,7 +1392,7 @@ AppendUnicodeToUnicodeRep(
+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
offset = unicode - stringPtr->unicode;
}
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
@@ -1577,7 +1575,7 @@ AppendUtfToUtfRep(
unsigned int limit = INT_MAX - newLength;
unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC;
int growth = (int) ((extra > limit) ? limit : extra);
Tcl_SetObjLength(objPtr, newLength + growth);
}
@@ -1938,10 +1936,6 @@ Tcl_AppendFormatToObj(
width = 0;
if (isdigit(UCHAR(ch))) {
width = strtoul(format, &end, 10);
if (width < 0) {
msg = overflow;
goto errorMsg;
}
format = end;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == '*') {
@@ -2093,7 +2087,7 @@ Tcl_AppendFormatToObj(
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
goto error;
}
mp_mod_2d(&big, CHAR_BIT*sizeof(Tcl_WideInt), &big);
mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
@@ -2107,7 +2101,7 @@ Tcl_AppendFormatToObj(
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
goto error;
}
mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big);
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
TclGetLongFromObj(NULL, objPtr, &l);
@@ -2251,11 +2245,11 @@ Tcl_AppendFormatToObj(
uw /= base;
}
} else if (useBig && big.used) {
int leftover = (big.used * MP_DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover);
int leftover = (big.used * DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
numDigits = 1 +
(((Tcl_WideInt)big.used * MP_DIGIT_BIT) / numBits);
(((Tcl_WideInt)big.used * DIGIT_BIT) / numBits);
while ((mask & big.dp[big.used-1]) == 0) {
numDigits--;
mask >>= numBits;
@@ -2290,9 +2284,9 @@ Tcl_AppendFormatToObj(
if (useBig && big.used) {
if (index < big.used && (size_t) shift <
CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift);
shift += MP_DIGIT_BIT;
shift += DIGIT_BIT;
}
shift -= numBits;
}
+4 -4
View File
@@ -909,7 +909,7 @@ TestasyncCmd(
static int
AsyncHandlerProc(
ClientData clientData, /* If of TestAsyncHandler structure.
ClientData clientData, /* If of TestAsyncHandler structure.
* in global list. */
Tcl_Interp *interp, /* Interpreter in which command was
* executed, or NULL. */
@@ -3606,7 +3606,7 @@ PrintParse(
Tcl_Parse *parsePtr) /* Parse structure to print out. */
{
Tcl_Obj *objPtr;
const char *typeString;
char *typeString;
Tcl_Token *tokenPtr;
int i;
@@ -4326,7 +4326,7 @@ TesttranslatefilenameCmd(
*
* TestupvarCmd --
*
* This procedure implements the "testupvar" command. It is used
* This procedure implements the "testupvar2" command. It is used
* to test Tcl_UpVar and Tcl_UpVar2.
*
* Results:
@@ -6518,7 +6518,7 @@ TestGetIndexFromObjStructObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *ary[] = {
char *ary[] = {
"a", "b", "c", "d", "e", "f", NULL, NULL
};
int idx,target;
+2 -47
View File
@@ -132,11 +132,10 @@ TestbignumobjCmd(
Tcl_Obj *const objv[]) /* Argument vector */
{
const char * subcmds[] = {
"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
"set", "get", "mult10", "div10", NULL
};
enum options {
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
BIGNUM_RADIXSIZE
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
};
int index, varIndex;
@@ -254,50 +253,6 @@ TestbignumobjCmd(
} else {
SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
}
break;
case BIGNUM_ISEVEN:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], !mp_isodd(&bignumValue));
} else {
SetVarToObj(varIndex, Tcl_NewIntObj(!mp_isodd(&bignumValue)));
}
mp_clear(&bignumValue);
break;
case BIGNUM_RADIXSIZE:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
if (mp_radix_size(&bignumValue, 10, &index) != MP_OKAY) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], index);
} else {
SetVarToObj(varIndex, Tcl_NewIntObj(index));
}
mp_clear(&bignumValue);
break;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
+12 -12
View File
@@ -24,7 +24,7 @@
typedef struct {
int num; /* Number of objects remembered */
int max; /* Max size of the array */
void **list; /* List of pointers */
char **list; /* List of pointers */
} SyncObjRecord;
static SyncObjRecord keyRecord = {0, 0, NULL};
@@ -35,8 +35,8 @@ static SyncObjRecord condRecord = {0, 0, NULL};
* Prototypes of functions used only in this file.
*/
static void ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr);
static void RememberSyncObject(void *objPtr,
static void ForgetSyncObject(char *objPtr, SyncObjRecord *recPtr);
static void RememberSyncObject(char *objPtr,
SyncObjRecord *recPtr);
/*
@@ -94,7 +94,7 @@ Tcl_GetThreadData(
result = ckalloc((size_t) size);
memset(result, 0, (size_t) size);
*keyPtr = (Tcl_ThreadDataKey)result;
RememberSyncObject(keyPtr, &keyRecord);
RememberSyncObject((char *) keyPtr, &keyRecord);
}
result = * (void **) keyPtr;
#endif /* TCL_THREADS */
@@ -153,10 +153,10 @@ TclThreadDataKeyGet(
static void
RememberSyncObject(
void *objPtr, /* Pointer to sync object */
char *objPtr, /* Pointer to sync object */
SyncObjRecord *recPtr) /* Record of sync objects */
{
void **newList;
char **newList;
int i, j;
@@ -178,7 +178,7 @@ RememberSyncObject(
if (recPtr->num >= recPtr->max) {
recPtr->max += 8;
newList = (void **) ckalloc(recPtr->max * sizeof(char *));
newList = (char **) ckalloc(recPtr->max * sizeof(char *));
for (i=0,j=0 ; i<recPtr->num ; i++) {
if (recPtr->list[i] != NULL) {
newList[j++] = recPtr->list[i];
@@ -214,7 +214,7 @@ RememberSyncObject(
static void
ForgetSyncObject(
void *objPtr, /* Pointer to sync object */
char *objPtr, /* Pointer to sync object */
SyncObjRecord *recPtr) /* Record of sync objects */
{
int i;
@@ -248,7 +248,7 @@ void
TclRememberMutex(
Tcl_Mutex *mutexPtr)
{
RememberSyncObject(mutexPtr, &mutexRecord);
RememberSyncObject((char *)mutexPtr, &mutexRecord);
}
/*
@@ -276,7 +276,7 @@ Tcl_MutexFinalize(
TclpFinalizeMutex(mutexPtr);
#endif
TclpMasterLock();
ForgetSyncObject(mutexPtr, &mutexRecord);
ForgetSyncObject((char *) mutexPtr, &mutexRecord);
TclpMasterUnlock();
}
@@ -301,7 +301,7 @@ void
TclRememberCondition(
Tcl_Condition *condPtr)
{
RememberSyncObject(condPtr, &condRecord);
RememberSyncObject((char *) condPtr, &condRecord);
}
/*
@@ -329,7 +329,7 @@ Tcl_ConditionFinalize(
TclpFinalizeCondition(condPtr);
#endif
TclpMasterLock();
ForgetSyncObject(condPtr, &condRecord);
ForgetSyncObject((char *) condPtr, &condRecord);
TclpMasterUnlock();
}
+6 -6
View File
@@ -135,7 +135,7 @@ AllocThreadStorageEntry(
hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
hPtr->key.oneWordValue = keyPtr;
hPtr->clientData = NULL;
return hPtr;
}
@@ -170,7 +170,7 @@ FreeThreadStorageEntry(
* ThreadStorageGetHashTable --
*
* This procedure returns a hash table pointer to be used for thread
* storage for the specified thread.
* storage for the specified thread.
*
* Results:
* A hash table pointer for the specified thread, or NULL if the hash
@@ -182,8 +182,8 @@ FreeThreadStorageEntry(
*
* Thread safety:
* This function assumes that integer operations are safe (atomic)
* on all (currently) supported Tcl platforms. Hence there are
* places where shared integer arithmetic is done w/o protective locks.
* on all (currently) supported Tcl platforms. Hence there are
* places where shared integer arithmetic is done w/o protective locks.
*
*----------------------------------------------------------------------
*/
@@ -205,12 +205,12 @@ ThreadStorageGetHashTable(
* Thread safety: threadStorageCache is accessed w/o locks in order to
* avoid serialization of all threads at this hot-spot. It is safe to
* do this here because (threadStorageCache[index].id != id) test below
* should be atomic on all (currently) supported platforms and there
* should be atomic on all (currently) supported platforms and there
* are no devastatig side effects of the test.
*
* Note Valgrind users: this place will show up as a race-condition in
* helgrind-tool output. To silence this warnings, define VALGRIND
* symbol at compilation time.
* symbol at compilation time.
*/
#if !defined(VALGRIND)
+71 -71
View File
@@ -1,8 +1,9 @@
# tclTomMath.decls --
#
# This file contains the declarations for the functions in 'libtommath'
# that are contained within the Tcl library. This file is used to
# generate the 'tclTomMathDecls.h' and 'tclStubInit.c' files.
# This file contains the declarations for the functions in
# 'libtommath' that are contained within the Tcl library.
# This file is used to generate the 'tclTomMathDecls.h' and
# 'tclTomMathStub.c' files.
#
# If you edit this file, advance the revision number (and the epoch
# if the new stubs are not backward compatible) in tclTomMathDecls.h
@@ -18,197 +19,196 @@ library tcl
interface tclTomMath
# hooks {tclTomMathInt}
scspec EXTERN
# Declare each of the functions in the Tcl tommath interface
declare 0 {
declare 0 generic {
int TclBN_epoch(void)
}
declare 1 {
declare 1 generic {
int TclBN_revision(void)
}
declare 2 {
declare 2 generic {
int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
}
declare 3 {
declare 3 generic {
int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
}
declare 4 {
int TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c)
declare 4 generic {
int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
}
declare 5 {
declare 5 generic {
void TclBN_mp_clamp(mp_int *a)
}
declare 6 {
declare 6 generic {
void TclBN_mp_clear(mp_int *a)
}
declare 7 {
declare 7 generic {
void TclBN_mp_clear_multi(mp_int *a, ...)
}
declare 8 {
int TclBN_mp_cmp(const mp_int *a, const mp_int *b)
declare 8 generic {
int TclBN_mp_cmp(mp_int *a, mp_int *b)
}
declare 9 {
int TclBN_mp_cmp_d(const mp_int *a, mp_digit b)
declare 9 generic {
int TclBN_mp_cmp_d(mp_int *a, mp_digit b)
}
declare 10 {
int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b)
declare 10 generic {
int TclBN_mp_cmp_mag(mp_int *a, mp_int *b)
}
declare 11 {
declare 11 generic {
int TclBN_mp_copy(mp_int *a, mp_int *b)
}
declare 12 {
declare 12 generic {
int TclBN_mp_count_bits(mp_int *a)
}
declare 13 {
declare 13 generic {
int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
}
declare 14 {
declare 14 generic {
int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
}
declare 15 {
declare 15 generic {
int TclBN_mp_div_2(mp_int *a, mp_int *q)
}
declare 16 {
declare 16 generic {
int TclBN_mp_div_2d(mp_int *a, int b, mp_int *q, mp_int *r)
}
declare 17 {
declare 17 generic {
int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
}
declare 18 {
declare 18 generic {
void TclBN_mp_exch(mp_int *a, mp_int *b)
}
declare 19 {
declare 19 generic {
int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
}
declare 20 {
declare 20 generic {
int TclBN_mp_grow(mp_int *a, int size)
}
declare 21 {
declare 21 generic {
int TclBN_mp_init(mp_int *a)
}
declare 22 {
declare 22 generic {
int TclBN_mp_init_copy(mp_int *a, mp_int *b)
}
declare 23 {
declare 23 generic {
int TclBN_mp_init_multi(mp_int *a, ...)
}
declare 24 {
declare 24 generic {
int TclBN_mp_init_set(mp_int *a, mp_digit b)
}
declare 25 {
declare 25 generic {
int TclBN_mp_init_size(mp_int *a, int size)
}
declare 26 {
declare 26 generic {
int TclBN_mp_lshd(mp_int *a, int shift)
}
declare 27 {
declare 27 generic {
int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
}
declare 28 {
declare 28 generic {
int TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r)
}
declare 29 {
declare 29 generic {
int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
}
declare 30 {
declare 30 generic {
int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
}
declare 31 {
declare 31 generic {
int TclBN_mp_mul_2(mp_int *a, mp_int *p)
}
declare 32 {
declare 32 generic {
int TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p)
}
declare 33 {
declare 33 generic {
int TclBN_mp_neg(mp_int *a, mp_int *b)
}
declare 34 {
int TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c)
declare 34 generic {
int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
}
declare 35 {
declare 35 generic {
int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
}
declare 36 {
declare 36 generic {
int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
}
declare 37 {
declare 37 generic {
void TclBN_mp_rshd(mp_int *a, int shift)
}
declare 38 {
declare 38 generic {
int TclBN_mp_shrink(mp_int *a)
}
declare 39 {
declare 39 generic {
void TclBN_mp_set(mp_int *a, mp_digit b)
}
declare 40 {
declare 40 generic {
int TclBN_mp_sqr(mp_int *a, mp_int *b)
}
declare 41 {
declare 41 generic {
int TclBN_mp_sqrt(mp_int *a, mp_int *b)
}
declare 42 {
declare 42 generic {
int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
}
declare 43 {
declare 43 generic {
int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
}
declare 44 {
declare 44 generic {
int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
}
declare 45 {
declare 45 generic {
int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
unsigned long *outlen)
}
declare 46 {
declare 46 generic {
int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
}
declare 47 {
declare 47 generic {
int TclBN_mp_unsigned_bin_size(mp_int *a)
}
declare 48 {
int TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
declare 48 generic {
int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
}
declare 49 {
declare 49 generic {
void TclBN_mp_zero(mp_int *a)
}
# internal routines to libtommath - should not be called but must be
# exported to accommodate the "tommath" extension
declare 50 {
declare 50 generic {
void TclBN_reverse(unsigned char *s, int len)
}
declare 51 {
declare 51 generic {
int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
}
declare 52 {
declare 52 generic {
int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
}
declare 53 {
declare 53 generic {
int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
}
declare 54 {
declare 54 generic {
int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
}
declare 55 {
declare 55 generic {
int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
}
declare 56 {
declare 56 generic {
int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
}
declare 57 {
declare 57 generic {
int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
}
declare 58 {
declare 58 generic {
int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
}
declare 59 {
declare 59 generic {
int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
}
declare 60 {
declare 60 generic {
int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
}
declare 61 {
+51 -88
View File
@@ -1,6 +1,17 @@
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
* LibTomMath is a library that provides multiple-precision
* integer arithmetic as well as number theoretic functionality.
*
* The library was designed directly after the MPI library by
* Michael Fromberger but has been written from scratch with
* additional optimizations in place.
*
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
*/
#ifndef BN_H_
#define BN_H_
@@ -137,31 +148,30 @@ extern "C" {
#define MP_MASK ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX MP_MASK
typedef int mp_sign;
#define MP_ZPOS 0 /* positive integer */
#define MP_NEG 1 /* negative */
typedef int mp_ord;
/* equalities */
#define MP_LT -1 /* less than */
#define MP_EQ 0 /* equal to */
#define MP_GT 1 /* greater than */
typedef int mp_bool;
#define MP_YES 1 /* yes response */
#define MP_NO 0 /* no response */
typedef int mp_err;
#define MP_ZPOS 0 /* positive integer */
#define MP_NEG 1 /* negative */
#define MP_OKAY 0 /* ok result */
#define MP_ERR -1 /* unknown error */
#define MP_MEM -2 /* out of mem */
#define MP_VAL -3 /* invalid input */
#define MP_RANGE MP_VAL
#define MP_ITER -4 /* Max. iterations reached */
#define MP_YES 1 /* yes response */
#define MP_NO 0 /* no response */
/* Primality generation flags */
#define LTM_PRIME_BBS 0x0001 /* BBS style prime */
#define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */
#define LTM_PRIME_2MSB_ON 0x0008 /* force 2nd MSB to 1 */
/* tunable cutoffs */
typedef int mp_err;
/* you'll have to tune these... */
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
KARATSUBA_SQR_CUTOFF,
@@ -174,57 +184,16 @@ MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
/* default precision */
#ifndef MP_PREC
# ifndef MP_LOW_MEM
# define MP_PREC 32 /* default digits of precision */
# elif defined(MP_8BIT)
# define MP_PREC 16 /* default digits of precision */
# else
# define MP_PREC 8 /* default digits of precision */
# endif
#ifndef MP_LOW_MEM
#define MP_PREC 32 /* default digits of precision */
#else
#define MP_PREC 8 /* default digits of precision */
#endif
#endif
/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
/*
* MP_WUR - warn unused result
* ---------------------------
*
* The result of functions annotated with MP_WUR must be
* checked and cannot be ignored.
*
* Most functions in libtommath return an error code.
* This error code must be checked in order to prevent crashes or invalid
* results.
*
* If you still want to avoid the error checks for quick and dirty programs
* without robustness guarantees, you can `#define MP_WUR` before including
* tommath.h, disabling the warnings.
*/
#ifndef MP_WUR
# if defined(__GNUC__) && __GNUC__ >= 4
# define MP_WUR __attribute__((warn_unused_result))
# else
# define MP_WUR
# endif
#endif
#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301)
# define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
# define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
# define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
#elif defined(_MSC_VER) && _MSC_VER >= 1500
# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
# define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
#else
# define MP_DEPRECATED
# define MP_DEPRECATED_PRAGMA(s)
#endif
#define USED(m) ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m) ((m)->sign)
/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
@@ -239,15 +208,19 @@ struct mp_int {
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
#define USED(m) ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m) ((m)->sign)
/* error code to char* string */
/*
const char *mp_error_to_string(mp_err code);
char *mp_error_to_string(int code);
*/
/* ---> init and deinit bignum functions <--- */
/* init a bignum */
/*
mp_err mp_init(mp_int *a);
int mp_init(mp_int *a);
*/
/* free a bignum */
@@ -257,7 +230,7 @@ void mp_clear(mp_int *a);
/* init a null terminated series of arguments */
/*
mp_err mp_init_multi(mp_int *mp, ...);
int mp_init_multi(mp_int *mp, ...);
*/
/* clear a null terminated series of arguments */
@@ -272,24 +245,23 @@ void mp_exch(mp_int *a, mp_int *b);
/* shrink ram required for a bignum */
/*
mp_err mp_shrink(mp_int *a);
int mp_shrink(mp_int *a);
*/
/* grow an int to a given size */
/*
mp_err mp_grow(mp_int *a, int size);
int mp_grow(mp_int *a, int size);
*/
/* init to a given number of digits */
/*
mp_err mp_init_size(mp_int *a, int size);
int mp_init_size(mp_int *a, int size);
*/
/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
#define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)
/* set to zero */
/*
@@ -306,16 +278,6 @@ void mp_set(mp_int *a, mp_digit b);
int mp_set_int(mp_int *a, unsigned long b);
*/
/* set a platform dependent unsigned long value */
/*
int mp_set_long(mp_int *a, unsigned long b);
*/
/* set a platform dependent unsigned long long value */
/*
int mp_set_long_long(mp_int *a, unsigned long long b);
*/
/* get a 32-bit value */
unsigned long mp_get_int(mp_int * a);
@@ -677,18 +639,18 @@ int mp_prime_is_divisible(mp_int *a, int *result);
* Sets result to 0 if composite or 1 if probable prime
*/
/*
mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result);
int mp_prime_fermat(mp_int *a, mp_int *b, int *result);
*/
/* performs one Miller-Rabin test of "a" using base "b".
* Sets result to 0 if composite or 1 if probable prime
*/
/*
mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result);
int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
*/
/* This gives [for a given bit size] the number of trials required
* such that Miller-Rabin gives a prob of failure lower than 2^-96
* such that Miller-Rabin gives a prob of failure lower than 2^-96
*/
/*
int mp_prime_rabin_miller_trials(int size);
@@ -702,7 +664,7 @@ int mp_prime_rabin_miller_trials(int size);
* Sets result to 1 if probably prime, 0 otherwise
*/
/*
mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result);
int mp_prime_is_prime(mp_int *a, int t, int *result);
*/
/* finds the next prime after the number "a" using "t" trials
@@ -711,11 +673,11 @@ mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result);
* bbs_style = 1 means the prime must be congruent to 3 mod 4
*/
/*
mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style);
int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
*/
/* makes a truly random prime of a given size (bytes),
* call with bbs = 1 if you want it to be congruent to 3 mod 4
* call with bbs = 1 if you want it to be congruent to 3 mod 4
*
* You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
* have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
@@ -728,10 +690,11 @@ mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style);
/* makes a truly random prime of a given size (bits),
*
* Flags are as follows:
*
* MP_PRIME_BBS - make prime congruent to 3 mod 4
* MP_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS)
* MP_PRIME_2MSB_ON - make the 2nd highest bit one
*
* LTM_PRIME_BBS - make prime congruent to 3 mod 4
* LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
* LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
* LTM_PRIME_2MSB_ON - make the 2nd highest bit one
*
* You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
* have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
@@ -867,7 +830,7 @@ MODULE_SCOPE const char *mp_s_rmap;
#endif
#ifdef __cplusplus
}
}
#endif
#endif
+19 -22
View File
@@ -44,12 +44,16 @@
#define XREALLOC(x,n) TclBNRealloc(x,n)
#define XCALLOC(n,x) TclBNCalloc(n,x)
/* Rename the global symbols in libtommath to avoid linkage conflicts */
#define KARATSUBA_MUL_CUTOFF TclBNKaratsubaMulCutoff
#define KARATSUBA_SQR_CUTOFF TclBNKaratsubaSqrCutoff
#define TOOM_MUL_CUTOFF TclBNToomMulCutoff
#define TOOM_SQR_CUTOFF TclBNToomSqrCutoff
#define bn_reverse TclBN_reverse
#define s_mp_reverse TclBN_reverse
#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
#define s_mp_mul_digs_fast TclBN_fast_s_mp_mul_digs
#define fast_s_mp_sqr TclBN_fast_s_mp_sqr
#define s_mp_sqr_fast TclBN_fast_s_mp_sqr
#define mp_add TclBN_mp_add
#define mp_add_d TclBN_mp_add_d
#define mp_and TclBN_mp_and
@@ -77,9 +81,7 @@
#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
#define mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
#define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
#define mp_lshd TclBN_mp_lshd
#define mp_mod TclBN_mp_mod
#define mp_mod_2d TclBN_mp_mod_2d
@@ -103,9 +105,7 @@
#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
#define mp_toom_mul TclBN_mp_toom_mul
#define s_mp_toom_mul TclBN_mp_toom_mul
#define mp_toom_sqr TclBN_mp_toom_sqr
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#define mp_toradix_n TclBN_mp_toradix_n
#define mp_unsigned_bin_size TclBN_mp_unsigned_bin_size
#define mp_xor TclBN_mp_xor
@@ -165,8 +165,7 @@ EXTERN int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
#ifndef TclBN_mp_and_TCL_DECLARED
#define TclBN_mp_and_TCL_DECLARED
/* 4 */
EXTERN int TclBN_mp_and(CONST mp_int *a, CONST mp_int *b,
mp_int *c);
EXTERN int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_clamp_TCL_DECLARED
#define TclBN_mp_clamp_TCL_DECLARED
@@ -186,17 +185,17 @@ EXTERN void TclBN_mp_clear_multi(mp_int *a, ...);
#ifndef TclBN_mp_cmp_TCL_DECLARED
#define TclBN_mp_cmp_TCL_DECLARED
/* 8 */
EXTERN int TclBN_mp_cmp(CONST mp_int *a, CONST mp_int *b);
EXTERN int TclBN_mp_cmp(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_cmp_d_TCL_DECLARED
#define TclBN_mp_cmp_d_TCL_DECLARED
/* 9 */
EXTERN int TclBN_mp_cmp_d(CONST mp_int *a, mp_digit b);
EXTERN int TclBN_mp_cmp_d(mp_int *a, mp_digit b);
#endif
#ifndef TclBN_mp_cmp_mag_TCL_DECLARED
#define TclBN_mp_cmp_mag_TCL_DECLARED
/* 10 */
EXTERN int TclBN_mp_cmp_mag(CONST mp_int *a, CONST mp_int *b);
EXTERN int TclBN_mp_cmp_mag(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_copy_TCL_DECLARED
#define TclBN_mp_copy_TCL_DECLARED
@@ -319,8 +318,7 @@ EXTERN int TclBN_mp_neg(mp_int *a, mp_int *b);
#ifndef TclBN_mp_or_TCL_DECLARED
#define TclBN_mp_or_TCL_DECLARED
/* 34 */
EXTERN int TclBN_mp_or(CONST mp_int *a, CONST mp_int *b,
mp_int *c);
EXTERN int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_radix_size_TCL_DECLARED
#define TclBN_mp_radix_size_TCL_DECLARED
@@ -393,8 +391,7 @@ EXTERN int TclBN_mp_unsigned_bin_size(mp_int *a);
#ifndef TclBN_mp_xor_TCL_DECLARED
#define TclBN_mp_xor_TCL_DECLARED
/* 48 */
EXTERN int TclBN_mp_xor(CONST mp_int *a, CONST mp_int *b,
mp_int *c);
EXTERN int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_zero_TCL_DECLARED
#define TclBN_mp_zero_TCL_DECLARED
@@ -483,13 +480,13 @@ typedef struct TclTomMathStubs {
int (*tclBN_revision) (void); /* 1 */
int (*tclBN_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 2 */
int (*tclBN_mp_add_d) (mp_int *a, mp_digit b, mp_int *c); /* 3 */
int (*tclBN_mp_and) (CONST mp_int *a, CONST mp_int *b, mp_int *c); /* 4 */
int (*tclBN_mp_and) (mp_int *a, mp_int *b, mp_int *c); /* 4 */
void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
void (*tclBN_mp_clear) (mp_int *a); /* 6 */
void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
int (*tclBN_mp_cmp) (CONST mp_int *a, CONST mp_int *b); /* 8 */
int (*tclBN_mp_cmp_d) (CONST mp_int *a, mp_digit b); /* 9 */
int (*tclBN_mp_cmp_mag) (CONST mp_int *a, CONST mp_int *b); /* 10 */
int (*tclBN_mp_cmp) (mp_int *a, mp_int *b); /* 8 */
int (*tclBN_mp_cmp_d) (mp_int *a, mp_digit b); /* 9 */
int (*tclBN_mp_cmp_mag) (mp_int *a, mp_int *b); /* 10 */
int (*tclBN_mp_copy) (mp_int *a, mp_int *b); /* 11 */
int (*tclBN_mp_count_bits) (mp_int *a); /* 12 */
int (*tclBN_mp_div) (mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 13 */
@@ -513,7 +510,7 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
int (*tclBN_mp_mul_2d) (mp_int *a, int d, mp_int *p); /* 32 */
int (*tclBN_mp_neg) (mp_int *a, mp_int *b); /* 33 */
int (*tclBN_mp_or) (CONST mp_int *a, CONST mp_int *b, mp_int *c); /* 34 */
int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
int (*tclBN_mp_read_radix) (mp_int *a, CONST char *str, int radix); /* 36 */
void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
@@ -527,7 +524,7 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_to_unsigned_bin_n) (mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
int (*tclBN_mp_toradix_n) (mp_int *a, char *str, int radix, int maxlen); /* 46 */
int (*tclBN_mp_unsigned_bin_size) (mp_int *a); /* 47 */
int (*tclBN_mp_xor) (CONST mp_int *a, CONST mp_int *b, mp_int *c); /* 48 */
int (*tclBN_mp_xor) (mp_int *a, mp_int *b, mp_int *c); /* 48 */
void (*tclBN_mp_zero) (mp_int *a); /* 49 */
void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
int (*tclBN_fast_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 51 */
+2 -2
View File
@@ -196,7 +196,7 @@ TclBNInitBignumFromLong(
*/
status = mp_init_size(a,
(CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT);
(CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT);
if (status != MP_OKAY) {
Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
}
@@ -283,7 +283,7 @@ TclBNInitBignumFromWideUInt(
*/
status = mp_init_size(a,
(CHAR_BIT * sizeof(Tcl_WideUInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT);
(CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT);
if (status != MP_OKAY) {
Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
}
+1 -11
View File
@@ -176,9 +176,7 @@ Tcl_TraceObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int optionIndex;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
char *name, *flagOps, *p;
#endif
/* Main sub commands to 'trace' */
static const char *traceOptions[] = {
"add", "info", "remove",
@@ -354,12 +352,10 @@ Tcl_TraceObjCmd(
}
return TCL_OK;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
badVarOps:
Tcl_AppendResult(interp, "bad operations \"", flagOps,
"\": should be one or more of rwua", NULL);
return TCL_ERROR;
#endif
}
/*
@@ -906,11 +902,9 @@ TraceVariableObjCmd(
(sizeof(CombinedTraceVarInfo) + length + 1
- sizeof(ctvarPtr->traceCmdInfo.command)));
ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
if (objv[0] == NULL) {
ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
}
#endif
ctvarPtr->traceCmdInfo.length = length;
flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
@@ -937,11 +931,7 @@ TraceVariableObjCmd(
TraceVarProc, clientData)) != 0) {
tvarPtr = (TraceVarInfo *) clientData;
if ((tvarPtr->length == length)
&& ((tvarPtr->flags
#ifndef TCL_REMOVE_OBSOLETE_TRACES
& ~TCL_TRACE_OLD_STYLE
#endif
)==flags)
&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
&& (strncmp(command, tvarPtr->command,
(size_t) length) == 0)) {
Tcl_UntraceVar2(interp, name, NULL,
+1071 -1224
View File
File diff suppressed because it is too large Load Diff
+99 -155
View File
@@ -69,11 +69,20 @@ static CONST unsigned char totalBytes[256] = {
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
#if TCL_UTF_MAX > 3
4,4,4,4,4,
4,4,4,4,4,4,4,4,
#else
1,1,1,1,1,
1,1,1,1,1,1,1,1,
#endif
#if TCL_UTF_MAX > 4
5,5,5,5,
#else
1,1,1,1,
#endif
#if TCL_UTF_MAX > 5
6,6,6,6
#else
1,1,1,1
#endif
1,1,1,1,1,1,1,1,1,1,1
};
/*
@@ -102,16 +111,25 @@ INLINE static int
UtfCount(
int ch) /* The Tcl_UniChar whose size is returned. */
{
if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
if ((ch > 0) && (ch < UNICODE_SELF)) {
return 1;
}
if (ch <= 0x7FF) {
return 2;
}
if (ch <= 0xFFFF) {
return 3;
}
#if TCL_UTF_MAX > 3
if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) {
if (ch <= 0x1FFFFF) {
return 4;
}
if (ch <= 0x3FFFFFF) {
return 5;
}
if (ch <= 0x7FFFFFFF) {
return 6;
}
#endif
return 3;
}
@@ -143,7 +161,7 @@ Tcl_UniCharToUtf(
* large enough to hold the UTF-8 character
* (at most TCL_UTF_MAX bytes). */
{
if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
if ((ch > 0) && (ch < UNICODE_SELF)) {
buf[0] = (char) ch;
return 1;
}
@@ -154,50 +172,43 @@ Tcl_UniCharToUtf(
return 2;
}
if (ch <= 0xFFFF) {
#if TCL_UTF_MAX == 4
if ((ch & 0xF800) == 0xD800) {
if (ch & 0x0400) {
/* Low surrogate */
if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
&& ((buf[2] & 0xCF) == 0)) {
/* Previous Tcl_UniChar was a High surrogate, so combine */
buf[3] = (char) ((ch & 0x3F) | 0x80);
buf[2] |= (char) (((ch >> 6) & 0x0F) | 0x80);
return 4;
}
/* Previous Tcl_UniChar was not a High surrogate, so just output */
} else {
/* High surrogate */
ch += 0x40;
/* Fill buffer with specific 3-byte (invalid) byte combination,
so following Low surrogate can recognize it and combine */
buf[2] = (char) ((ch << 4) & 0x30);
buf[1] = (char) (((ch >> 2) & 0x3F) | 0x80);
buf[0] = (char) (((ch >> 8) & 0x07) | 0xF0);
return 0;
}
}
#endif
goto three;
three:
buf[2] = (char) ((ch | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 12) | 0xE0);
return 3;
}
#if TCL_UTF_MAX > 3
if (ch <= 0x10FFFF) {
if (ch <= 0x1FFFFF) {
buf[3] = (char) ((ch | 0x80) & 0xBF);
buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 18) | 0xF0);
return 4;
}
if (ch <= 0x3FFFFFF) {
buf[4] = (char) ((ch | 0x80) & 0xBF);
buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 24) | 0xF8);
return 5;
}
if (ch <= 0x7FFFFFFF) {
buf[5] = (char) ((ch | 0x80) & 0xBF);
buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 30) | 0xFC);
return 6;
}
#endif
}
ch = 0xFFFD;
three:
buf[2] = (char) ((ch | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 12) | 0xE0);
return 3;
goto three;
}
/*
@@ -266,15 +277,6 @@ Tcl_UniCharToUtfDString(
* Tcl_UtfCharComplete() before calling this routine to ensure that
* enough bytes remain in the string.
*
* If TCL_UTF_MAX == 4, special handling of Surrogate pairs is done:
* For any UTF-8 string containing a character outside of the BMP, the
* first call to this function will fill *chPtr with the high surrogate
* and generate a return value of 0. Calling Tcl_UtfToUniChar again
* will produce the low surrogate and a return value of 4. Because *chPtr
* is used to remember whether the high surrogate is already produced, it
* is recommended to initialize the variable it points to as 0 before
* the first call to Tcl_UtfToUniChar is done.
*
* Results:
* *chPtr is filled with the Tcl_UniChar, and the return value is the
* number of bytes from the UTF-8 string that were consumed.
@@ -314,15 +316,16 @@ Tcl_UtfToUniChar(
*/
*chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F));
if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
return 2;
}
return 2;
}
/*
* A two-byte-character lead-byte not followed by trail-byte
* represents itself.
*/
*chPtr = (Tcl_UniChar) byte;
return 1;
} else if (byte < 0xF0) {
if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
/*
@@ -331,52 +334,38 @@ Tcl_UtfToUniChar(
*chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
| ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
if (*chPtr > 0x7FF) {
return 3;
}
return 3;
}
/*
* A three-byte-character lead-byte not followed by two trail-bytes
* represents itself.
*/
*chPtr = (Tcl_UniChar) byte;
return 1;
}
#if TCL_UTF_MAX > 3
else if (byte < 0xF8) {
if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
/*
* Four-byte-character lead byte followed by three trail bytes.
*/
#if TCL_UTF_MAX == 4
Tcl_UniChar surrogate;
{
int ch, total, trail;
byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000;
surrogate = (Tcl_UniChar) (0xD800 + (byte >> 10));
if (byte & 0x100000) {
/* out of range, < 0x10000 or > 0x10ffff */
} else if (*chPtr != surrogate) {
/* produce high surrogate, but don't advance source pointer */
*chPtr = surrogate;
return 0;
} else {
/* produce low surrogate, and advance source pointer */
*chPtr = (Tcl_UniChar) (0xDC00 | (byte & 0x3FF));
return 4;
}
#else
*chPtr = (Tcl_UniChar) (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) {
return 4;
}
#endif
total = totalBytes[byte];
trail = total - 1;
if (trail > 0) {
ch = byte & (0x3F >> trail);
do {
src++;
if ((*src & 0xC0) != 0x80) {
*chPtr = byte;
return 1;
}
ch <<= 6;
ch |= (*src & 0x3F);
trail--;
} while (trail > 0);
*chPtr = ch;
return total;
}
/*
* A four-byte-character lead-byte not followed by two trail-bytes
* represents itself.
*/
}
#endif
@@ -426,28 +415,18 @@ Tcl_UtfToUniCharDString(
oldLength = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr,
oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar)));
(int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
w = wString;
p = src;
end = src + length - TCL_UTF_MAX;
while (p < end) {
end = src + length;
for (p = src; p < end; ) {
p += TclUtfToUniChar(p, w);
w++;
}
end += TCL_UTF_MAX;
while (p < end) {
if (Tcl_UtfCharComplete(p, end-p)) {
p += TclUtfToUniChar(p, w);
} else {
*w = UCHAR(*p++);
}
w++;
}
*w = '\0';
Tcl_DStringSetLength(dsPtr,
oldLength + ((char *) w - (char *) wString));
(oldLength + ((char *) w - (char *) wString)));
return wString;
}
@@ -477,7 +456,10 @@ Tcl_UtfCharComplete(
* a complete UTF-8 character. */
int length) /* Length of above string in bytes. */
{
return length >= totalBytes[(unsigned char)*src];
int ch;
ch = *((unsigned char *) src);
return length >= totalBytes[ch];
}
/*
@@ -505,6 +487,7 @@ Tcl_NumUtfChars(
* for strlen(string). */
{
Tcl_UniChar ch;
register Tcl_UniChar *chPtr = &ch;
register int i;
/*
@@ -517,25 +500,23 @@ Tcl_NumUtfChars(
i = 0;
if (length < 0) {
while (*src != '\0') {
src += TclUtfToUniChar(src, &ch);
src += TclUtfToUniChar(src, chPtr);
i++;
}
if (i < 0) i = INT_MAX; /* Bug [2738427] */
} else {
register const char *endPtr = src + length - TCL_UTF_MAX;
register int n;
while (src < endPtr) {
src += TclUtfToUniChar(src, &ch);
while (length > 0) {
if (UCHAR(*src) < 0xC0) {
length--;
src++;
} else {
n = Tcl_UtfToUniChar(src, chPtr);
length -= n;
src += n;
}
i++;
}
endPtr += TCL_UTF_MAX;
while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
src += TclUtfToUniChar(src, &ch);
i++;
}
if (src < endPtr) {
i += endPtr - src;
}
}
return i;
}
@@ -969,11 +950,7 @@ Tcl_UtfToTitle(
}
while (*src) {
bytes = TclUtfToUniChar(src, &ch);
lowChar = ch;
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
lowChar = Tcl_UniCharToLower(lowChar);
}
lowChar = Tcl_UniCharToLower(ch);
if (bytes < UtfCount(lowChar)) {
memcpy(dst, src, (size_t) bytes);
@@ -1061,7 +1038,7 @@ Tcl_UtfNcmp(
/*
* Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
* pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
* pair of bytes 0xc0,0x80) is larger than byte representation of \u0001
* (the byte 0x01.)
*/
@@ -1075,16 +1052,6 @@ Tcl_UtfNcmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return (ch1 - ch2);
}
}
@@ -1125,16 +1092,6 @@ Tcl_UtfNcasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1174,16 +1131,6 @@ TclUtfCasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1244,9 +1191,8 @@ Tcl_UniCharToLower(
int ch) /* Unicode character to convert. */
{
int info = GetUniCharInfo(ch);
int mode = GetCaseType(info);
if ((mode & 0x02) && (mode != 0x7)) {
if (GetCaseType(info) & 0x02) {
ch += GetDelta(info);
}
return (Tcl_UniChar) ch;
@@ -1280,9 +1226,7 @@ Tcl_UniCharToTitle(
* Subtract or add one depending on the original case.
*/
if (mode != 0x7) {
ch += ((mode & 0x4) ? -1 : 1);
}
ch += ((mode & 0x4) ? -1 : 1);
} else if (mode == 0x4) {
ch -= GetDelta(info);
}
@@ -1611,7 +1555,7 @@ Tcl_UniCharIsSpace(
if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
return TclIsSpaceProc((char) ch);
} else if ((Tcl_UniChar) ch == 0x180E || (Tcl_UniChar) ch == 0x202F) {
} else if ((Tcl_UniChar) ch == 0x180e || (Tcl_UniChar) ch == 0x202f) {
return 1;
} else {
return ((SPACE_BITS >> GetCategory(ch)) & 1);
+82 -254
View File
@@ -63,7 +63,7 @@ static ProcessGlobalValue executableName = {
* CONVERT_MASK A mask value used to extract the conversion mode from
* the flags argument.
* Also indicates a strange conversion mode where all
* special characters are escaped with backslashes
* special characters are escaped with backslashes
* *except for braces*. This is a strange and unnecessary
* case, but it's part of the historical way in which
* lists have been formatted in Tcl. To experiment with
@@ -81,7 +81,7 @@ static ProcessGlobalValue executableName = {
* in other cases this means an overestimate of the
* required size.
*
* For more details, see the comments on the Tcl*Scan*Element and
* For more details, see the comments on the Tcl*Scan*Element and
* Tcl*Convert*Element routines.
*/
@@ -171,12 +171,12 @@ Tcl_ObjType tclEndOffsetType = {
* rules similar to the parsing of the words of a command in a Tcl script.
* Backslash substitution plays a key role, and is defined exactly as it is
* in command parsing. The same routine, TclParseBackslash() is used in both
* command parsing and list parsing.
* command parsing and list parsing.
*
* NOTE: This means that if and when backslash substitution rules ever
* change for command parsing, the interpretation of strings as lists also
* changes.
*
*
* Backslash substitution replaces an "escape sequence" of one or more
* characters starting with
* \u005c \ BACKSLASH
@@ -189,7 +189,7 @@ Tcl_ObjType tclEndOffsetType = {
*
* * If the first character of a formatted substring is
* \u007b { OPEN BRACE
* then the end of the substring is the matching
* then the end of the substring is the matching
* \u007d } CLOSE BRACE
* character, where matching is determined by counting nesting levels,
* and not including any brace characters that are contained within a
@@ -211,7 +211,7 @@ Tcl_ObjType tclEndOffsetType = {
* that includes an unbalanced brace not in a backslash escape sequence,
* and any value that ends with a backslash not itself in a backslash
* escape sequence.
*
*
* * If the first character of a formatted substring is
* \u0022 " QUOTE
* then the end of the substring is the next QUOTE character, not counting
@@ -246,7 +246,7 @@ Tcl_ObjType tclEndOffsetType = {
* minimum be able to produce escape sequences for the 10 characters
* identified above that have significance to a list parser.
*
* * * CANONICAL LISTS * * * * *
* * * CANONICAL LISTS * * * * *
*
* In addition to the basic rules for parsing strings into Tcl lists, there
* are additional properties to be met by the set of list values that are
@@ -297,7 +297,7 @@ Tcl_ObjType tclEndOffsetType = {
* This sort of coding was once fairly common, though it's become more
* idiomatic to see the following instead:
* set script [list puts [list $one $two $three]]; eval $script
* In order to support this guarantee, every canonical list must have
* In order to support this guarantee, every canonical list must have
* balance when counting those braces that are not in escape sequences.
*
* Within these constraints, the canonical list generation routines
@@ -339,7 +339,7 @@ Tcl_ObjType tclEndOffsetType = {
* #if COMPAT directives. This makes it easy to experiment with eliminating
* this formatting mode simply with "#define COMPAT 0" above. I believe
* this is worth considering.
*
*
* Another consideration is the treatment of QUOTE characters in list elements.
* TclConvertElement() must have the ability to produce the escape sequence
* \" so that when a list element begins with a QUOTE we do not confuse
@@ -396,7 +396,7 @@ TclMaxListLength(
}
/* No list element before leading white space */
count += 1 - TclIsSpaceProc(*bytes);
count += 1 - TclIsSpaceProc(*bytes);
/* Count white space runs as potential element separators */
while (numBytes) {
@@ -420,7 +420,7 @@ TclMaxListLength(
}
/* No list element following trailing white space */
count -= TclIsSpaceProc(bytes[-1]);
count -= TclIsSpaceProc(bytes[-1]);
done:
if (endPtr) {
@@ -488,7 +488,7 @@ TclFindElement(
* indicate that the substring of *sizePtr
* bytes starting at **elementPtr is/is not
* the literal list element and therefore
* does not/does require a call to
* does not/does require a call to
* TclCopyAndCollapse() by the caller. */
{
CONST char *p = list;
@@ -945,30 +945,13 @@ TclScanElement(
int preferBrace = 0; /* CONVERT_MASK mode. */
int braceCount = 0; /* Count of all braces '{' '}' seen. */
#endif
if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
/* Empty string element must be brace quoted. */
*flagPtr = CONVERT_BRACE;
return 2;
}
#if COMPAT
/*
* We have an established history in TclConvertElement() when quoting
* because of a leading hash character to force what would be the
* CONVERT_MASK mode into the CONVERT_BRACE mode. That is, we format
* the element #{a"b} like this:
* {#{a"b}}
* and not like this:
* \#{a\"b}
* This is inconsistent with [list x{a"b}], but we will not change that now.
* Set that preference here so that we compute a tight size requirement.
*/
if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
preferBrace = 1;
}
#endif
if ((*p == '{') || (*p == '"')) {
/*
* Must escape or protect so leading character of value is not
@@ -1029,7 +1012,7 @@ TclScanElement(
extra++; /* Escape '\' => '\\' */
if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
/* Final backslash. Cannot format with brace quoting. */
requireEscape = 1;
requireEscape = 1;
break;
}
if (p[1] == '\n') {
@@ -1104,7 +1087,7 @@ TclScanElement(
if (preferEscape && !preferBrace) {
/*
* If we are quoting solely due to ] or internal " characters
* use the CONVERT_MASK mode where we escape all special
* use the CONVERT_MASK mode where we escape all special
* characters except for braces. "extra" counted space needed
* to escape braces too, so substract "braceCount" to get our
* actual needs.
@@ -1368,7 +1351,7 @@ int TclConvertElement(
if (length == -1) {
return p - dst;
}
/*
/*
* If we reach this point, there's an embedded NULL in the
* string range being processed, which should not happen when
* the encoding rules for Tcl strings are properly followed.
@@ -1434,7 +1417,7 @@ Tcl_Merge(
/*
* We cannot allocate a large enough flag array to format this
* list in one pass. We could imagine converting this routine
* to a multi-pass implementation, but for sizeof(int) == 4,
* to a multi-pass implementation, but for sizeof(int) == 4,
* the limit is a max of 2^30 list elements and since each element
* is at least one byte formatted, and requires one byte space
* between it and the next one, that a minimum space requirement
@@ -1513,48 +1496,12 @@ Tcl_Backslash(
return (char) ch;
}
/*
*----------------------------------------------------------------------
*
* UtfWellFormedEnd --
* Checks the end of utf string is malformed, if yes - wraps bytes
* to the given buffer (as well-formed NTS string). The buffer
* argument should be initialized by the caller and ready to use.
*
* Results:
* The bytes with well-formed end of the string.
*
* Side effects:
* Buffer (DString) may be allocated, so must be released.
*
*----------------------------------------------------------------------
*/
static inline const char*
UtfWellFormedEnd(
Tcl_DString *buffer, /* Buffer used to hold well-formed string. */
CONST char *bytes, /* Pointer to the beginning of the string. */
int length) /* Length of the string. */
{
CONST char *l = bytes + length;
CONST char *p = Tcl_UtfPrev(l, bytes);
if (Tcl_UtfCharComplete(p, l - p)) {
return bytes;
}
/*
* Malformed utf-8 end, be sure we've NTS to safe compare of end-character,
* avoid segfault by access violation out of range.
*/
Tcl_DStringAppend(buffer, bytes, length);
return Tcl_DStringValue(buffer);
}
/*
*----------------------------------------------------------------------
*
* TclTrimRight --
* Takes two counted strings in the Tcl encoding. Conceptually
* finds the sub string (offset) to trim from the right side of the
* Takes two counted strings in the Tcl encoding which must both be
* null terminated. Conceptually trims from the right side of the
* first string all characters found in the second string.
*
* Results:
@@ -1566,8 +1513,8 @@ UtfWellFormedEnd(
*----------------------------------------------------------------------
*/
static inline int
TrimRight(
int
TclTrimRight(
const char *bytes, /* String to be trimmed... */
int numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
@@ -1576,6 +1523,15 @@ TrimRight(
const char *p = bytes + numBytes;
int pInc;
if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
Tcl_Panic("TclTrimRight works only on null-terminated strings");
}
/* Empty strings -> nothing to do */
if ((numBytes == 0) || (numTrim == 0)) {
return 0;
}
/* Outer loop: iterate over string to be trimmed */
do {
Tcl_UniChar ch1;
@@ -1607,44 +1563,13 @@ TrimRight(
return numBytes - (p - bytes);
}
int
TclTrimRight(
const char *bytes, /* String to be trimmed... */
int numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
int numTrim) /* ...and its length in bytes */
{
int res;
Tcl_DString bytesBuf, trimBuf;
/* Empty strings -> nothing to do */
if ((numBytes == 0) || (numTrim == 0)) {
return 0;
}
Tcl_DStringInit(&bytesBuf);
Tcl_DStringInit(&trimBuf);
bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);
res = TrimRight(bytes, numBytes, trim, numTrim);
if (res > numBytes) {
res = numBytes;
}
Tcl_DStringFree(&bytesBuf);
Tcl_DStringFree(&trimBuf);
return res;
}
/*
*----------------------------------------------------------------------
*
* TclTrimLeft --
* Takes two counted strings in the Tcl encoding. Conceptually
* finds the sub string (offset) to trim from the left side of the
* Takes two counted strings in the Tcl encoding which must both be
* null terminated. Conceptually trims from the left side of the
* first string all characters found in the second string.
*
* Results:
@@ -1656,8 +1581,8 @@ TclTrimRight(
*----------------------------------------------------------------------
*/
static inline int
TrimLeft(
int
TclTrimLeft(
const char *bytes, /* String to be trimmed... */
int numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
@@ -1665,6 +1590,15 @@ TrimLeft(
{
const char *p = bytes;
if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
Tcl_Panic("TclTrimLeft works only on null-terminated strings");
}
/* Empty strings -> nothing to do */
if ((numBytes == 0) || (numTrim == 0)) {
return 0;
}
/* Outer loop: iterate over string to be trimmed */
do {
Tcl_UniChar ch1;
@@ -1692,99 +1626,10 @@ TrimLeft(
p += pInc;
numBytes -= pInc;
} while (numBytes > 0);
} while (numBytes);
return p - bytes;
}
int
TclTrimLeft(
const char *bytes, /* String to be trimmed... */
int numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
int numTrim) /* ...and its length in bytes */
{
int res;
Tcl_DString bytesBuf, trimBuf;
/* Empty strings -> nothing to do */
if ((numBytes == 0) || (numTrim == 0)) {
return 0;
}
Tcl_DStringInit(&bytesBuf);
Tcl_DStringInit(&trimBuf);
bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);
res = TrimLeft(bytes, numBytes, trim, numTrim);
if (res > numBytes) {
res = numBytes;
}
Tcl_DStringFree(&bytesBuf);
Tcl_DStringFree(&trimBuf);
return res;
}
/*
*----------------------------------------------------------------------
*
* TclTrim --
* Finds the sub string (offset) to trim from both sides of the
* first string all characters found in the second string.
*
* Results:
* The number of bytes to be removed from the start of the string
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclTrim(
const char *bytes, /* String to be trimmed... */
int numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
int numTrim, /* ...and its length in bytes */
int *trimRight) /* Offset from the end of the string. */
{
int trimLeft;
Tcl_DString bytesBuf, trimBuf;
*trimRight = 0;
/* Empty strings -> nothing to do */
if ((numBytes == 0) || (numTrim == 0)) {
return 0;
}
Tcl_DStringInit(&bytesBuf);
Tcl_DStringInit(&trimBuf);
bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);
trimLeft = TrimLeft(bytes, numBytes, trim, numTrim);
if (trimLeft > numBytes) {
trimLeft = numBytes;
}
numBytes -= trimLeft;
/* have to trim yet (first char was already verified within TrimLeft) */
if (numBytes > 1) {
bytes += trimLeft;
*trimRight = TrimRight(bytes, numBytes, trim, numTrim);
if (*trimRight > numBytes) {
*trimRight = numBytes;
}
}
Tcl_DStringFree(&bytesBuf);
Tcl_DStringFree(&trimBuf);
return trimLeft;
}
/*
*----------------------------------------------------------------------
@@ -1833,7 +1678,7 @@ Tcl_Concat(
}
if (bytesNeeded + argc - 1 < 0) {
/*
* Panic test could be tighter, but not going to bother for
* Panic test could be tighter, but not going to bother for
* this legacy routine.
*/
Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
@@ -1842,18 +1687,25 @@ Tcl_Concat(
result = (char *) ckalloc((unsigned) (bytesNeeded + argc));
for (p = result, i = 0; i < argc; i++) {
int triml, trimr, elemLength;
int trim, elemLength;
const char *element;
element = argv[i];
elemLength = strlen(argv[i]);
/* Trim away the leading/trailing whitespace. */
triml = TclTrim(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE, &trimr);
element += triml;
elemLength -= triml + trimr;
/* Do not permit trimming to expose a final backslash character. */
elemLength += trimr && (element[elemLength - 1] == '\\');
/* Trim away the leading whitespace */
trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
/*
* Trim away the trailing whitespace. Do not permit trimming
* to expose a final backslash character.
*/
trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
/* If we're left with empty element after trimming, do nothing */
if (elemLength == 0) {
@@ -1939,12 +1791,7 @@ Tcl_ConcatObj(
TclListObjGetElements(NULL, objPtr, &listc, &listv);
if (listc) {
if (resPtr) {
if (TCL_OK != Tcl_ListObjReplace(NULL, resPtr,
INT_MAX, 0, listc, listv)) {
/* Abandon ship! */
Tcl_DecrRefCount(resPtr);
goto slow;
}
Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
} else {
resPtr = TclListObjCopy(NULL, objPtr);
}
@@ -1961,7 +1808,6 @@ Tcl_ConcatObj(
* the slow way, using the string representations.
*/
slow:
/* First try to pre-allocate the size required */
for (i = 0; i < objc; i++) {
element = TclGetStringFromObj(objv[i], &elemLength);
@@ -1980,16 +1826,23 @@ Tcl_ConcatObj(
Tcl_SetObjLength(resPtr, 0);
for (i = 0; i < objc; i++) {
int triml, trimr;
int trim;
element = TclGetStringFromObj(objv[i], &elemLength);
/* Trim away the leading/trailing whitespace. */
triml = TclTrim(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE, &trimr);
element += triml;
elemLength -= triml + trimr;
/* Do not permit trimming to expose a final backslash character. */
elemLength += trimr && (element[elemLength - 1] == '\\');
/* Trim away the leading whitespace */
trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
/*
* Trim away the trailing whitespace. Do not permit trimming
* to expose a final backslash character.
*/
trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
/* If we're left with empty element after trimming, do nothing */
if (elemLength == 0) {
@@ -2481,8 +2334,7 @@ TclStringMatchObj(
udata = Tcl_GetUnicodeFromObj(strObj, &length);
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
} else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
&& !flags) {
} else if (TclIsPureByteArray(strObj) && !flags) {
unsigned char *data, *ptn;
data = Tcl_GetByteArrayFromObj(strObj, &length);
@@ -2573,20 +2425,8 @@ Tcl_DStringAppend(
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
int offset = -1;
/* See [16896d49fd] */
if (bytes >= dsPtr->string
&& bytes <= dsPtr->string + dsPtr->length) {
offset = bytes - dsPtr->string;
}
dsPtr->string = ckrealloc((void *) dsPtr->string,
(size_t) dsPtr->spaceAvl);
if (offset >= 0) {
bytes = dsPtr->string + offset;
}
}
}
@@ -2649,20 +2489,8 @@ Tcl_DStringAppendElement(
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
int offset = -1;
/* See [16896d49fd] */
if (element >= dsPtr->string
&& element <= dsPtr->string + dsPtr->length) {
offset = element - dsPtr->string;
}
dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
(size_t) dsPtr->spaceAvl);
if (offset >= 0) {
element = dsPtr->string + offset;
}
}
dst = dsPtr->string + dsPtr->length;
}
@@ -3000,7 +2828,7 @@ Tcl_PrintDouble(
/*
* Remember to copy the terminating NUL too.
*/
if (value < 0) {
memcpy(dst, "-Inf", 5);
} else {
@@ -3057,7 +2885,7 @@ Tcl_PrintDouble(
*/
digits = TclDoubleDigits(value, *precisionPtr,
TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
&exponent, &signum, &end);
}
if (signum) {
@@ -3068,7 +2896,7 @@ Tcl_PrintDouble(
/*
* E format for numbers < 1e-3 or >= 1e17.
*/
*dst++ = *p++;
c = *p;
if (c != '\0') {
@@ -3078,7 +2906,7 @@ Tcl_PrintDouble(
c = *++p;
}
}
/*
/*
* Tcl 8.4 appears to format with at least a two-digit exponent; \
* preserve that behaviour when tcl_precision != 0
*/
@@ -3091,7 +2919,7 @@ Tcl_PrintDouble(
/*
* F format for others.
*/
if (exponent < 0) {
*dst++ = '0';
}
+43 -77
View File
@@ -672,7 +672,7 @@ TclObjLookupVarEx(
}
part1 = TclGetStringFromObj(part1Ptr, &len1);
if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) {
if (!parsed && (*(part1 + len1 - 1) == ')')) {
/*
* part1Ptr is possibly an unparsed array element.
*/
@@ -916,7 +916,7 @@ TclLookupSimpleVar(
* the variable. */
Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
ResolverScheme *resPtr;
int isNew;
int isNew, i, result;
const char *varName = TclGetString(varNamePtr);
varPtr = NULL;
@@ -937,8 +937,6 @@ TclLookupSimpleVar(
if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
&& !(flags & AVOID_RESOLVERS)) {
int result;
resPtr = iPtr->resolverPtr;
if (cxtNsPtr->varResProc) {
result = (*cxtNsPtr->varResProc)(interp, varName,
@@ -1008,10 +1006,9 @@ TclLookupSimpleVar(
(Tcl_Namespace *) cxtNsPtr,
(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
if (varPtr == NULL) {
Tcl_Obj *tailPtr;
if (create) { /* Var wasn't found so create it. */
Tcl_Obj *tailPtr;
TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
if (varNsPtr == NULL) {
@@ -1047,7 +1044,6 @@ TclLookupSimpleVar(
} else { /* Local var: look in frame varFramePtr. */
int localCt = varFramePtr->numCompiledLocals;
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
int i;
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
register Tcl_Obj *objPtr = *objPtrPtr;
@@ -1146,6 +1142,7 @@ TclLookupArrayElement(
int isNew;
Var *varPtr;
TclVarHashTable *tablePtr;
Namespace *nsPtr;
/*
* We're dealing with an array element. Make sure the variable is an array
@@ -1153,8 +1150,6 @@ TclLookupArrayElement(
*/
if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
Namespace *nsPtr;
if (!createArray) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
@@ -2109,7 +2104,7 @@ TclPtrIncrObjVar(
if (Tcl_IsShared(varValuePtr)) {
/* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
varValuePtr, flags, index);
@@ -2383,6 +2378,7 @@ UnsetVarStruct(
if (traced) {
VarTrace *tracePtr = NULL;
Tcl_HashEntry *tPtr = NULL;
if (TclIsVarTraced(&dummyVar)) {
/*
@@ -2408,8 +2404,6 @@ UnsetVarStruct(
if ((dummyVar.flags & VAR_TRACED_UNSET)
|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
Tcl_HashEntry *tPtr = NULL;
dummyVar.flags &= ~VAR_TRACE_ACTIVE;
TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
@@ -2587,8 +2581,10 @@ Tcl_AppendObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Var *varPtr, *arrayPtr;
register Tcl_Obj *varValuePtr = NULL;
/* Initialized to avoid compiler warning. */
int i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
@@ -2601,9 +2597,6 @@ Tcl_AppendObjCmd(
return TCL_ERROR;
}
} else {
Var *arrayPtr, *varPtr;
int i;
varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
@@ -2655,7 +2648,8 @@ Tcl_LappendObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varValuePtr, *newValuePtr;
int numElems;
int numElems, createdNewObj;
Var *varPtr, *arrayPtr;
int result;
if (objc < 2) {
@@ -2683,9 +2677,6 @@ Tcl_LappendObjCmd(
}
}
} else {
Var *varPtr, *arrayPtr;
int createdNewObj = 0;
/*
* We have arguments to append. We used to call Tcl_SetVar2 to append
* each argument one at a time to ensure that traces were run for each
@@ -2696,6 +2687,8 @@ Tcl_LappendObjCmd(
* copy to modify: this is "copy on write".
*/
createdNewObj = 0;
/*
* Protect the variable pointers around the TclPtrGetVar call
* to insure that they remain valid even if the variable was undefined
@@ -2877,8 +2870,10 @@ Tcl_ArrayObjCmd(
return TCL_ERROR;
}
while (1) {
Var *varPtr2;
if (searchPtr->nextEntry != NULL) {
Var *varPtr2 = VarHashGetValue(searchPtr->nextEntry);
varPtr2 = VarHashGetValue(searchPtr->nextEntry);
if (!TclIsVarUndefined(varPtr2)) {
break;
}
@@ -3308,6 +3303,7 @@ Tcl_ArrayObjCmd(
case ARRAY_SIZE: {
Tcl_HashSearch search;
Var *varPtr2;
int size;
if (objc != 3) {
@@ -3322,8 +3318,6 @@ Tcl_ArrayObjCmd(
*/
if (!notArray) {
Var *varPtr2;
for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
if (TclIsVarUndefined(varPtr2)) {
@@ -3411,7 +3405,7 @@ TclArraySet(
* Install the contents of the dictionary or list into the array.
*/
if (arrayElemObj->typePtr == &tclDictType && arrayElemObj->bytes == NULL) {
if (arrayElemObj->typePtr == &tclDictType) {
Tcl_Obj *keyPtr, *valuePtr;
Tcl_DictSearch search;
int done;
@@ -3455,7 +3449,7 @@ TclArraySet(
} else {
/*
* Not a dictionary, so assume (and convert to, for backward-
* -compatibility reasons) a list.
* -compatability reasons) a list.
*/
int elemLen;
@@ -3611,8 +3605,9 @@ ObjMakeUpvar(
|| !HasLocalVars(varFramePtr)
|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
TclGetString(myNamePtr), "\": can't create namespace "
"variable that refers to procedure variable", NULL);
TclGetString(myNamePtr), "\": upvar won't create "
"namespace variable that refers to procedure variable",
NULL);
return TCL_ERROR;
}
}
@@ -3667,7 +3662,7 @@ TclPtrMakeUpvar(
}
/* Callers must Incr myNamePtr if they plan to Decr it. */
int
TclPtrObjMakeUpvar(
Tcl_Interp *interp, /* Interpreter containing variables. Used for
@@ -3682,7 +3677,7 @@ TclPtrObjMakeUpvar(
{
Interp *iPtr = (Interp *) interp;
CallFrame *varFramePtr = iPtr->varFramePtr;
const char *errMsg, *myName;
const char *errMsg, *p, *myName;
Var *varPtr;
if (index >= 0) {
@@ -3693,7 +3688,6 @@ TclPtrObjMakeUpvar(
myNamePtr = localName(iPtr->varFramePtr, index);
myName = myNamePtr? TclGetString(myNamePtr) : NULL;
} else {
const char *p;
/*
* Do not permit the new variable to look like an array reference, as
* it will not be reachable in that case [Bug 600812, TIP 184]. The
@@ -3711,8 +3705,8 @@ TclPtrObjMakeUpvar(
*/
Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
myName, "\": can't create a scalar variable that "
"looks like an array element", NULL);
myName, "\": upvar won't create a scalar variable "
"that looks like an array element", NULL);
return TCL_ERROR;
}
}
@@ -3896,6 +3890,8 @@ Tcl_GetVariableFullName(
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr = (Var *) variable;
Tcl_Obj *namePtr;
Namespace *nsPtr;
/*
* Add the full name of the containing namespace (if any), followed by the
@@ -3904,9 +3900,6 @@ Tcl_GetVariableFullName(
if (varPtr) {
if (!TclIsVarArrayElement(varPtr)) {
Tcl_Obj *namePtr;
Namespace *nsPtr;
nsPtr = TclGetVarNsPtr(varPtr);
if (nsPtr) {
Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
@@ -3922,8 +3915,7 @@ Tcl_GetVariableFullName(
} else if (iPtr->varFramePtr->procPtr) {
int index = varPtr - iPtr->varFramePtr->compiledLocals;
if (index >= 0
&& index < iPtr->varFramePtr->numCompiledLocals) {
if (index < iPtr->varFramePtr->numCompiledLocals) {
namePtr = localName(iPtr->varFramePtr, index);
Tcl_AppendObjToObj(objPtr, namePtr);
}
@@ -3960,7 +3952,7 @@ Tcl_GlobalObjCmd(
register Tcl_Obj *objPtr, *tailPtr;
char *varName;
register char *tail;
int i;
int result, i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
@@ -3976,8 +3968,6 @@ Tcl_GlobalObjCmd(
}
for (i=1 ; i<objc ; i++) {
int result;
/*
* Make a local variable linked to its counterpart in the global ::
* namespace.
@@ -4069,6 +4059,7 @@ Tcl_VariableObjCmd(
{
Interp *iPtr = (Interp *) interp;
char *varName, *tail, *cp;
Var *varPtr, *arrayPtr;
Tcl_Obj *varValuePtr;
int i, result;
Tcl_Obj *varNamePtr, *tailPtr;
@@ -4079,8 +4070,6 @@ Tcl_VariableObjCmd(
}
for (i=1 ; i<objc ; i+=2) {
Var *varPtr, *arrayPtr;
/*
* Look up each variable in the current namespace context, creating it
* if necessary.
@@ -4435,10 +4424,10 @@ DeleteSearches(
register Var *arrayVarPtr) /* Variable whose searches are to be
* deleted. */
{
if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
ArraySearch *searchPtr, *nextPtr;
Tcl_HashEntry *sPtr;
ArraySearch *searchPtr, *nextPtr;
Tcl_HashEntry *sPtr;
if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
searchPtr != NULL; searchPtr = nextPtr) {
@@ -4498,14 +4487,11 @@ TclDeleteNamespaceVars(
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
NULL, flags);
Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
/*
* We just unset the variable. However, an unset trace might
* have re-set it, or might have re-established traces on it.
* This namespace and its vartable are going away unconditionally,
* so we cannot let such things linger. That would be a leak.
*
* First we destroy all traces. ...
* Remove the variable from the table and force it undefined in case
* an unset trace brought it back from the dead.
*/
if (TclIsVarTraced(varPtr)) {
@@ -4530,17 +4516,6 @@ TclDeleteNamespaceVars(
}
}
}
/*
* ...and then, if the variable still holds a value, we unset it
* again. This time with no traces left, we're sure it goes away.
*/
if (!TclIsVarUndefined(varPtr)) {
UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
NULL, flags);
}
Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
VarHashRefCount(varPtr)--;
VarHashDeleteEntry(varPtr);
}
@@ -4944,10 +4919,9 @@ DupParsedVarName(
register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
char *elemCopy;
unsigned int elemLen;
if (arrayPtr != NULL) {
unsigned int elemLen;
Tcl_IncrRefCount(arrayPtr);
elemLen = strlen(elem);
elemCopy = ckalloc(elemLen+1);
@@ -5074,6 +5048,7 @@ ObjFindNamespaceVar(
const char *simpleName;
Var *varPtr;
register int search;
int result;
Tcl_Var var;
Tcl_Obj *simpleNamePtr;
char *name = TclGetString(namePtr);
@@ -5094,8 +5069,6 @@ ObjFindNamespaceVar(
if (!(flags & AVOID_RESOLVERS) &&
(cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
int result;
resPtr = iPtr->resolverPtr;
if (cxtNsPtr->varResProc) {
@@ -5188,13 +5161,14 @@ TclInfoVarsCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
char *pattern;
char *varName, *pattern;
const char *simplePattern;
Tcl_HashSearch search;
Var *varPtr;
Namespace *nsPtr;
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
Tcl_Obj *listPtr;
Tcl_Obj *listPtr, *elemObjPtr;
int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;
@@ -5250,9 +5224,6 @@ TclInfoVarsCmd(
if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
|| specificNsInPattern) {
Var *varPtr;
Tcl_Obj *elemObjPtr;
/*
* There is no frame pointer, the frame pointer was pushed only to
* activate a namespace, or we are in a procedure call frame but a
@@ -5293,11 +5264,9 @@ TclInfoVarsCmd(
/*
* Have to scan the tables of variables.
*/
char *varName;
varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
while (varPtr) {
if (!TclIsVarUndefined(varPtr)
|| TclIsVarNamespaceVar(varPtr)) {
varNamePtr = VarHashGetKey(varPtr);
@@ -5385,11 +5354,11 @@ TclInfoGlobalsCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
char *pattern;
char *varName, *pattern;
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
Tcl_HashSearch search;
Var *varPtr;
Tcl_Obj *listPtr, *patternPtr;
Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
if (objc == 1) {
pattern = NULL;
@@ -5436,9 +5405,6 @@ TclInfoGlobalsCmd(
for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
varPtr != NULL;
varPtr = VarHashNextVar(&search)) {
char *varName;
Tcl_Obj *varNamePtr;
if (TclIsVarUndefined(varPtr)) {
continue;
}
+9 -9
View File
@@ -16,7 +16,7 @@
# so that the information gets recomputed the next time it's needed.
# Also delete any commands that are listed in the auto-load index.
#
# Arguments:
# Arguments:
# None.
proc auto_reset {} {
@@ -172,7 +172,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# parse Tcl source files, writing out index entries as "proc"
# commands are encountered. This implementation won't work in a
# safe interpreter, since a safe interpreter can't create the
# special parser and mess with its commands.
# special parser and mess with its commands.
if {[interp issafe]} {
return ;# Stop sourcing the file here
@@ -184,7 +184,7 @@ if {[interp issafe]} {
# followed by any number of glob patterns to use in that directory to
# locate all of the relevant files.
#
# Arguments:
# Arguments:
# dir - Name of the directory in which to create an index.
# args - Any number of additional arguments giving the
# names of files within dir. If no additional
@@ -211,7 +211,7 @@ proc auto_mkindex {dir args} {
}
auto_mkindex_parser::init
foreach file [lsort [glob -- {*}$args]] {
foreach file [glob -- {*}$args] {
if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} {
append index $msg
} else {
@@ -244,7 +244,7 @@ proc auto_mkindex_old {dir args} {
if {[llength $args] == 0} {
set args *.tcl
}
foreach file [lsort [glob -- {*}$args]] {
foreach file [glob -- {*}$args] {
set f ""
set error [catch {
set f [open $file]
@@ -338,7 +338,7 @@ namespace eval auto_mkindex_parser {
# handles things like the "proc" command by adding an entry for the
# index file. Returns a string that represents the index file.
#
# Arguments:
# Arguments:
# file Name of Tcl source file to be indexed.
proc auto_mkindex_parser::mkindex {file} {
@@ -455,7 +455,7 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
if {[string match *::* $name]} {
set exportCmd [list _%@namespace export [namespace tail $name]]
$parser eval [list _%@namespace eval $ns $exportCmd]
# The following proc definition does not work if you
# want to tolerate space or something else diabolical
# in the procedure name, (i.e., space in $alias)
@@ -528,7 +528,7 @@ auto_mkindex_parser::command proc {name args} {
variable scriptFile
# Do some fancy reformatting on the "source" call to handle platform
# differences with respect to pathnames. Use format just so that the
# command is a little easier to read (otherwise it'd be full of
# command is a little easier to read (otherwise it'd be full of
# backslashed dollar signs, etc.
append index [list set auto_index([fullname $name])] \
[format { [list source [file join $dir %s]]} \
@@ -553,7 +553,7 @@ auto_mkindex_parser::hook {
# AUTO MKINDEX: tbcload::bcproc name arglist body
# Adds an entry to the auto index list for the given pre-compiled
# procedure name.
# procedure name.
auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
variable index
+84 -84
View File
@@ -43,7 +43,7 @@ namespace eval ::tcl::clock \
# The 'clock' command manipulates time. Refer to the user documentation
# for the available subcommands and what they do.
#
#----------------------------------------------------------------------
#----------------------------------------------------------------------
namespace eval ::tcl::clock {
@@ -189,7 +189,7 @@ proc ::tcl::clock::Initialize {} {
# Germany, Norway, Denmark (Catholic Germany changed earlier)
::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032
@@ -225,7 +225,7 @@ proc ::tcl::clock::Initialize {} {
# Greece
::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
#------------------------------------------------------------------
#
# CONSTANTS
@@ -378,7 +378,7 @@ proc ::tcl::clock::Initialize {} {
{46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
}]
# Groups of fields that specify the date, priorities, and
# Groups of fields that specify the date, priorities, and
# code bursts that determine Julian Day Number given those groups.
# The code in [clock scan] will choose the highest priority
# (lowest numbered) set of fields that determines the date.
@@ -670,7 +670,7 @@ proc ::tcl::clock::format { args } {
set clockval [lindex $args 0]
# Get the data for time changes in the given zone
if {$timezone eq ""} {
set timezone [GetSystemTimeZone]
}
@@ -680,11 +680,11 @@ proc ::tcl::clock::format { args } {
return -options $opts $retval
}
}
# Build a procedure to format the result. Cache the built procedure's
# name in the 'FormatProc' array to avoid losing its internal
# representation, which contains the name resolution.
set procName formatproc'$format'$locale
set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
if {[info exists FormatProc($procName)]} {
@@ -693,7 +693,7 @@ proc ::tcl::clock::format { args } {
set FormatProc($procName) \
[ParseClockFormatFormat $procName $format $locale]
}
return [$procName $clockval $timezone]
}
@@ -720,7 +720,7 @@ proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
}
# Map away the locale-dependent composite format groups
EnterLocale $locale oldLocale
# Change locale if a fresh locale has been given on the command line.
@@ -767,7 +767,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
set formatString {}
set substituents {}
set state {}
set format [LocalizeFormat $locale $format]
foreach char [split $format {}] {
@@ -794,7 +794,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
{ [lindex @DAYS_OF_WEEK_ABBREV@ \
[expr {[dict get $date dayOfWeek] \
% 7}]]}]
}
}
A { # Day of week, spelt out.
append formatString %s
append substituents \
@@ -895,7 +895,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
k { # Hour (0-23), no leading zero
append formatString %2d
append substituents \
{ [expr { [dict get $date localSeconds]
{ [expr { [dict get $date localSeconds]
/ 3600
% 24 }]}
}
@@ -916,7 +916,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
M { # Minute of the hour, leading zero
append formatString %02d
append substituents \
{ [expr { [dict get $date localSeconds]
{ [expr { [dict get $date localSeconds]
/ 60
% 60 }]}
}
@@ -957,7 +957,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
{ [expr {(([dict get $date localSeconds]
% 86400) < 43200) ?
$am : $pm}]}
}
Q { # Hi, Jeff!
append formatString %s
@@ -967,11 +967,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents { [dict get $date seconds]}
}
S { # Second of the minute, with
S { # Second of the minute, with
# leading zero
append formatString %02d
append substituents \
{ [expr { [dict get $date localSeconds]
{ [expr { [dict get $date localSeconds]
% 60 }]}
}
t { # A literal tab character
@@ -992,7 +992,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
}
incr dow
set UweekNumber \
[expr { ( [dict get $date dayOfYear]
[expr { ( [dict get $date dayOfYear]
- $dow + 7 )
/ 7 }]
}
@@ -1015,7 +1015,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
set WweekNumber \
[expr { ( [dict get $date dayOfYear]
- [dict get $date dayOfWeek]
+ 7 )
+ 7 )
/ 7 }]
}
append formatString %02d
@@ -1084,7 +1084,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
percentO { # Character following %O
set state {}
switch -exact -- $char {
d - e { # Day of the month in alternative
d - e { # Day of the month in alternative
# numerals
append formatString %s
append substituents \
@@ -1096,7 +1096,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents \
{ [lindex $localeNumerals \
[expr { [dict get $date localSeconds]
[expr { [dict get $date localSeconds]
/ 3600
% 24 }]]}
}
@@ -1122,7 +1122,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents \
{ [lindex $localeNumerals \
[expr { [dict get $date localSeconds]
[expr { [dict get $date localSeconds]
/ 60
% 60 }]]}
}
@@ -1131,7 +1131,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
append formatString %s
append substituents \
{ [lindex $localeNumerals \
[expr { [dict get $date localSeconds]
[expr { [dict get $date localSeconds]
% 60 }]]}
}
u { # Day of the week (Monday=1,Sunday=7)
@@ -1162,9 +1162,9 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
}
}
}
# Clean up any improperly terminated groups
switch -exact -- $state {
percent {
append formatString %%
@@ -1263,7 +1263,7 @@ proc ::tcl::clock::scan { args } {
}
if { [catch { expr { wide($base) } } result] } {
return -code error \
"expected integer but got \"$base\""
"expected integer but got \"$base\""
}
if { ![string is boolean $gmt] } {
return -code error \
@@ -1340,7 +1340,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
variable TZData
# Get the data for time changes in the given zone
if {[catch {SetupTimeZone $timezone} retval opts]} {
dict unset opts -errorinfo
return -options $opts $retval
@@ -1353,7 +1353,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
$base \
$TZData($timezone) \
2361222]
dict set date secondOfDay [expr { [dict get $date localSeconds]
dict set date secondOfDay [expr { [dict get $date localSeconds]
% 86400 }]
# Parse the date. The parser will return a list comprising
@@ -1400,7 +1400,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
# east of Greenwich, and the second is a Daylight Saving Time
# indicator ( 1 == yes, 0 == no, -1 == unknown ). We make it into
# a time zone indicator of +-hhmm.
if { [llength $parseZone] > 0 } {
lassign $parseZone minEast dstFlag
set timezone [FormatNumericTimeZone \
@@ -1414,9 +1414,9 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222]
if { $parseTime ne {} } {
dict set date secondOfDay $parseTime
} elseif { [llength $parseWeekday] != 0
|| [llength $parseOrdinalMonth] != 0
|| ( [llength $parseRel] != 0
} elseif { [llength $parseWeekday] != 0
|| [llength $parseOrdinalMonth] != 0
|| ( [llength $parseRel] != 0
&& ( [lindex $parseRel 0] != 0
|| [lindex $parseRel 1] != 0 ) ) } {
dict set date secondOfDay 0
@@ -1437,17 +1437,17 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
set seconds [add $seconds \
$relMonth months $relDay days $relSecond seconds \
-timezone $timezone -locale $locale]
}
}
# Do relative weekday
if { [llength $parseWeekday] > 0 } {
lassign $parseWeekday dayOrdinal dayOfWeek
set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
dict set date2 era CE
set jdwkday [WeekdayOnOrBefore $dayOfWeek \
[expr { [dict get $date2 julianDay]
[expr { [dict get $date2 julianDay]
+ 6 }]]
incr jdwkday [expr { 7 * $dayOrdinal }]
if { $dayOrdinal > 0 } {
@@ -1506,7 +1506,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
#
# Results:
# Constructs and returns a procedure that accepts the
# string being scanned, the base time, and the time zone.
# string being scanned, the base time, and the time zone.
# The procedure will either return the scanned time or
# else throw an error that should be rethrown to the caller
# of [clock scan]
@@ -1776,7 +1776,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
append re \\s*\\d\\d?
}
V { # Week of ISO8601 year
append re \\s*(\\d\\d?)
dict set fieldSet iso8601Week [incr fieldCount]
append postcode "dict set date iso8601Week \[" \
@@ -1948,7 +1948,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"day of week is greater than 7"
}
dict set date dayOfWeek $dow
}
}
}
y {
lassign [LocaleNumeralMatcher $locale] regex lookup
@@ -1996,7 +1996,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
# Get time zone if needed
if { ![dict exists $fieldSet seconds]
if { ![dict exists $fieldSet seconds]
&& ![dict exists $fieldSet starDate] } {
if { [dict exists $fieldSet tzName] } {
append procBody {
@@ -2018,7 +2018,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
# Assemble seconds, and convert local nominal time to UTC.
if { ![dict exists $fieldSet seconds]
if { ![dict exists $fieldSet seconds]
&& ![dict exists $fieldSet starDate] } {
append procBody {
if { [dict get $date julianDay] > 5373484 } {
@@ -2047,7 +2047,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
return $procName
}
#----------------------------------------------------------------------
#
# LocaleNumeralMatcher --
@@ -2087,7 +2087,7 @@ proc ::tcl::clock::LocaleNumeralMatcher {l} {
}
return [dict get $LocaleNumeralCache $l]
}
#----------------------------------------------------------------------
@@ -2128,7 +2128,7 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
foreach { key value } $data {
# Construct all prefixes of the key;
# Construct all prefixes of the key;
set prefix {}
foreach char [split $key {}] {
@@ -2191,7 +2191,7 @@ proc ::tcl::clock::UniquePrefixRegexp { data } {
#
#----------------------------------------------------------------------
proc ::tcl::clock::MakeUniquePrefixRegexp { successors
proc ::tcl::clock::MakeUniquePrefixRegexp { successors
uniquePrefixMapping
prefixString } {
@@ -2322,7 +2322,7 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
set currPrio $prio
set currFieldPos $fPos
set currCodeBurst $parseAction
}
return $currCodeBurst
@@ -2401,7 +2401,7 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {
dict set McLoaded $locale {}
}
}
}
#----------------------------------------------------------------------
#
@@ -2565,7 +2565,7 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
# string. Note that the order of the [string map] operations is
# significant because later formats can refer to later ones; for example
# %c can refer to %X, which in turn can refer to %T.
set list {
%% %%
%D %m/%d/%Y
@@ -2582,7 +2582,7 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
lappend list %c [string map $list [mc DATE_TIME_FORMAT]]
lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
set format [string map $list $format]
dict set McLoaded $locale FORMAT $inFormat $format
return $format
}
@@ -2790,7 +2790,7 @@ proc ::tcl::clock::ScanWide { str } {
#
#----------------------------------------------------------------------
proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
{ twoDigitField yearOfCentury }
{ fourDigitField year } } {
@@ -2886,7 +2886,7 @@ proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
#
# AssignBaseMonth --
#
# Places the number of the current year and month into a
# Places the number of the current year and month into a
# dictionary.
#
# Parameters:
@@ -3191,10 +3191,10 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]
} elseif { [string index $timezone 0] eq {:} } {
# Convert using a time zone file
if {
if {
[catch {
LoadTimeZoneFile [string range $timezone 1 end]
}]
@@ -3206,9 +3206,9 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
}
} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
# This looks like a POSIX time zone - try to process it
if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
@@ -3255,7 +3255,7 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
# no time zone information supplied with Windows actually uses
# them!
#
# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is
# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is
# specified, GuessWindowsTimeZone looks in the Registry for the
# system time zone information. It then attempts to find an entry
# in WinZoneInfo for a time zone that uses the same rules. If
@@ -3378,7 +3378,7 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
: [::format %02d $stdSecond]
}
dict set WinZoneInfo $data $tzname
}
}
return [dict get $WinZoneInfo $data]
@@ -3533,10 +3533,10 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
if {$version eq "2"} {
set seek [expr {44
+ 5 * $nTime
+ 6 * $nType
+ 5 * $nTime
+ 6 * $nType
+ 4 * $nLeap
+ $nIsStd
+ $nIsStd
+ $nIsGMT
+ $nChar
}]
@@ -3652,7 +3652,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
# The following keys are present in the dictionary:
# stdName - Name of the time zone when Daylight Saving Time
# is not in effect.
# stdSignum - Sign (+, -, or empty) of the offset from Greenwich
# stdSignum - Sign (+, -, or empty) of the offset from Greenwich
# to the given (non-DST) time zone. + and the empty
# string denote zones west of Greenwich, - denotes east
# of Greenwich; this is contrary to the ISO convention
@@ -3697,7 +3697,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
# endHours, endMinutes, endSeconds -
# Specify the end of DST in the same way that the start* fields
# specify the beginning of DST.
#
#
# This procedure serves only to break the time specifier into fields.
# No attempt is made to canonicalize the fields or supply default values.
#
@@ -3715,8 +3715,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
([[:digit:]]{1,2})
(?:
# 4 - Standard time zone offset, minutes
: ([[:digit:]]{1,2})
(?:
: ([[:digit:]]{1,2})
(?:
# 5 - Standard time zone offset, seconds
: ([[:digit:]]{1,2} )
)?
@@ -3732,8 +3732,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
([[:digit:]]{1,2})
(?:
# 9 - DST time zone offset, minutes
: ([[:digit:]]{1,2})
(?:
: ([[:digit:]]{1,2})
(?:
# 10 - DST time zone offset, seconds
: ([[:digit:]]{1,2})
)?
@@ -3746,8 +3746,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
( J ? ) ( [[:digit:]]+ )
| M
# 13 - Month number 14 - Week of month 15 - Day of week
( [[:digit:]] + )
[.] ( [[:digit:]] + )
( [[:digit:]] + )
[.] ( [[:digit:]] + )
[.] ( [[:digit:]] + )
)
(?:
@@ -3768,8 +3768,8 @@ proc ::tcl::clock::ParsePosixTimeZone { tz } {
( J ? ) ( [[:digit:]]+ )
| M
# 21 - Month number 22 - Week of month 23 - Day of week
( [[:digit:]] + )
[.] ( [[:digit:]] + )
( [[:digit:]] + )
[.] ( [[:digit:]] + )
[.] ( [[:digit:]] + )
)
(?:
@@ -3845,14 +3845,14 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
} else {
set stdSignum -1
}
set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
if { [dict get $z stdMinutes] ne {} } {
set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
} else {
set stdMinutes 0
}
if { [dict get $z stdSeconds] ne {} } {
set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
} else {
set stdSeconds 0
}
@@ -3881,14 +3881,14 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
if { [dict get $z dstHours] eq {} } {
set dstOffset [expr { 3600 + $stdOffset }]
} else {
set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
if { [dict get $z dstMinutes] ne {} } {
set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
} else {
set dstMinutes 0
}
if { [dict get $z dstSeconds] ne {} } {
set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
} else {
set dstSeconds 0
}
@@ -3903,7 +3903,7 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
# US end time is the first Sunday in November.
# EU end time is the last Sunday in October
if { [dict get $z startDayOfYear] eq {}
if { [dict get $z startDayOfYear] eq {}
&& [dict get $z startMonth] eq {} } {
if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
# EU
@@ -3923,7 +3923,7 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
dict set z startMinutes 0
dict set z startSeconds 0
}
if { [dict get $z endDayOfYear] eq {}
if { [dict get $z endDayOfYear] eq {}
&& [dict get $z endMonth] eq {} } {
if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
# EU
@@ -3964,8 +3964,8 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } {
}
return $data
}
}
#----------------------------------------------------------------------
#
@@ -4000,7 +4000,7 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
# Time was specified as a day of the year
if { [dict get $z ${bound}J] ne {}
&& [IsGregorianLeapYear $y]
&& [IsGregorianLeapYear $y]
&& ( $doy > $FEB_28 ) } {
incr doy
}
@@ -4078,7 +4078,7 @@ proc ::tcl::clock::GetLocaleEra { date etable } {
[expr { [dict get $date year] % 100 }]
} else {
dict set date localeEra [lindex $etable $index 1]
dict set date localeYear [expr { [dict get $date year]
dict set date localeYear [expr { [dict get $date year]
- [lindex $etable $index 2] }]
}
return $date
@@ -4136,7 +4136,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
+ ( $ym1 / 4 )
- ( $ym1 / 100 )
+ ( $ym1 / 400 ) }]
# If the date is before the Gregorian change, use the Julian calendar.
if { $jd < $changeover } {
@@ -4219,7 +4219,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
proc ::tcl::clock::IsGregorianLeapYear { date } {
switch -exact -- [dict get $date era] {
BCE {
BCE {
set year [expr { 1 - [dict get $date year]}]
}
CE {
@@ -4415,7 +4415,7 @@ proc ::tcl::clock::add { clockval args } {
}
if { [catch { expr { wide($clockval) } } result] } {
return -code error \
"expected integer but got \"$clockval\""
"expected integer but got \"$clockval\""
}
if { ![string is boolean $gmt] } {
return -code error \
@@ -4427,7 +4427,7 @@ proc ::tcl::clock::add { clockval args } {
}
EnterLocale $locale oldLocale
set changeover [mc GREGORIAN_CHANGE_DATE]
if {[catch {SetupTimeZone $timezone} retval opts]} {

Some files were not shown because too many files have changed in this diff Show More