Compare commits
2
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
9befca04cc | ||
|
|
d8f1034a21 |
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
@@ -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
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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.
|
||||
@@ -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/).
|
||||
|
||||
[](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.
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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.
|
||||
|
||||
@@ -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
@@ -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.
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
|
||||
.
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
@@ -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
@@ -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:
|
||||
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+27
-45
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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) {
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
@@ -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;
|
||||
|
||||
@@ -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) {
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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
@@ -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.
|
||||
|
||||
@@ -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
File diff suppressed because it is too large
Load Diff
+5
-3
@@ -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
@@ -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);
|
||||
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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
@@ -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))
|
||||
|
||||
/*
|
||||
|
||||
@@ -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 */
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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 *)));
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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();
|
||||
}
|
||||
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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 */
|
||||
|
||||
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+99
-155
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
Reference in New Issue
Block a user