Compare commits

..
275 changed files with 15375 additions and 70942 deletions
-7
View File
@@ -1,7 +0,0 @@
puts exe:\t[info nameofexecutable]
puts ver:\t[info patchlevel]
catch {
puts build:\t[tcl::build-info]
}
puts lib:\t[info library]
puts plat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]
+15 -39
View File
@@ -5,54 +5,32 @@ on:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
- "core-**"
permissions:
contents: read
jobs:
plan:
runs-on: ubuntu-latest
outputs:
gcc: ${{ steps.matrix.outputs.gcc }}
steps:
- name: Select build matrix based on branch name
id: matrix
run: |
(
echo gcc=$(jq -nc '{config: (if env.IsMatched == "true" then env.FULL else env.PARTIAL end) | fromjson }' )
) | tee -a $GITHUB_OUTPUT
env:
IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-0-branch' }}
# DO NOT CHANGE THESE MATRIX SPECS; IT AFFECTS OUR COST CONTROLS
FULL: >
[
"",
"CFLAGS=-DTCL_NO_DEPRECATED=1",
"--disable-shared",
"--disable-zipfs",
"--enable-symbols",
"--enable-symbols=mem",
"--enable-symbols=all",
"CFLAGS=-ftrapv",
"CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit"
]
PARTIAL: >
[
"",
"--enable-symbols=all",
"CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit"
]
gcc:
needs: plan
runs-on: ubuntu-24.04
strategy:
matrix: ${{ fromJson(needs.plan.outputs.gcc) }}
matrix:
config:
- ""
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--disable-zipfs"
- "--enable-symbols"
- "--enable-symbols=mem"
- "--enable-symbols=all"
- "CFLAGS=-ftrapv"
# Duplicated below
- "CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit"
defaults:
run:
shell: bash
working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
timeout-minutes: 5
- name: Install 32-bit dependencies if needed
# Duplicated from above
@@ -82,7 +60,7 @@ jobs:
- name: Info
run: |
ulimit -a || echo 'get limit failed'
make runtest SCRIPT=../.github/workflows/info.tcl || echo 'get info failed'
echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
- name: Run Tests
run: |
make test
@@ -94,12 +72,10 @@ jobs:
make install
timeout-minutes: 5
- name: Create Distribution Package
if: ${{ matrix.config == '' }}
run: |
make dist
timeout-minutes: 5
- name: Convert Documentation to HTML
if: ${{ matrix.config == '' }}
run: |
make html-tcl
timeout-minutes: 5
+12 -34
View File
@@ -5,38 +5,10 @@ on:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
- "core-**"
permissions:
contents: read
jobs:
plan:
runs-on: ubuntu-latest
outputs:
clang: ${{ steps.matrix.outputs.clang }}
steps:
- name: Select build matrix based on branch name
id: matrix
run: |
(
echo clang=$(jq -nc '{config: (if env.IsMatched == "true" then env.FULL else env.PARTIAL end) | fromjson }' )
) | tee -a $GITHUB_OUTPUT
env:
IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-0-branch' }}
# DO NOT CHANGE THIS MATRIX SPEC; IT AFFECTS OUR COST CONTROLS
FULL: >
[
"",
"--disable-shared",
"--disable-zipfs",
"--enable-symbols",
"--enable-symbols=mem",
"--enable-symbols=all"
]
PARTIAL: >
[
"",
"--enable-symbols=all"
]
xcode:
runs-on: macos-15
defaults:
@@ -45,7 +17,7 @@ jobs:
working-directory: macosx
steps:
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
timeout-minutes: 5
- name: Prepare
run: |
@@ -64,16 +36,22 @@ jobs:
timeout-minutes: 15
clang:
runs-on: macos-15
needs: plan
strategy:
matrix: ${{ fromJson(needs.plan.outputs.clang) }}
matrix:
config:
- ""
- "--disable-shared"
- "--disable-zipfs"
- "--enable-symbols"
- "--enable-symbols=mem"
- "--enable-symbols=all"
defaults:
run:
shell: bash
working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
timeout-minutes: 5
- name: Prepare
run: |
@@ -96,7 +74,7 @@ jobs:
- name: Info
run: |
ulimit -a || echo 'get limit failed'
make runtest SCRIPT=../.github/workflows/info.tcl || echo 'get info failed'
echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
- name: Run Tests
run: |
make test
+10 -9
View File
@@ -5,20 +5,20 @@ on:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
- "core-**"
permissions:
contents: read
jobs:
linux:
name: Linux
runs-on: ubuntu-24.04
runs-on: ubuntu-22.04
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
- name: Prepare
run: |
touch generic/tclStubInit.c generic/tclOOStubInit.c
@@ -61,9 +61,9 @@ jobs:
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
- name: Checkout create-dmg
uses: actions/checkout@v5
uses: actions/checkout@v4
with:
repository: create-dmg/create-dmg
ref: v1.0.8
@@ -124,7 +124,7 @@ jobs:
url: ${{ steps.upload.outputs.artifact-url }}
win:
name: Windows
runs-on: windows-2025
runs-on: windows-2019
defaults:
run:
shell: msys2 {0}
@@ -139,7 +139,7 @@ jobs:
msystem: UCRT64
install: git mingw-w64-ucrt-x86_64-toolchain make zip
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
- name: Prepare
run: |
touch generic/tclStubInit.c generic/tclOOStubInit.c
@@ -153,6 +153,7 @@ jobs:
run: |
make binaries libraries
echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
rm tclsh*c*.exe
working-directory: win
- name: Get Exact Version
run: |
@@ -194,7 +195,7 @@ jobs:
run: |
mkdir data
- name: Get Linux build
uses: actions/download-artifact@v5
uses: actions/download-artifact@v4
with:
path: data
# Can't download by artifact ID; stupid missing feature!
@@ -205,7 +206,7 @@ jobs:
working-directory: data
- name: Transfer built files
# https://github.com/marketplace/actions/rsync-deployments-action
uses: burnett01/rsync-deployments@7.1.0
uses: burnett01/rsync-deployments@7.0.2
id: rsync
if: false # Disabled... for now
with:
+24 -58
View File
@@ -5,69 +5,31 @@ on:
- "main"
- "core-9-0-branch"
tags:
- "core-*"
- "core-**"
permissions:
contents: read
env:
ERROR_ON_FAILURES: 1
jobs:
plan:
runs-on: ubuntu-latest
outputs:
msvc: ${{ steps.matrix.outputs.msvc }}
gcc: ${{ steps.matrix.outputs.gcc }}
steps:
- name: Select build matrix based on branch name
id: matrix
run: |
(
echo msvc=$(jq -nc '{config: (if env.IsMatched == "true" then env.MSVC_FULL else env.MSVC_PARTIAL end) | fromjson }' )
echo gcc=$(jq -nc '{config: (if env.IsMatched == "true" then env.GCC_FULL else env.GCC_PARTIAL end) | fromjson }' )
) | tee -a $GITHUB_OUTPUT
env:
IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-0-branch' }}
# DO NOT CHANGE THESE MATRIX SPECS; IT AFFECTS OUR COST CONTROLS
MSVC_FULL: >
[
"",
"CHECKS=nodep",
"OPTS=static",
"OPTS=noembed",
"OPTS=symbols",
"OPTS=symbols STATS=compdbg,memdbg"
]
MSVC_PARTIAL: >
[
"",
"OPTS=symbols STATS=compdbg,memdbg"
]
GCC_FULL: >
[
"",
"CFLAGS=-DTCL_NO_DEPRECATED=1",
"--disable-shared",
"--disable-zipfs",
"--enable-symbols",
"--enable-symbols=mem",
"--enable-symbols=all"
]
GCC_PARTIAL: >
[
"",
"--disable-shared",
"--enable-symbols=all"
]
msvc:
runs-on: windows-2025
needs: plan
defaults:
run:
shell: powershell
working-directory: win
strategy:
matrix: ${{ fromJson(needs.plan.outputs.msvc) }}
matrix:
config:
- ""
- "CHECKS=nodep"
- "OPTS=static"
- "OPTS=noembed"
- "OPTS=symbols"
- "OPTS=symbols STATS=compdbg,memdbg"
# Using powershell means we need to explicitly stop on failure
steps:
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
timeout-minutes: 5
- name: Init MSVC
uses: ilammy/msvc-dev-cmd@v1
@@ -93,17 +55,23 @@ jobs:
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 30
env:
ERROR_ON_FAILURES: 1
gcc:
runs-on: windows-2025
needs: plan
defaults:
run:
shell: msys2 {0}
working-directory: win
strategy:
matrix: ${{ fromJson(needs.plan.outputs.gcc) }}
matrix:
config:
- ""
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--disable-zipfs"
- "--enable-symbols"
- "--enable-symbols=mem"
- "--enable-symbols=all"
# Using powershell means we need to explicitly stop on failure
steps:
- name: Install MSYS2
uses: msys2/setup-msys2@v2
@@ -112,7 +80,7 @@ jobs:
install: git mingw-w64-x86_64-toolchain make
timeout-minutes: 10
- name: Checkout
uses: actions/checkout@v5
uses: actions/checkout@v4
timeout-minutes: 5
- name: Prepare
run: |
@@ -134,12 +102,10 @@ jobs:
- name: Info
run: |
ulimit -a || echo 'get limit failed'
make runtest SCRIPT=../.github/workflows/info.tcl || echo 'get info failed'
echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
- name: Run Tests
run: make test
timeout-minutes: 30
env:
ERROR_ON_FAILURES: 1
# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.
+1 -1
View File
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
<name>tcl9.1</name>
<name>tcl9</name>
<comment></comment>
<projects>
</projects>
+5 -5
View File
@@ -1,6 +1,6 @@
# README: Tcl
This is the **Tcl 9.1a1** source distribution.
This is the **Tcl 9.0.2** source distribution.
You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).
@@ -31,7 +31,7 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/).
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 macOS.
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.
@@ -51,7 +51,7 @@ and selling it either in whole or in part. See the file
## <a id="doc">2.</a> Documentation
Extensive documentation is available on our website.
The home page for this release, including new features, is
[here](https://www.tcl-lang.org/software/tcltk/9.1.html).
[here](https://www.tcl-lang.org/software/tcltk/9.0.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.
@@ -61,8 +61,8 @@ Xchange](https://www.tcl-lang.org/about/).
There have been many Tcl books on the market. Many are mentioned in
[the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206).
The complete set of reference manual entries for Tcl 9.1 is [online,
here](https://www.tcl-lang.org/man/tcl9.1/).
The complete set of reference manual entries for Tcl 9.0 is [online,
here](https://www.tcl-lang.org/man/tcl9.0/).
### <a id="doc.unix">2a.</a> Unix Documentation
The `doc` subdirectory in this release contains a complete set of
+197 -16
View File
@@ -4,30 +4,211 @@ changes to the Tcl source code at
> [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline)
Release Tcl 9.1a1 arises from the check-in with tag `core-9-1-a1`.
Release Tcl 9.0.2 arises from the check-in with tag `core-9-0-2`.
Highlighted differences between Tcl 9.1 and Tcl 9.0 are summarized below,
Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase.
# Bug fixes
- [Better error-message than "interpreter uses an incompatible stubs mechanism"](https://core.tcl-lang.org/tcl/tktview/fc3509)
- [\[$interp eval $lambda\] after \[eval $lambda\] or vice versa fails](https://core.tcl-lang.org/tcl/tktview/67d5f7)
- [tcl::mathfunc::isunordered inconsistency with some integer values](https://core.tcl-lang.org/tcl/tktview/98006f)
- [test lseq hangs with -Os](https://core.tcl-lang.org/tcl/tktview/d2a3c5)
- [exec does not handle app execution aliases on Windows](https://core.tcl-lang.org/tcl/tktview/4f0b57)
- [auto_execok does not find several built-in cmd commands](https://core.tcl-lang.org/tcl/tktview/4e2c8b)
- [Panic "Buffer Underflow, BUFFER_PADDING not enough"](https://core.tcl-lang.org/tcl/tktview/73bb42)
- [MS-VS build system: pckIndex.tcl when building for 9 misses "t" for TCL 8.6 part](https://core.tcl-lang.org/tcl/tktview/a77029)
- [clock format -locale does not look up locale children if parent locale used first](https://core.tcl-lang.org/tcl/tktview/2c0f49)
- [Missing libtcl?.?.dll.a in Cygwin](https://core.tcl-lang.org/tcl/tktview/dcedba)
- [tclEpollNotfy PlatformEventsControl panics if websocket disconnected](https://core.tcl-lang.org/tcl/tktview/010d8f)
- [Tcl_InitStubs compatibility for 9.1](https://core.tcl-lang.org/tcl/tktview/fd8341)
- [proc with more than 2**31 variables](https://core.tcl-lang.org/tcl/tktview/92aeb8)
- [scan "long mantissa" %g](https://core.tcl-lang.org/tcl/tktview/42d14c)
- ["encoding system": wrong result without manifest](https://core.tcl-lang.org/tcl/tktview/8ffd8c)
- [lseq crash on out-of-range index](https://core.tcl-lang.org/tcl/tktview/7d3101)
- [lseq crash on nested indices](https://core.tcl-lang.org/tcl/tktview/452b10)
# Incompatibilities
- No known incompatibilities with the Tcl 9.0.0 public interface.
# Updated bundled packages, libraries, standards, data
- sqlite3 3.49.1
- tzdata 2025b
Release Tcl 9.0.1 arises from the check-in with tag `core-9-0-1`.
Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase. As the first patch release in the Tcl 9.0.\* series,
Tcl 9.0.1 also includes a small number of interface changes that complete
some incomplete features first delivered in Tcl 9.0.0.
# Completed 9.0 Features and Interfaces
- [TIP 701 - Tcl_FSTildeExpand C API](https://core.tcl-lang.org/tips/doc/trunk/tip/701.md)
- [TIP 707 - ptrAndSize internal rep in Tcl_Obj](https://core.tcl-lang.org/tips/doc/trunk/tip/707.md)
- [Size modifiers j, q, z, t not implemented]( https://core.tcl-lang.org/tcl/info/c4f365)
# Bug fixes
- [regression in tzdata, %z instead of offset TZ-name](https://core.tcl-lang.org/tcl/tktview/2c237b)
- [Tcl will not start properly if there is an init.tcl file in the current dir](https://core.tcl-lang.org/tcl/tktview/43c94f)
- [clock scan "24:00", ISO-8601 compatibility](https://core.tcl-lang.org/tcl/tktview/aee9f2)
- [Temporary folder with file "tcl9registry13.dll" remains after "exit"](https://core.tcl-lang.org/tcl/tktview/6ce3c0)
- [Wrong result by "lsearch -stride -subindices -inline -all"](https://core.tcl-lang.org/tcl/info/5a1aaa)
- [TIP 609 - required Tcl_ThreadAlert() skipped with nested event loop](https://core.tcl-lang.org/tcl/info/c7e4c4)
- [buffer overwrite for non-BMP characters in utf-16](https://core.tcl-lang.org/tcl/tktview/66da4d)
- [zipfs info on mountpoint of executable returns zero offset in field 4"](https://core.tcl-lang.org/tcl/info/aaa84f)
- [zlib-8.8, zlib-8.16 fail on Fedora 40, gcc 14.1.1](https://core.tcl-lang.org/tcl/tktview/73d5cb)
- [install registry and dde in $INSTALL_DIR\lib always](https://core.tcl-lang.org/tcl/tktview/364bd9)
- [cannot build .chm help file (Windows)](https://core.tcl-lang.org/tcl/tktview/bb110c)
# Incompatibilities
- No known incompatibilities with the Tcl 9.0.0 public interface.
# Updated bundled packages, libraries, standards, data
- Itcl 4.3.2
- sqlite3 3.47.2
- Thread 3.0.1
- TDBC\* 1.1.10
- tcltest 2.5.9
- tzdata 2024b, corrected
Release Tcl 9.0.0 arises from the check-in with tag `core-9-0-0`.
Highlighted differences between Tcl 9.0 and Tcl 8.6 are summarized below,
with focus on changes important to programmers using the Tcl library and
writing Tcl scripts.
# New commands and options
# Major Features
- [New options -backslashes, -commands and -variables for subst command](https://core.tcl-lang.org/tips/doc/trunk/tip/712.md)
- [New command unicode for Unicode normalization](https://core.tcl-lang.org/tips/doc/trunk/tip/726.md)
## 64-bit capacity: Data values larger than 2Gb
- Strings can be any length (that fits in your available memory)
- Lists and dictionaries can have very large numbers of elements
# New public C API
## Internationalization of text
- Full Unicode range of codepoints
- New encodings: `utf-16`/`utf-32`/`ucs-2`(`le`|`be`), `CESU-8`, etc.
- `encoding` options `-profile`, `-failindex` manage encoding of I/O.
- `msgcat` supports custom locale search list
- `source` defaults to `-encoding utf-8`
- [Tcl\_IsEmpty checks if the string representation of a value would be the empty string](https://core.tcl-lang.org/tips/doc/trunk/tip/711.md)
- [Tcl\_GetEncodingNameForUser returns name of encoding from user settings](https://core.tcl-lang.org/tips/doc/trunk/tip/716.md)
- [Tcl\_AttemptCreateHashEntry - version of Tcl\_CreateHashEntry that returns NULL instead of panic'ing on memory allocation errors](https://core.tcl-lang.org/tips/doc/trunk/tip/717.md)
- [Tcl\_ListObjRange, Tcl\_ListObjRepeat, Tcl\_TclListObjReverse - C API for new list operations](https://core.tcl-lang.org/tips/doc/trunk/tip/649.md)
- [Tcl\_UtfToNormalized, Tcl\_UtfToNormalizedDString - C API for Unicode normalization](https://core.tcl-lang.org/tips/doc/trunk/tip/726.md)
## Zip filesystems and attached archives.
- Packaging of the Tcl script library with the Tcl binary library,
meaning that the `TCL_LIBRARY` environment variable is usually not required.
- Packaging of an application into a virtual filesystem is now a supported
core Tcl feature.
# Performance
## Unix notifiers available using `epoll()` or `kqueue()`
- This relieves limits on file descriptors imposed by legacy `select()` and fixes a performance bottleneck.
- [Memory efficient internal representations](https://core.tcl-lang.org/tcl/wiki?name=New+abstract+list+representations)
for list operations on large lists.
# Incompatibilities
# Bug fixes
- [tclEpollNotfy PlatformEventsControl panics if websocket disconnected](https://core.tcl-lang.org/tcl/tktview/010d8f38)
## Notable incompatibilities
- Unqualified varnames resolved in current namespace, not global.
Note that in almost all cases where this causes a change, the change is actually the removal of a latent bug.
- No `--disable-threads` build option. Always thread-enabled.
- I/O malencoding default response: raise error (`-profile strict`)
- Windows platform needs Windows 7 or Windows Server 2008 R2 or later
- Ended interpretation of `~` as home directory in pathnames.
(See `file home` and `file tildeexpand` for replacements when you need them.)
- Removed the `identity` encoding.
(There were only ever very few valid use cases for this; almost all uses
were systematically wrong.)
- Removed the encoding alias `binary` to `iso8859-1`.
- `$::tcl_precision` no longer controls string generation of doubles.
(If you need a particular precision, use `format`.)
- Removed pre-Tcl 8 legacies: `case`, `puts` and `read` variant syntaxes.
- Removed subcommands [`trace variable`|`vdelete`|`vinfo`]
- Removed `-eofchar` option for write channels.
- On Windows 10+ (Version 1903 or higher), system encoding is always utf-8.
- `%b`/`%d`/`%o`/`%x` format modifiers (without size modifier) for `format`
and `scan` always truncate to 32-bits on all platforms.
- `%L` size modifier for `scan` no longer truncates to 64-bit.
- Removed command `::tcl::unsupported::inject`.
(See `coroinject` and `coroprobe` for supported commands with significantly
more comprehensible semantics.)
## Incompatibilities in C public interface
- Extensions built against Tcl 8.6 and before will not work with Tcl 9.0;
ABI compatibility was a non-goal for 9.0. In _most_ cases, rebuilding
against Tcl 9.0 should work except when a removed API function is used.
- Many arguments expanded type from `int` to `Tcl_Size`, a signed integer type
large enough to support 64-bit sized memory objects.
The constant `TCL_AUTO_LENGTH` is a value of that type that indicates that
the length should be obtained using an appropriate function (typically `strlen()` for `char *` values).
- Ended support for `Tcl_ChannelTypeVersion` less than 5
- Introduced versioning of the `Tcl_ObjType` struct
- Removed macros `CONST*`: Tcl 9 support means dropping Tcl 8.3 support.
(Replaced with standard C `const` keyword going forward.)
- Removed registration of several `Tcl_ObjType`s.
- Removed API functions:
`Tcl_Backslash()`,
`Tcl_*VA()`,
`Tcl_*MathFunc*()`,
`Tcl_MakeSafe()`,
`Tcl_(Save|Restore|Discard|Free)Result()`,
`Tcl_EvalTokens()`,
`Tcl_(Get|Set)DefaultEncodingDir()`,
`Tcl_UniCharN(case)cmp()`,
`Tcl_UniCharCaseMatch()`
- Revised many internals; beware reliance on undocumented behaviors.
# New Features
## New commands
- `array default` — Specify default values for arrays (note that this alters the behaviour of `append`, `incr`, `lappend`).
- `array for` — Cheap iteration over an array's contents.
- `chan isbinary` — Test if a channel is configured to work with binary data.
- `coroinject`, `coroprobe` — Interact with paused coroutines.
- `clock add weekdays` — Clock arithmetic with week days.
- `const`, `info const*` — Commands for defining constants (variables that can't be modified).
- `dict getwithdefault` — Define a fallback value to use when `dict get` would otherwise fail.
- `file home` — Get the user home directory.
- `file tempdir` — Create a temporary directory.
- `file tildeexpand` — Expand a file path containing a `~`.
- `info commandtype` — Introspection for the kinds of commands.
- `ledit` — Equivalent to `lreplace` but on a list in a variable.
- `lpop` — Remove an item from a list in a variable.
- `lremove` — Remove a sublist from a list in a variable.
- `lseq` — Generate a list of numbers in a sequence.
- `package files` — Describe the contents of a package.
- `string insert` — Insert a string as a substring of another string.
- `string is dict` — Test whether a string is a dictionary.
- `tcl::process` — Commands for working with subprocesses.
- `*::build-info` — Obtain information about the build of Tcl.
- `readFile`, `writeFile`, `foreachLine` — Simple procedures for basic working with files.
- `tcl::idna::*` — Commands for working with encoded DNS names.
## New command options
- `chan configure ... -inputmode ...` — Support for raw terminal input and reading passwords.
- `clock scan ... -validate ...`
- `info loaded ... ?prefix?`
- `lsearch ... -stride ...` — Search a list by groups of items.
- `regsub ... -command ...` — Generate the replacement for a regular expression by calling a command.
- `socket ... -nodelay ... -keepalive ...`
- `vwait` controlled by several new options
- `expr` string comparators `lt`, `gt`, `le`, `ge`
- `expr` supports comments inside expressions
## Numbers
- <code>0<i>NNN</i></code> format is no longer octal interpretation. Use <code>0o<i>NNN</i></code>.
- <code>0d<i>NNNN</i></code> format to compel decimal interpretation.
- <code>NN_NNN_NNN</code>, underscores in numbers for optional readability
- Functions: `isinf()`, `isnan()`, `isnormal()`, `issubnormal()`, `isunordered()`
- Command: `fpclassify`
- Function `int()` no longer truncates to word size
## TclOO facilities
- private variables and methods
- class variables and methods
- abstract and singleton classes
- configurable properties
- `method -export`, `method -unexport`
# Known bugs
- [changed behaviour wrt command names, namespaces and resolution](https://core.tcl-lang.org/tcl/tktview/f14b33)
- [windows dos device paths inconsistencies and missing functionality](https://core.tcl-lang.org/tcl/tktview/d8f121)
- [load library (dll) from zipfs-library causes a leak in temporary folder](https://core.tcl-lang.org/tcl/tktview/a8e4f7)
- [lsearch -sorted -inline -subindices incorrect result](https://core.tcl-lang.org/tcl/tktview/bc4ac0)
- ["No error" when load fails due to a missing secondary DLL](https://core.tcl-lang.org/tcl/tktview/bc4ac0)
+1 -1
View File
@@ -47,7 +47,7 @@ Interpreter to use for error reporting.
Points to space where the number of bytes in the array may be written.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
NULL for byte arrays larger than INT_MAX (which should
trigger proper error-handling), otherwise expect it to crash.
.BE
+1 -1
View File
@@ -87,7 +87,7 @@ for an alias.
Pointer to location to store count of additional value arguments to be
passed to the alias. The location is in storage owned by the caller.
If it points to a variable which type is not \fBTcl_Size\fR, a compiler
warning will be generated. If your extensions is compiled with \fB-DTCL_8_API\fR,
warning will be generated. If your extensions is compiled with -DTCL_8_API,
this function will return TCL_ERROR for aliases with more than INT_MAX
value arguments, otherwise expect it to crash
.AP Tcl_Obj ***objvPtr out
+1 -1
View File
@@ -74,7 +74,7 @@ Points to a variable that will have the number of key/value pairs
contained within the dictionary placed within it.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
NULL for dictionaries larger than INT_MAX (which should
trigger proper error-handling), otherwise expect it to crash.
.AP Tcl_DictSearch *searchPtr in/out
+7 -20
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtfDStringEx, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternalDStringEx, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNameForUser, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtfDStringEx, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternalDStringEx, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -53,9 +53,6 @@ int
const char *
\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)
.sp
const char *
\fBTcl_GetEncodingNameForUser\fR(\fIbufPtr\fR)
.sp
\fBTcl_GetEncodingNames\fR(\fIinterp\fR)
.sp
Tcl_Encoding
@@ -311,22 +308,12 @@ procedure increments the reference count of the new system encoding,
decrements the reference count of the old system encoding, and returns
\fBTCL_OK\fR.
.PP
\fBTcl_GetEncodingNameFromEnvironment\fR retrieves the encoding name to
use as the system encoding. On non-Windows platforms, this is derived
from the \fBnl_langinfo\fR system call if available, and environment
variables \fBLC_ALL\fR, \fBLC_CTYPE\fR or \fBLANG\fR otherwise. On
Windows versions Windows 10 Build 18362 and later the returned value is
always \fButf-8\fR. On earlier Windows versions, it is derived from the
user settings in the Windows registry. \fBTcl_GetEncodingNameForUser\fR
retrieves the encoding name based on the user settings for the current
user and is derived in the same manner as
\fBTcl_GetEncodingNameFromEnvironment\fR on non-Windows platforms. On
Windows, unlike \fBTcl_GetEncodingNameFromEnvironment\fR, it returns the
encoding name as per the Windows registry settings irrespective of the
Windows version. Both functions accept \fIbufPtr\fR, a pointer to an
uninitialized or freed \fBTcl_DString\fR and write the encoding name to
it. They return \fBTcl_DStringValue(bufPtr)\fR which points to the stored
name.
\fBTcl_GetEncodingNameFromEnvironment\fR provides a means for the Tcl
library to report the encoding name it believes to be the correct one
to use as the system encoding, based on system calls and examination of
the environment suitable for the platform. It accepts \fIbufPtr\fR,
a pointer to an uninitialized or freed \fBTcl_DString\fR and writes
the encoding name to it. The \fBTcl_DStringValue\fR is returned.
.PP
\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
consisting of the names of all the encodings that are currently defined
+1 -1
View File
@@ -278,7 +278,7 @@ permissions will be set on the created file.
Filled with the number of elements in the split path.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
NULL for paths having more than INT_MAX elements (which should
trigger proper error-handling), otherwise expect it to crash.
.AP Tcl_Obj *basePtr in
+2 -11
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_AttemptCreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -25,9 +25,6 @@ Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHash
Tcl_HashEntry *
\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_AttemptCreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
.sp
Tcl_HashEntry *
@@ -173,16 +170,10 @@ If an entry already existed with the given key then \fI*newPtr\fR
is set to zero.
If a new entry was created, then \fI*newPtr\fR is set to a non-zero
value and the value of the new entry will be set to zero.
\fI*newPtr\fR is allowed to be NULL.
The return value from \fBTcl_CreateHashEntry\fR is a pointer to
the entry, which may be used to retrieve and modify the entry's
value or to delete the entry from the table.
.PP
\fBTcl_AttemptCreateHashEntry\fR does the same as
\fBTcl_CreateHashEntry\fR, except in case of a memory
overflow. \fBTcl_AttemptCreateHashEntry\fR returns NULL
in that case while \fBTcl_CreateHashEntry\fR panics.
.PP
\fBTcl_DeleteHashEntry\fR will remove an existing entry from a
table.
The memory associated with the entry itself will be freed, but
@@ -285,7 +276,7 @@ The \fIhashKeyProc\fR member contains the address of a function called to
calculate a hash value for the key.
.PP
.CS
typedef size_t \fBTcl_HashKeyProc\fR(
typedef TCL_HASH_TYPE \fBTcl_HashKeyProc\fR(
Tcl_HashTable *\fItablePtr\fR,
void *\fIkeyPtr\fR);
.CE
+1 -1
View File
@@ -32,7 +32,7 @@ int
.sp
\fBTcl_LimitTypeReset\fR(\fIinterp, type\fR)
.sp
Tcl_Size
int
\fBTcl_LimitGetCommands\fR(\fIinterp\fR)
.sp
\fBTcl_LimitSetCommands\fR(\fIinterp, commandLimit\fR)
+33 -83
View File
@@ -4,11 +4,11 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_ListObj 3 9.1 Tcl "Tcl Library Procedures"
.TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace, Tcl_ListObjRange, Tcl_ListObjRepeat, Tcl_ListObjReverse \- manipulate Tcl values as lists
Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl values as lists
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -35,15 +35,6 @@ int
.sp
int
\fBTcl_ListObjReplace\fR(\fIinterp, listPtr, first, count, objc, objv\fR)
.sp
int
\fBTcl_ListObjRange\fR(\fIinterp, listPtr, first, last, objPtrPtr\fR)
.sp
int
\fBTcl_ListObjRepeat\fR(\fIinterp, count, objc, objv, objPtrPtr\fR)
.sp
int
\fBTcl_ListObjReverse\fR(\fIinterp, listPtr, objPtrPtr\fR)
.fi
.SH ARGUMENTS
.AS "Tcl_Obj *const" *elemListPtr in/out
@@ -52,12 +43,9 @@ If an error occurs while converting a value to be a list value,
an error message is left in the interpreter's result value
unless \fIinterp\fR is NULL.
.AP Tcl_Obj *listPtr in/out
Points to the input list value.
Points to the list value to be manipulated.
If \fIlistPtr\fR does not already point to a list value,
an attempt will be made to convert it to one.
Some functions may store a reference to it internally so
care must be taken when managing its reference count.
See the \fBREFERENCE COUNT MANAGEMENT\fR section below.
.AP Tcl_Obj *elemListPtr in/out
For \fBTcl_ListObjAppendList\fR, this points to a list value
containing elements to be appended onto \fIlistPtr\fR.
@@ -77,22 +65,29 @@ Points to location where \fBTcl_ListObjGetElements\fR
stores the number of element values in \fIlistPtr\fR.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB\-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
NULL for lists with more than INT_MAX elements (which should
trigger proper error-handling), otherwise expect it to crash.
.AP Tcl_Obj ***objvPtr out
A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
of pointers to the element values of \fIlistPtr\fR.
.AP Tcl_Size objc in
The number of Tcl values in the \fIobjv\fR array.
The number of Tcl values that \fBTcl_NewListObj\fR
will insert into a new list value,
and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
the number of Tcl values to insert into \fIobjPtr\fR.
.AP "Tcl_Obj *const" objv[] in
An array of pointers to Tcl values.
An array of pointers to values.
\fBTcl_NewListObj\fR will insert these values into a new list value
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
Each value will become a separate list element.
.AP "Tcl_Size \&| int" *lengthPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
TCL_ERROR for lists with more than INT_MAX elements (which should
trigger proper error-handling), otherwise expect it to crash.
.AP Tcl_Size index in
@@ -100,22 +95,23 @@ Index of the list element that \fBTcl_ListObjIndex\fR
is to return.
The first element has index 0.
.AP Tcl_Obj **objPtrPtr out
Points to location to store an output list or element value. No assumptions
should be made about the reference count of the returned value.
See the \fBREFERENCE COUNT MANAGEMENT\fR section below.
Points to place where \fBTcl_ListObjIndex\fR is to store
a pointer to the resulting list element value.
.AP Tcl_Size first in
Index of the first element in a range of elements in a list.
.AP Tcl_Size last in
Index of the last element in a range of elements in a list.
Index of the starting list element that \fBTcl_ListObjReplace\fR
is to replace.
The list's first element has index 0.
.AP Tcl_Size count in
The number of elements to be operated on or a repetition count.
The number of elements that \fBTcl_ListObjReplace\fR
is to replace.
.BE
.SH DESCRIPTION
.PP
Tcl list values have an internal representation that supports
the efficient indexing and appending.
The procedures described in this man page are used to
create, modify, access, and transform Tcl list values from C code.
create, modify, index, and append to Tcl list values from C code.
.PP
\fBTcl_ListObjAppendList\fR and \fBTcl_ListObjAppendElement\fR
both add one or more values
@@ -213,6 +209,7 @@ change from Tcl 8 where all list elements always have a reference
count of at least 1. (See \fBABSTRACT LIST TYPES\fR, \fBSTORAGE
MANAGEMENT OF VALUES\fR, Tcl_BounceRefCount(3), and lseq(n) for more
information.)
.PP
\fBTcl_ListObjReplace\fR replaces zero or more elements
of the list referenced by \fIlistPtr\fR
@@ -271,44 +268,8 @@ with a NULL \fIobjvPtr\fR:
result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
0, NULL);
.CE
.PP
\fBTcl_ListObjRange\fR stores in \fIobjPtrPtr\fR a pointer to a list value
containing all elements in the passed input list \fIlistPtr\fR at indices
between \fIfirst\fR and \fIlast\fR, both inclusive. An empty
list is returned in the case of \fIfirst\fR being greater than \fIlast\fR.
.PP
\fBTcl_ListObjRepeat\fR stores in \fIobjPtrPtr\fR a pointer to a list value
whose elements are the \fIobjc\fR elements passed in \fIobjv\fR, repeated
\fIcount\fR number of times. An error is raised if \fIcount\fR is negative.
.PP
\fBTcl_ListObjReverse\fR stores in \fIobjPtrPtr\fR a pointer to a list value
containing all elements of the input list \fIlistPtr\fR in reverse order.
.PP
For all three functions, \fBTcl_ListObjRange\fR, \fBTcl_ListObjRepeat\fR and
\fBTcl_ListObjReverse\fR, the value passed in \fIlistPtr\fR need not be unshared.
The pointer stored at \fIobjPtrPtr\fR is guaranteed to be different from
\fIlistPtr\fR but no assumptions should be made about its reference count.
In case of errors, the location addressed by \fIobjPtrPtr\fR may have been
modified and should be treated by the caller as undefined.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
Care must be taken by callers when managing the reference count
of values passed in as well as values returned from the above functions.
.PP
Unless specified otherwise below, the above functions may internally
keep a reference to the value passed in \fIlistPtr\fR and increment its
reference count. Therefore, if \fIlistPtr\fR is newly allocated and has
a zero reference count, it should not be freed after the call with
\fBTcl_DecrRefCount\fR. Rather, use \fBTcl_BounceRefCount\fR instead.
Furthermore, if \fIlistPtr\fR was retrieved from the interpreter result
(e.g. via \fBTcl_GetObjResult\fR) and that is the only reference to the
value, it may be deleted if a function sets the interpreter result on
error. The more general and safe method for passing values is to
increment their reference counts with \fBTcl_IncrRefCount\fR prior to
the call and release them with \fBTcl_DecrRefCount\fR when the call
returns. However, this may preclude certain optimizations based on
modifying unshared values in-place.
.PP
\fBTcl_NewListObj\fR always returns a zero-reference object, much like
\fBTcl_NewObj\fR. If a non-NULL \fIobjv\fR argument is given, the reference
counts of the first \fIobjc\fR values in that array are incremented.
@@ -318,31 +279,20 @@ argument, but does require that the object be unshared. The reference counts
of the first \fIobjc\fR values in the \fIobjv\fR array are incremented.
.PP
\fBTcl_ListObjGetElements\fR, \fBTcl_ListObjIndex\fR, and
\fBTcl_ListObjLength\fR do not modify the reference count of the
\fIlistPtr\fR argument except on error when the interpreter
result holds a reference to it as described earlier.
\fBTcl_ListObjLength\fR do not modify the reference count of their
\fIlistPtr\fR arguments; they only read. Note however that these three
functions may set the interpreter result; if that is the only place that is
holding a reference to the object, it will be deleted.
.PP
\fBTcl_ListObjAppendList\fR, \fBTcl_ListObjAppendElement\fR, and
\fBTcl_ListObjReplace\fR require an unshared \fIlistPtr\fR argument.
\fBTcl_ListObjAppendList\fR only reads its \fIelemListPtr\fR argument.
\fBTcl_ListObjAppendElement\fR increments the reference count of its
\fIobjPtr\fR on success. \fBTcl_ListObjReplace\fR increments the
reference count of the first \fIobjc\fR values in the \fIobjv\fR array
on success. Note that the same caveat stated earlier applies if the
interpreter result holds a reference to \fIlistPtr\fR.
.PP
The pointer to a result value returned in \fIobjPtrPtr\fR by the
functions \fBTcl_ListObjRange\fR,
\fBTcl_ListObjRepeat\fR and \fBTcl_ListObjReverse\fR is guaranteed
to be different from the \fBlistPtr\fR passed in. It is therefore
safe to manage its reference count independently from that of
\fBlistPtr\fR. No assumptions should be made about its reference
count and the standard reference counting idiom should be followed.
The caller can pass it to a function such as \fBTcl_SetObjResult\fR,
\fBTcl_ListObjAppendElement\fR etc. which take ownership of
its reference count management or dispose of the value itself
with either a \fBTcl_IncrRefCount\fR/\fBTcl_DecrRefCount\fR pair or
\fBTcl_BounceRefCount\fR.
\fIobjPtr\fR on success. \fBTcl_ListObjReplace\fR increments the reference
count of the first \fIobjc\fR values in the \fIobjv\fR array on success. Note
however that all these three functions may set the interpreter result on
failure; if that is the only place that is holding a reference to the object,
it will be deleted.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
.SH KEYWORDS
+1 -4
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_NewObj, Tcl_DuplicateObj, Tcl_AttemptDuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_BounceRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values
Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_BounceRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -19,9 +19,6 @@ Tcl_Obj *
Tcl_Obj *
\fBTcl_DuplicateObj\fR(\fIobjPtr\fR)
.sp
Tcl_Obj *
\fBTcl_AttemptDuplicateObj\fR(\fIobjPtr\fR)
.sp
\fBTcl_IncrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
+5 -23
View File
@@ -269,9 +269,6 @@ Tcl routines accepting string values as arguments.
Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR.
Note that \fIupdateStringProc\fRs must allocate
enough storage for the string's bytes and the terminating null byte.
If the \fIupdateStringProc\fR cannot do that, it must set
interp->bytes to be NULL (freeing the previous content), and set
interp->length to the number of bytes it tried to allocate.
.PP
The \fIupdateStringProc\fR for Tcl's built-in double type, for example,
calls Tcl_PrintDouble to write to a buffer of size TCL_DOUBLE_SPACE,
@@ -352,9 +349,8 @@ without converting the value to a List type. This requires the custom
type to provide functions that will perform the given operation on the
custom data representation. Not all functions are required. In the
absence of a particular function (set to NULL), the fallback is to
allow the internal List operation to perform the operation, which
may possibly cause the value type to be converted to a traditional
list.
allow the internal List operation to perform the operation, most
likely causing the value type to be converted to a traditional list.
.SS "SCALAR VALUE TYPES"
.PP
For a custom value type that is scalar or atomic in nature, i.e., not
@@ -368,17 +364,6 @@ Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
functions described below are provided. This allows for script level
use of the List commands without causing the type of the Tcl_Obj value
to be converted to a list.
Unless specified otherwise, all functions specific to Version 2 should return
\fBTCL_OK\fR on success and \fBTCL_ERROR\fR on failure.
In the case that a \fBTcl_Obj*\fR is also returned, the reference count of the
returned \fBTcl_Obj\fR should not be incremented so, for example, if a new
\fBTcl_Obj\fR value is returned it should have a reference count of zero.
The functions should not assume that any \fBTcl_Obj\fR passed in
is unshared.
.SS "THE LENGTHPROC FIELD"
.PP
The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
@@ -393,11 +378,8 @@ typedef Tcl_Size
.SS "THE INDEXPROC FIELD"
.PP
The \fBIndexProc\fR function correlates with with the
\fBTcl_ListObjIndex\fR C API. The function should store a pointer to
the element at the specified \fBindex\fR in \fB*elemObj\fR.
Indices that are out of bounds should not be treated as errors;
rather, the function should store a null pointer and
return TCL_OK.
\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
the element at the specified index.
.CS
typedef int (\fBTcl_ObjTypeIndexProc\fR) (
Tcl_Interp *interp,
@@ -422,7 +404,7 @@ typedef int (\fBTcl_ObjTypeSliceProc\fR) (
.PP
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
returning a List or Abstract List that has the same elements as the
input Abstract List, but in reverse order.
input Abstract List, with the elements in the reverse order.
.CS
typedef int (\fBTcl_ObjTypeReverseProc\fR) (
Tcl_Interp *interp,
+8 -22
View File
@@ -9,7 +9,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_CloseEx, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_TruncateChannel, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels
Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_TruncateChannel, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -46,9 +46,6 @@ int
int
\fBTcl_Close\fR(\fIinterp, channel\fR)
.sp
int
\fBTcl_CloseEx\fR(\fIinterp, channel, closeFlags\fR)
.sp
Tcl_Size
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
@@ -160,10 +157,6 @@ channel.
The number of characters to read from the channel. If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int closeFlags in
If \fB0\fR, the channel is closed in both directions. If \fBTCL_CLOSE_READ\fR,
the channel is only closed for reading. If \fBTCL_CLOSE_WRITE\fR, the channel
is only closed for writing. These flags must not be combined.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
Otherwise, the data will replace the existing contents of the value.
@@ -376,7 +369,7 @@ If so, it returns 1, otherwise 0.
.PP
No attempt is made to check whether the given channel or the standard
channels are initialized or otherwise valid.
.SH "TCL_CLOSE AND TCL_CLOSEEX"
.SH TCL_CLOSE
.PP
\fBTcl_Close\fR destroys the channel \fIchannel\fR, which must denote a
currently open channel. The channel should not be registered in any
@@ -390,23 +383,16 @@ immediately; output is flushed in the background and the channel will be
closed once all of the buffered data has been output. In this case errors
during flushing are not reported.
.PP
\fBTcl_CloseEx\fR allows for both full closing and half-closing of channels
depending on its \fBcloseFlags\fR parameter. See the description of the
parameter above. It is an error to attempt to close the channel for
a direction for which it is not open. The channel is destroyed only when
it has been closed for both reading and writing. Only socket and command
pipe channels support half-closing.
.PP
If the channel was closed successfully, \fBTcl_Close\fR and \fBTcl_CloseEx\fR
return \fBTCL_OK\fR. If an error occurs, they return \fBTCL_ERROR\fR and record
a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
If the channel was closed successfully, \fBTcl_Close\fR returns \fBTCL_OK\fR.
If an error occurs, \fBTcl_Close\fR returns \fBTCL_ERROR\fR and records a
POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
If the channel is being closed synchronously and an error occurs during
closing of the channel and \fIinterp\fR is not NULL, an error message is
left in the interpreter's result.
.PP
Note that it is not safe to call the channel closing functions on a channel
that has been registered using \fBTcl_RegisterChannel\fR; see the documentation
for \fBTcl_RegisterChannel\fR, above, for details. If the channel has ever
Note that it is not safe to call \fBTcl_Close\fR on a channel that has been
registered using \fBTcl_RegisterChannel\fR; see the documentation for
\fBTcl_RegisterChannel\fR, above, for details. If the channel has ever
been given as the \fBchan\fR argument in a call to
\fBTcl_RegisterChannel\fR, you should instead use
\fBTcl_UnregisterChannel\fR, which will internally call \fBTcl_Close\fR
+1 -1
View File
@@ -28,7 +28,7 @@ modified to hold number of arguments left in the unprocessed argument list
stored in \fIremObjv\fR.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
NULL for argument lists with more than INT_MAX elements (which should
trigger proper error-handling), otherwise expect it to crash.
.AP "Tcl_Obj *const" *objv in
+1 -1
View File
@@ -43,7 +43,7 @@ Pointer to a string with proper list structure.
Filled in with number of elements in \fIlist\fR.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will return
If your extensions is compiled with -DTCL_8_API, this function will return
TCL_ERROR for lists with more than INT_MAX elements (which should
trigger proper error-handling), otherwise expect it to crash.
.AP "const char" ***argvPtr out
+1 -1
View File
@@ -30,7 +30,7 @@ File path in a form appropriate for the current platform (see the
Filled in with number of path elements in \fIpath\fR.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, argcPtr will be filled
If your extensions is compiled with -DTCL_8_API, argcPtr will be filled
with -1 for paths with more than INT_MAX elements (which should
trigger proper error-handling), otherwise expect it to crash.
.AP "const char" ***argvPtr out
+2 -25
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_NewStringObj, Tcl_AttemptNewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_AttemptSetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_AttemptGetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj, Tcl_IsEmpty \- manipulate Tcl values as strings
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -17,17 +17,11 @@ Tcl_Obj *
\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
.sp
Tcl_Obj *
\fBTcl_AttemptNewStringObj\fR(\fIbytes, length\fR)
.sp
Tcl_Obj *
\fBTcl_NewUnicodeObj\fR(\fIunicode, numChars\fR)
.sp
void
\fBTcl_SetStringObj\fR(\fIobjPtr, bytes, length\fR)
.sp
char *
\fBTcl_AttemptSetStringObj\fR(\fIobjPtr, bytes, length\fR)
.sp
void
\fBTcl_SetUnicodeObj\fR(\fIobjPtr, unicode, numChars\fR)
.sp
@@ -49,9 +43,6 @@ int
Tcl_Size
\fBTcl_GetCharLength\fR(\fIobjPtr\fR)
.sp
Tcl_Size
\fBTcl_AttemptGetCharLength\fR(\fIobjPtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
.sp
@@ -90,9 +81,6 @@ int
.sp
Tcl_Obj *
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.sp
int
\fBTcl_IsEmpty\fR(\fIfIobjPtr\fR)
.fi
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
@@ -136,7 +124,7 @@ The location where \fBTcl_GetStringFromObj\fR will store the length
of a value's string representation.
May be (Tcl_Size *)NULL when not used. If it points to a variable which
type is not \fBTcl_Size\fR, a compiler warning will be generated.
If your extensions is compiled with \fB-DTCL_8_API\fR, this function will
If your extensions is compiled with -DTCL_8_API, this function will
panic for strings with more than INT_MAX bytes/characters, otherwise
expect it to crash.
.AP "const char" *string in
@@ -233,10 +221,6 @@ negative, then the returned string ends at the end of the value.
\fBTcl_GetCharLength\fR returns the number of characters (as opposed
to bytes) in the string value.
.PP
\fBTcl_AttemptGetCharLength\fR returns the number of characters
(as opposed to bytes) in the string value. It returns -1 if this
cannot be determined.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
\fIlength\fR to the string representation of the value specified by
\fIobjPtr\fR. If the value has an invalid string representation,
@@ -419,13 +403,6 @@ white space, then that value is ignored entirely. This white-space
removal was added to make the output of the \fBconcat\fR command
cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
newly-created value whose ref count is zero.
.PP
The \fBTcl_IsEmpty\fR function returns 1 if \fIobjPtr\fR is the empty
string, 0 otherwise.
It doesn't generate the string representation (unless there
is no other way to do it), so it can safely be called on lists with
billions of elements, or any other data structure for which
it is impossible or expensive to construct the string representation.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
\fBTcl_NewStringObj\fR, \fBTcl_NewUnicodeObj\fR, \fBTcl_Format\fR,
+1 -1
View File
@@ -34,7 +34,7 @@ Tcl_Obj *
Number of elements in \fIargv\fR.
.AP char *argv[] in
Array of strings containing command-line arguments. On Windows, when
using \fB\-DUNICODE\fR, the parameter type changes to wchar_t *.
using -DUNICODE, the parameter type changes to wchar_t *.
.AP char *charargv[] in
As argv, but does not change type to wchar_t.
.AP char *wideargv[] in
-66
View File
@@ -1,66 +0,0 @@
'\"
'\" Copyright (c) 2025 Ashok P. Nadkarni.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH unicode n "9.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
unicode \- Unicode character transforms
.SH SYNOPSIS
\fBunicode \fIfunction\fR ?\fIoptions\fR? \fIstring\fR
.BE
.SH DESCRIPTION
.PP
The command performs one of several Unicode character transformations, depending on
\fIfunction\fR which may take the values described below.
.\" METHOD: tonfc
.VS "TIP726"
.TP
\fBunicode tonfc\fR ?\fB-profile\fR \fIprofile\fR \fIstring\fR
.VE "TIP726"
.
Returns \fIstring\fR normalized as per Unicode \fBNormalization Form C\fR (NFC).
.PP
.\" METHOD: tonfd
.VS "TIP726"
.TP
\fBunicode tonfd\fR ?\fB-profile\fR \fIprofile\fR \fIstring\fR
.VE "TIP726"
.
Returns \fIstring\fR normalized as per Unicode \fBNormalization Form D\fR (NFD).
.PP
.\" METHOD: tonfkc
.VS "TIP726"
.TP
\fBunicode tonfkc\fR ?\fB-profile\fR \fIprofile\fR \fIstring\fR
.VE "TIP726"
.
Returns \fIstring\fR normalized as per Unicode \fBNormalization Form KC\fR (NFKC).
.PP
.\" METHOD: tonfkd
.VS "TIP726"
.TP
\fBunicode tonfkd\fR ?\fB-profile\fR \fIprofile\fR \fIstring\fR
.VE "TIP726"
.
Returns \fIstring\fR normalized as per Unicode \fBNormalization Form KD\fR (NFKD).
.PP
The normalization forms NFC, NFD, NFKC and NFKD referenced above are defined
in \fBSection 3.11\fR of the Unicode standard
(see https://www.unicode.org/versions/Unicode16.0.0/core-spec/chapter-3/).
.PP
The \fB-profile\fR option determines the command behavior in the presence
of conversion errors. The passed profile must be \fBstrict\fR or \fBreplace\fR.
See the \fBPROFILES\fR section in the documentation
of the \fBencoding\fR command for details on profiles.
.PP
.SH "SEE ALSO"
Tcl_UtfToNormalized(3)
.SH KEYWORDS
Unicode, normalize
.\" Local Variables:
.\" mode: nroff
.\" End:
-82
View File
@@ -1,82 +0,0 @@
'\"
'\" Copyright (c) 2025 Ashok P. Nadkarni
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_UtfToNormalized 3 "9.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_UtfToNormalized, Tcl_UtfToNormalizedDString \- procedures for Unicode normalization
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_UtfToNormalized\fR(\fIinterp, src, numBytes, normForm, profile, dst, dstLen, dstWrotePtr\fR)
.sp
int
\fBTcl_UtfToNormalizedDString\fR(\fIinterp, src, numBytes, normForm, profile, dstPtr\fR)
.fi
.SH ARGUMENTS
.AP Tcl_Interp *interp in
Interpreter to use for error reporting, or NULL if no error reporting is
desired.
.AP "const char" *src in
An array of bytes in Tcl's internal UTF-8 based encoding.
.AP Tcl_Size numBytes in
Length of \fIsrc\fR in bytes. If the length is negative,
the length includes all bytes until the first nul byte.
.AP char *dst out
Buffer in which the converted result will be stored. No more than
\fIdstLen\fR bytes will be stored in \fIdst\fR.
.AP Tcl_Size dstLen in
The size of the output buffer \fIdst\fR in bytes.
.AP Tcl_Size *dstWrotePtr out
Filled with the number of bytes in the normalized string. This number
does not include the terminating nul character.
May be NULL.
.AP Tcl_UnicodeNormalizationForm normForm in
Must be one of the \fBTcl_UnicodeNormalizationForm\fR members
\fBTCL_NFC\fR, \fBTCL_NFD\fR, \fBTCL_NFKC\fR or \fBTCL_NFKD\fR specifying
the Unicode normalization type.
.AP int profile in/out
The encoding profile as described in the \fBTcl_GetEncoding\fR documentation.
Must be either \fBTCL_ENCODING_PROFILE_STRICT\fR
or \fBTCL_ENCODING_PROFILE_REPLACE\fR.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result, which is also encoded in Tcl's internal UTF-8 encoding, will be stored.
The function initializes the storage and caller must call
\fBTcl_DStringFree\fR on success.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_UtfToNormalized\fR and \fBTcl_UtfToNormalizedDString\fR functions
transform the passed string into one of the standard normalization forms defined
in the Unicode standard. The normalization form is specified via the
\fInormForm\fR argument which must have one of the values \fBTCL_NFC\fR,
\fBTCL_NFD\fR, \fBTCL_NFKC\fR or \fBTCL_NFKD\fR corresponding to the Unicode
normalization forms \fBNormalization Form C\fR (NFC), \fBNormalization Form D\fR
(NFD), \fBNormalization Form KC\fR (NFKC) and \fBNormalization Form KD\fR (NFKD)
respectively. For details on the above normalization forms, refer to Section
3.11 of the Unicode standard
(https://www.unicode.org/versions/Unicode16.0.0/core-spec/chapter-3/).
.PP
The \fBTcl_UtfToNormalized\fR function stores the normalized result
in the buffer provided by the caller through the \fIdst\fR argument. The
result is nul terminated but the nul is not included in the count of
stored bytes returned in \fIdstWrotePtr\fR. The function returns TCL_OK
on success, TCL_CONVERT_NOSPACE if there is insufficient room in the output
buffer and TCL_ERROR in case of other failures. In the latter two cases,
an error message is stored in \fIinterp\fR if it is not NULL.
.PP
The \fBTcl_UtfToNormalizedDString\fR function stores the normalized result
in \fIdstPtr\fR which must eventually be freed by caller through
\fBTcl_DStringFree\fR. The function returns TCL_OK on success and
TCL_ERROR on failure with an error message in \fIinterp\fR if it is not NULL.
.SH "SEE ALSO"
unicode(n)
.SH KEYWORDS
utf, Unicode, normalize
-173
View File
@@ -1,173 +0,0 @@
'\"
'\" Copyright (c) 2025 Jan Nijtmans.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH build-info n 9.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
buildinfo \- Build info
.SH SYNOPSIS
\fB::tcl::build-info\fR ?\fIfield\fR?
.BE
.SH DESCRIPTION
.PP
This command provides a way to retrieve information about how Tcl was built.
Without any options, the command returns the Tcl patchlevel, followed
by the '+'-sign, followed by the fossil commit-id followed by a list of
dot-separated tags. If a \fIfield\fR is given, this command extracts that
field as described below. Any other \fIfield\fR value not mentioned
below will always return "0". For official Tcl releases, the \fIfield\fRs are:
.\" METHOD: clang
.TP
\fB::tcl::build-info clang\fR
.
Returns the clang version number (as 4 digits) if Tcl is compiled with clang, 0 otherwise.
.\" METHOD: commit
.TP
\fB::tcl::build-info commit\fR
.
Returns the fossil commit-id where Tcl was built from.
.\" METHOD: compiledebug
.TP
\fB::tcl::build-info compiledebug\fR
.
Returns 1 if Tcl is compiled with \fB\-DTCL_COMPILE_DEBUG\fR, 0 otherwise.
.\" METHOD: compiler
.TP
\fB::tcl::build-info compiler\fR
.
Returns the compiler name (either clang, gcc, icc or msvc), followed by a dash and a (4-digit) version number.
.\" METHOD: compilestats
.TP
\fB::tcl::build-info compilestats\fR
.
Returns 1 if Tcl is compiled with \fB\-DTCL_COMPILE_STATS\fR, 0 otherwise.
.\" METHOD: cplusplus
.TP
\fB::tcl::build-info cplusplus\fR
.
Returns 1 if Tcl is compiled with a C++ compiler, 0 otherwise.
.\" METHOD: debug
.TP
\fB::tcl::build-info debug\fR
.
Returns 1 if Tcl is not compiled with \fB\-DNDEBUG\fR, 0 otherwise.
.\" METHOD: gcc
.TP
\fB::tcl::build-info gcc\fR
.
Returns the gcc version number (as 4 digits) if Tcl is compiled with gcc, 0 otherwise.
.\" METHOD: icc
.TP
\fB::tcl::build-info icc\fR
.
Returns the icc version number (as 4 digits) if Tcl is compiled with icc, 0 otherwise.
.\" METHOD: ilp32
.TP
\fB::tcl::build-info ilp32\fR
.
Returns 1 if Tcl is compiled such that integers, longs and pointers are all 32-bit, 0 otherwise.
.\" METHOD: memdebug
.TP
\fB::tcl::build-info memdebug\fR
.
Returns 1 if Tcl is compiled with \fB\-DTCL_MEM_DEBUG\fR, 0 otherwise.
.\" METHOD: msvc
.TP
\fB::tcl::build-info msvc\fR
.
Returns the msvc version number (as 4 digits) if Tcl is compiled with msvc, 0 otherwise.
.\" METHOD: nmake
.TP
\fB::tcl::build-info nmake\fR
.
Returns 1 if Tcl is built using nmake, 0 otherwise.
.\" METHOD: no-deprecate
.TP
\fB::tcl::build-info no-deprecate\fR
.
Returns 1 if Tcl is compiled with \fB\-DTCL_NO_DEPRECATED\fR, 0 otherwise.
.\" METHOD: no-thread
.TP
\fB::tcl::build-info no-thread\fR
.
Returns 1 if Tcl is compiled with \fB\-DTCL_THREADS=0\fR, 0 otherwise.
.\" METHOD: no-optimize
.TP
\fB::tcl::build-info no-optimize\fR
.
Returns 1 if Tcl is not compiled with \fB\-DTCL_CFG_OPTIMIZED\fR, 0 otherwise.
.\" METHOD: objective-c
.TP
\fB::tcl::build-info objective-c\fR
.
Returns 1 if Tcl is compiled with an objective-c compiler, 0 otherwise.
.\" METHOD: objective-cplusplus
.TP
\fB::tcl::build-info objective-cplusplus\fR
.
Returns 1 if Tcl is compiled with an objective-c++ compiler, 0 otherwise.
.\" METHOD: patchlevel
.TP
\fB::tcl::build-info patchlevel\fR
.
Returns the Tcl patchlevel, same as \fBinfo patchlevel\fR.
.\" METHOD: profile
.TP
\fB::tcl::build-info profile\fR
.
Returns 1 if Tcl is compiled with \fB\-DTCL_CFG_PROFILED\fR, 0 otherwise.
.\" METHOD: purify
.TP
\fB::tcl::build-info purify\fR
.
Returns 1 if Tcl is compiled with \fB\-DPURIFY\fR, 0 otherwise.
.\" METHOD: static
.TP
\fB::tcl::build-info static\fR
.
Returns 1 if Tcl is compiled as a static library, 0 otherwise.
.\" METHOD: tommath
.TP
\fB::tcl::build-info tommath\fR
.
Returns the libtommath version number (as 4 digits) if libtommath is built into Tcl, 0 otherwise.
.\" METHOD: version
.TP
\fB::tcl::build-info version\fR
.
Returns the Tcl version, same as \fBinfo tclversion\fR.
.\" METHOD: zlib
.TP
\fB::tcl::build-info zlib\fR
.
Returns the zlib version number (as 4 digits) if zlib is built into Tcl, 0 otherwise.
.SH "EXAMPLES"
.PP
These show the use of \fB::tcl::build-info\fR.
.PP
.CS
\fB::tcl::build-info\fR
\fI\(-> 9.0.2+af16c07b81655fabde8028374161ad54b84ef9956843c63f49976b4ef601b611.gcc-1204\fR
\fB::tcl::build-info commit\fR
\fI\(-> af16c07b81655fabde8028374161ad54b84ef9956843c63f49976b4ef601b611\fR
\fB::tcl::build-info compiler\fR
\fI\(-> gcc-1204\fR
\fB::tcl::build-info gcc\fR
\fI\(-> 1204\fR
\fB::tcl::build-info version\fR
\fI\(-> 9.0\fR
\fB::tcl::build-info patchlevel\fR
\fI\(-> 9.0.2\fR
.CE
.SH "SEE ALSO"
info(n)
.SH "KEYWORDS"
build-info
'\" Local Variables:
'\" mode: nroff
'\" End:
-8
View File
@@ -104,14 +104,6 @@ Returns a list of the names of encoding profiles. See \fBPROFILES\fR below.
Set the system encoding to \fIencoding\fR. If \fIencoding\fR is
omitted then the command returns the current system encoding. The
system encoding is used whenever Tcl passes strings to system calls.
.TP
\fBencoding user\fR
.VS TIP716
Returns the name of encoding as per the user's preferences. On Windows
systems, this is based on the user's code page settings in the registry.
On other platforms, the returned value is the same as returned by
\fBencoding system\fR.
.VE TIP716
.\" Do not put .VS on whole section as that messes up the bullet list alignment
.SH PROFILES
.PP
-6
View File
@@ -31,12 +31,6 @@ If the initial arguments to \fBexec\fR start with \fB\-\fR then
they are treated as command-line switches and are not part
of the pipeline specification. The following switches are
currently supported:
.\" OPTION: -encoding
.TP 13
\fB\-encoding \fIencodingName\fR
.
Specifies the name of the encoding to use to decode the output of the first
subprocess. Defaults to that returned by the \fBencoding system\fR command.
.\" OPTION: -ignorestderr
.TP 13
\fB\-ignorestderr\fR
+1 -1
View File
@@ -109,7 +109,7 @@ oo::class create Ex {
}
set o [Ex new]
$o call 3 5 7
$o 3 5 7
\fI\(-> This is a\fR
\fI\(-> This is b(3)\fR
\fI\(-> This is c(5,7)\fR
+1 -5
View File
@@ -19,8 +19,7 @@ lseq \- Build a numeric sequence returned as a list
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values, which may
be either wide integers or doubles, using the given
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
is used to define a count of the number of elements in the list. A short form
@@ -43,9 +42,6 @@ empty list is returned. For example:
% \fBlseq\fR 5 to 1 ;# decreasing
\fI\(-> 5 4 3 2 1
% \fBlseq\fR 0 0.5 by 0.1 ;# doubles
\fI\(-> 0.0 0.1 0.2 0.3 0.4 0.5\fR
% \fBlseq\fR 6 to 1 by 2 ;# decreasing, step wrong sign, empty list
% \fBlseq\fR 1 to 5 by 0 ;# all step sizes of 0 produce an empty list
+1 -1
View File
@@ -13,7 +13,7 @@
registry \- Manipulate the Windows registry
.SH SYNOPSIS
.nf
\fBpackage require registry 1.4\fR
\fBpackage require registry 1.3\fR
\fBregistry \fR?\fI\-mode\fR? \fIoption keyName\fR ?\fIarg arg ...\fR?
.fi
+7 -10
View File
@@ -348,9 +348,8 @@ characters in the reverse order.
Returns a value equal to \fIstring\fR except that all upper (or title)
case letters have been converted to lower case. If \fIfirst\fR is
specified, it refers to the first char index in the string to start
modifying. If \fIlast\fR is not specified, only the character at position
\fIfirst\fR is converted, otherwise \fIlast\fR refers to the char index
in the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
modifying. If \fIlast\fR is specified, it refers to the char index in
the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
specified using the forms described in \fBSTRING INDICES\fR.
.\" METHOD: totitle
.TP
@@ -361,10 +360,9 @@ in \fIstring\fR is converted to its Unicode title case variant (or
upper case if there is no title case variant) and the rest of the
string is converted to lower case. If \fIfirst\fR is specified, it
refers to the first char index in the string to start modifying. If
\fIlast\fR is not specified, only the character at position \fIfirst\fR
is converted, otherwise \fIlast\fR refers to the char index in
the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
specified using the forms described in \fBSTRING INDICES\fR.
\fIlast\fR is specified, it refers to the char index in the string to
stop at (inclusive). \fIfirst\fR and \fIlast\fR may be specified
using the forms described in \fBSTRING INDICES\fR.
.\" METHOD: toupper
.TP
\fBstring toupper \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
@@ -372,9 +370,8 @@ specified using the forms described in \fBSTRING INDICES\fR.
Returns a value equal to \fIstring\fR except that all lower (or title)
case letters have been converted to upper case. If \fIfirst\fR is
specified, it refers to the first char index in the string to start
modifying. If \fIlast\fR is not specified, only the character at position
\fIfirst\fR is converted, otherwise \fIlast\fR refers to the char index
in the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
modifying. If \fIlast\fR is specified, it refers to the char index in
the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be
specified using the forms described in \fBSTRING INDICES\fR.
.\" METHOD: trim
.TP
-15
View File
@@ -13,10 +13,7 @@
.SH NAME
subst \- Perform backslash, command, and variable substitutions
.SH SYNOPSIS
.nf
\fBsubst \fR?\fB\-nobackslashes\fR? ?\fB\-nocommands\fR? ?\fB\-novariables\fR? \fIstring\fR
\fBsubst \fR?\fB\-backslashes\fR? ?\fB\-commands\fR? ?\fB\-variables\fR? \fIstring\fR
.fi
.BE
.SH DESCRIPTION
.PP
@@ -36,18 +33,6 @@ For example, if \fB\-nocommands\fR is specified, command substitution
is not performed: open and close brackets are treated as ordinary characters
with no special interpretation.
.PP
If any of the \fB\-backslashes\fR, \fB\-commands\fR, or
\fB\-variables\fR are specified, then only the corresponding
substitutions are performed. This means that the following lines are
equivalent:
.PP
.CS
\fBsubst\fR -nobackslashes -nocommands $string
\fBsubst\fR -variables $string
.CE
.PP
It is not allowed to combine positive and negated options.
.PP
Note that the substitution of one kind can include substitution of
other kinds. For example, even when the \fB\-novariables\fR option
is specified, command substitution is performed without restriction.
+3
View File
@@ -330,6 +330,9 @@ general operating environment of the machine.
.IP \fBpointerSize\fR
This gives the size of the native-machine pointer in bytes (strictly, it
is same as the result of evaluating \fIsizeof(void*)\fR in C.)
.IP \fBthreaded\fR
If this variable exists, then the interpreter
was compiled with threads enabled.
.IP \fBuser\fR
This identifies the
current user based on the login information available on the platform.
+1 -1
View File
@@ -412,7 +412,7 @@ newsub(
sco = cm->cd[co].sub;
if (sco == NOSUB) { /* color has no open subcolor */
if (cm->cd[co].nchrs == 1) { /* optimization */
return (color)co;
return co;
}
sco = newcolor(cm); /* must create subcolor */
if (sco == COLORLESS) {
+7 -7
View File
@@ -592,8 +592,8 @@ sortins(
{
struct arc **sortarray;
struct arc *a;
size_t n = s->nins;
size_t i;
int n = s->nins;
int i;
if (n <= 1) {
return; /* nothing to do */
@@ -668,8 +668,8 @@ sortouts(
{
struct arc **sortarray;
struct arc *a;
size_t n = s->nouts;
size_t i;
int n = s->nouts;
int i;
if (n <= 1) {
return; /* nothing to do */
@@ -1872,12 +1872,12 @@ fixempties(
struct state *nexts;
struct arc *a;
struct arc *nexta;
size_t totalinarcs;
int totalinarcs;
struct arc **inarcsorig;
struct arc **arcarray;
int arccount;
size_t prevnins;
size_t nskip;
int prevnins;
int nskip;
/*
* First, get rid of any states whose sole out-arc is an EMPTY,
+27 -27
View File
@@ -48,7 +48,7 @@ static void parseqatom(struct vars *, int, int, struct state *, struct state *,
static void nonword(struct vars *, int, struct state *, struct state *);
static void word(struct vars *, int, struct state *, struct state *);
static int scannum(struct vars *);
static void repeat(struct vars *, struct state *, struct state *, size_t, size_t);
static void repeat(struct vars *, struct state *, struct state *, int, int);
static void bracket(struct vars *, struct state *, struct state *);
static void cbracket(struct vars *, struct state *, struct state *);
static void brackpart(struct vars *, struct state *, struct state *);
@@ -64,8 +64,8 @@ static void markst(struct subre *);
static void cleanst(struct vars *);
static long nfatree(struct vars *, struct subre *, FILE *);
static long nfanode(struct vars *, struct subre *, FILE *);
static size_t newlacon(struct vars *, struct state *, struct state *, size_t);
static void freelacons(struct subre *, size_t);
static int newlacon(struct vars *, struct state *, struct state *, int);
static void freelacons(struct subre *, int);
static void rfree(regex_t *);
static void dump(regex_t *, FILE *);
static void dumpst(struct subre *, FILE *, int);
@@ -205,7 +205,7 @@ struct vars {
int cflags; /* copy of compile flags */
int lasttype; /* type of previous token */
int nexttype; /* type of next token */
chr nextvalue; /* value (if any) of next token */
size_t nextvalue; /* value (if any) of next token */
int lexcon; /* lexical context type (see lex.c) */
size_t nsubexp; /* subexpression count */
struct subre **subs; /* subRE pointer vector */
@@ -685,7 +685,7 @@ parse(
NOERRN();
branch->left = parsebranch(v, stopper, type, left, right, 0);
NOERRN();
branch->flags |= (char)(UP(branch->flags | branch->left->flags));
branch->flags |= UP(branch->flags | branch->left->flags);
if ((branch->flags &~ branches->flags) != 0) { /* new flags */
for (t = branches; t != branch; t = t->right) {
t->flags |= branch->flags;
@@ -788,12 +788,12 @@ parseqatom(
{
struct state *s; /* temporaries for new states */
struct state *s2;
#define ARCV(t, val) newarc(v->nfa, (t), (pcolor)(val), lp, rp)
size_t m, n;
#define ARCV(t, val) newarc(v->nfa, t, val, lp, rp)
int m, n;
struct subre *atom; /* atom's subtree */
struct subre *t;
size_t cap; /* capturing parens? */
size_t pos; /* positive lookahead? */
int cap; /* capturing parens? */
int pos; /* positive lookahead? */
size_t subno; /* capturing-parens or backref number */
int atomtype;
int qprefer; /* quantifier short/long preference */
@@ -990,7 +990,7 @@ parseqatom(
break;
case BACKREF: /* the Feature From The Black Lagoon */
INSIST(type != LACON, REG_ESUBREG);
INSIST((size_t)v->nextvalue < v->nsubs, REG_ESUBREG);
INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
NOERR();
assert(v->nextvalue > 0);
@@ -1094,7 +1094,7 @@ parseqatom(
if (atom != NULL) {
freesubre(v, atom);
}
top->flags = (char)f;
top->flags = f;
return;
}
@@ -1204,7 +1204,7 @@ parseqatom(
repeat(v, atom->begin, atom->end, m, n);
atom->min = (short) m;
atom->max = (short) n;
atom->flags |= (char)COMBINE(qprefer, atom->flags);
atom->flags |= COMBINE(qprefer, atom->flags);
/* rest of branch can be strung starting from atom->end */
s2 = atom->end;
} else if (m == 1 && n == 1) {
@@ -1268,8 +1268,8 @@ parseqatom(
}
NOERR();
assert(SEE('|') || SEE(stopper) || SEE(EOS));
t->flags |= (char)COMBINE(t->flags, t->right->flags);
top->flags |= (char)COMBINE(top->flags, t->flags);
t->flags |= COMBINE(t->flags, t->right->flags);
top->flags |= COMBINE(top->flags, t->flags);
}
/*
@@ -1346,13 +1346,13 @@ repeat(
struct vars *v,
struct state *lp,
struct state *rp,
size_t m,
size_t n)
int m,
int n)
{
#define SOME 2
#define INF 3
#define PAIR(x, y) ((x)*4 + (y))
#define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (int)(x)) )
#define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (x)) )
const int rm = REDUCE(m);
const int rn = REDUCE(n);
struct state *s, *s2;
@@ -1660,7 +1660,7 @@ dovec(
{
chr ch, from, to;
const chr *p;
size_t i;
int i;
for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
ch = *p;
@@ -1744,8 +1744,8 @@ sub_re(
assert(strchr("=b|.*(", op) != NULL);
ret->op = (char)op;
ret->flags = (char)flags;
ret->op = op;
ret->flags = flags;
ret->id = 0; /* will be assigned later */
ret->subno = 0;
ret->min = ret->max = 1;
@@ -1944,16 +1944,16 @@ nfanode(
/*
- newlacon - allocate a lookahead-constraint subRE
^ static size_t newlacon(struct vars *, struct state *, struct state *, size_t);
^ static int newlacon(struct vars *, struct state *, struct state *, int);
*/
static size_t /* lacon number */
static int /* lacon number */
newlacon(
struct vars *v,
struct state *begin,
struct state *end,
size_t pos)
int pos)
{
size_t n;
int n;
struct subre *newlacons;
struct subre *sub;
@@ -1988,10 +1988,10 @@ newlacon(
static void
freelacons(
struct subre *subs,
size_t n)
int n)
{
struct subre *sub;
size_t i;
int i;
assert(n > 0);
for (sub=subs+1, i=n-1; i>0; sub++, i--) { /* no 0th */
@@ -2135,7 +2135,7 @@ stdump(
fprintf(f, " UNUSED");
}
if (t->subno != 0) {
fprintf(f, " (#%" TCL_Z_MODIFIER "d)", t->subno);
fprintf(f, " (#%d)", t->subno);
}
if (t->min != 1 || t->max != 1) {
fprintf(f, " {%d,", t->min);
+3 -3
View File
@@ -414,14 +414,14 @@ freeDFA(
/*
- hash - construct a hash code for a bitvector
* There are probably better ways, but they're more expensive.
^ static unsigned hash(unsigned *, size_t);
^ static unsigned hash(unsigned *, int);
*/
static unsigned
hash(
unsigned *const uv,
size_t n)
int n)
{
size_t i;
int i;
unsigned h;
h = 0;
+5 -6
View File
@@ -145,7 +145,7 @@ static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *con
static chr *lastCold(struct vars *const, struct dfa *const);
static struct dfa *newDFA(struct vars *const, struct cnfa *const, struct colormap *const, struct smalldfa *);
static void freeDFA(struct dfa *const);
static unsigned hash(unsigned *const, size_t);
static unsigned hash(unsigned *const, int);
static struct sset *initialize(struct vars *const, struct dfa *const, chr *const);
static struct sset *miss(struct vars *const, struct dfa *const, struct sset *const, const pcolor, chr *const, chr *const);
static int checkLAConstraint(struct vars *const, struct cnfa *const, chr *const, const pcolor);
@@ -171,8 +171,8 @@ exec(
{
AllocVars(v);
int st, backref;
size_t n;
size_t i;
int n;
int i;
#define LOCALMAT 20
regmatch_t mat[LOCALMAT];
#define LOCALDFAS 40
@@ -592,7 +592,7 @@ subset(
chr *const begin,
chr *const end)
{
size_t n = sub->subno;
int n = sub->subno;
assert(n > 0);
if ((size_t)n >= v->nmatch) {
@@ -874,8 +874,7 @@ cbrdissect(
chr *begin, /* beginning of relevant substring */
chr *end) /* end of same */
{
size_t n = t->subno;
int min = t->min, max = t->max;
int n = t->subno, min = t->min, max = t->max;
size_t numreps;
size_t tlen;
size_t brlen;
+1 -1
View File
@@ -364,7 +364,7 @@ struct subre {
#define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
#define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2))
short id; /* ID of subre (1..ntree-1) */
size_t subno; /* subexpression number (for 'b' and '(') */
int subno; /* subexpression number (for 'b' and '(') */
short min; /* min repetitions for iteration or backref */
short max; /* max repetitions for iteration or backref */
struct subre *left; /* left child, if any (also freelist chain) */
+34 -82
View File
@@ -40,22 +40,22 @@ declare 2 {
TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
void *Tcl_Alloc(size_t size)
void *Tcl_Alloc(TCL_HASH_TYPE size)
}
declare 4 {
void Tcl_Free(void *ptr)
}
declare 5 {
void *Tcl_Realloc(void *ptr, size_t size)
void *Tcl_Realloc(void *ptr, TCL_HASH_TYPE size)
}
declare 6 {
void *Tcl_DbCkalloc(size_t size, const char *file, int line)
void *Tcl_DbCkalloc(TCL_HASH_TYPE size, const char *file, int line)
}
declare 7 {
void Tcl_DbCkfree(void *ptr, const char *file, int line)
}
declare 8 {
void *Tcl_DbCkrealloc(void *ptr, size_t size,
void *Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE size,
const char *file, int line)
}
@@ -104,9 +104,6 @@ declare 20 {
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
declare 22 {
char *Tcl_DbGetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr, const char *file, int line)
}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes,
Tcl_Size numBytes, const char *file, int line)
@@ -132,6 +129,17 @@ declare 29 {
declare 30 {
void TclFreeObj(Tcl_Obj *objPtr)
}
declare 31 {
int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *intPtr)
}
declare 32 {
int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *intPtr)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 33 {
unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, Tcl_Size *numBytesPtr)
}
declare 34 {
int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
@@ -196,9 +204,6 @@ declare 55 {
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, Tcl_Size length)
}
declare 57 {
Tcl_Obj *Tcl_AttemptNewStringObj(const char *bytes, Tcl_Size length)
}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, Tcl_Size numBytes)
}
@@ -209,9 +214,6 @@ declare 59 {
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
declare 61 {
Tcl_Size Tcl_AttemptGetCharLength(Tcl_Obj *objPtr)
}
declare 62 {
void Tcl_SetListObj(Tcl_Obj *objPtr, Tcl_Size objc, Tcl_Obj *const objv[])
}
@@ -257,6 +259,10 @@ declare 79 {
declare 80 {
void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 81 {
int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 {
int Tcl_CommandComplete(const char *cmd)
}
@@ -1048,13 +1054,7 @@ declare 339 {
Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
char *Tcl_AttemptGetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr)
}
declare 341 {
char *Tcl_AttemptSetStringObj(Tcl_Obj *objPtr, const char *bytes, Tcl_Size length)
}
declare 342 {
Tcl_Obj *Tcl_AttemptDuplicateObj(Tcl_Obj *objPtr)
char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 343 {
void Tcl_AlertNotifier(void *clientData)
@@ -1133,10 +1133,10 @@ declare 365 {
char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 366 {
int Tcl_Chdir(const char *dirName)
int Tcl_Chdir(const char *dirName)
}
declare 367 {
int Tcl_Access(const char *path, int mode)
int Tcl_Access(const char *path, int mode)
}
declare 368 {
int Tcl_Stat(const char *path, struct stat *bufPtr)
@@ -1217,7 +1217,7 @@ declare 392 {
}
declare 393 {
int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
void *clientData, size_t stackSize, int flags)
void *clientData, TCL_HASH_TYPE stackSize, int flags)
}
# Introduced in 8.3.2
@@ -1303,14 +1303,6 @@ declare 417 {
declare 418 {
int Tcl_IsChannelExisting(const char *channelName)
}
declare 421 {
Tcl_HashEntry *Tcl_DbCreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr, const char *file, int line)
}
declare 422 {
Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr)
}
declare 423 {
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
const Tcl_HashKeyType *typePtr)
@@ -1332,16 +1324,16 @@ declare 427 {
int flags, Tcl_CommandTraceProc *proc, void *clientData)
}
declare 428 {
void *Tcl_AttemptAlloc(size_t size)
void *Tcl_AttemptAlloc(TCL_HASH_TYPE size)
}
declare 429 {
void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line)
void *Tcl_AttemptDbCkalloc(TCL_HASH_TYPE size, const char *file, int line)
}
declare 430 {
void *Tcl_AttemptRealloc(void *ptr, size_t size)
void *Tcl_AttemptRealloc(void *ptr, TCL_HASH_TYPE size)
}
declare 431 {
void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
void *Tcl_AttemptDbCkrealloc(void *ptr, TCL_HASH_TYPE size,
const char *file, int line)
}
declare 432 {
@@ -1712,7 +1704,7 @@ declare 531 {
void Tcl_LimitTypeReset(Tcl_Interp *interp, int type)
}
declare 532 {
Tcl_Size Tcl_LimitGetCommands(Tcl_Interp *interp)
int Tcl_LimitGetCommands(Tcl_Interp *interp)
}
declare 533 {
void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
@@ -2104,12 +2096,12 @@ declare 626 {
# TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk
declare 627 {
int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *const symv[], int flags, void *procPtrs,
Tcl_LoadHandle *handlePtr)
const char *const symv[], int flags, void *procPtrs,
Tcl_LoadHandle *handlePtr)
}
declare 628 {
void *Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
const char *symbol)
const char *symbol)
}
declare 629 {
int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
@@ -2152,7 +2144,7 @@ declare 636 {
}
declare 637 {
char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
size_t numBytes)
TCL_HASH_TYPE numBytes)
}
declare 638 {
Tcl_ObjInternalRep *Tcl_FetchInternalRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr)
@@ -2354,7 +2346,7 @@ declare 682 {
# TIP 643
declare 683 {
Tcl_Size Tcl_GetEncodingNulLength(Tcl_Encoding encoding)
Tcl_Size Tcl_GetEncodingNulLength(Tcl_Encoding encoding)
}
# TIP #650
@@ -2383,49 +2375,9 @@ declare 689 {
void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue)
}
# ----- BASELINE -- FOR -- 9.0.0 ----- #
# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #
# TIP 711
declare 690 {
int Tcl_IsEmpty(Tcl_Obj *obj)
}
# TIP 716
declare 691 {
const char *Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr)
}
# TIP 649
declare 692 {
int Tcl_ListObjReverse(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj **resultPtrPtr)
}
declare 693 {
int Tcl_ListObjRepeat(Tcl_Interp *interp, Tcl_Size repeatCount,
Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Obj **resultPtrPtr)
}
declare 694 {
int Tcl_ListObjRange(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Size start, Tcl_Size end, Tcl_Obj **resultPtrPtr)
}
# TIP 726
declare 695 {
int Tcl_UtfToNormalizedDString(Tcl_Interp *interp,
const char *bytes, Tcl_Size length,
Tcl_UnicodeNormalizationForm normForm, int profile,
Tcl_DString *dsPtr)
}
declare 696 {
int Tcl_UtfToNormalized(Tcl_Interp *interp,
const char *bytes, Tcl_Size length,
Tcl_UnicodeNormalizationForm normForm, int profile,
char *bufPtr, Tcl_Size bufLen, Tcl_Size *lengthPtr)
}
# ----- BASELINE -- FOR -- 9.1.0 ----- #
declare 697 {
void TclUnusedStubEntry(void)
}
+139 -52
View File
@@ -49,15 +49,14 @@ extern "C" {
#if !defined(TCL_MAJOR_VERSION)
# define TCL_MAJOR_VERSION 9
#endif
#if TCL_MAJOR_VERSION != 9
# error "This header-file is for Tcl 9 only"
#endif
#define TCL_MINOR_VERSION 1
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL 1
#if TCL_MAJOR_VERSION == 9
# define TCL_MINOR_VERSION 0
# define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
# define TCL_RELEASE_SERIAL 2
#define TCL_VERSION "9.1"
#define TCL_PATCH_LEVEL "9.1a1"
# define TCL_VERSION "9.0"
# define TCL_PATCH_LEVEL "9.0.2"
#endif /* TCL_MAJOR_VERSION */
#if defined(RC_INVOKED)
/*
@@ -322,12 +321,30 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
typedef ptrdiff_t Tcl_Size;
#define TCL_SIZE_MAX ((Tcl_Size)(((size_t)-1)>>1))
#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#if TCL_MAJOR_VERSION < 9
# ifndef Tcl_Size
typedef int Tcl_Size;
# endif
# ifndef TCL_SIZE_MAX
# define TCL_SIZE_MAX ((int)(((unsigned int)-1)>>1))
# endif
# ifndef TCL_SIZE_MODIFIER
# define TCL_SIZE_MODIFIER ""
#endif
#else
typedef ptrdiff_t Tcl_Size;
# define TCL_SIZE_MAX ((Tcl_Size)(((size_t)-1)>>1))
# define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#endif /* TCL_MAJOR_VERSION */
#ifdef _WIN32
typedef struct __stat64 Tcl_StatBuf;
# if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
typedef struct __stat64 Tcl_StatBuf;
# elif defined(_USE_32BIT_TIME_T)
typedef struct _stati64 Tcl_StatBuf;
# else
typedef struct _stat32i64 Tcl_StatBuf;
# endif
#elif defined(__CYGWIN__)
typedef struct {
unsigned st_dev;
@@ -408,7 +425,7 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData);
* given to Tcl_CreateThread.
*/
#define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack. */
#define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack. */
#define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default
* behaviour. */
#define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable. */
@@ -452,18 +469,28 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData);
*/
typedef struct Tcl_RegExpIndices {
#if TCL_MAJOR_VERSION > 8
Tcl_Size start; /* Character offset of first character in
* match. */
Tcl_Size end; /* Character offset of first character after
* the match. */
#else
long start;
long end;
#endif
} Tcl_RegExpIndices;
typedef struct Tcl_RegExpInfo {
Tcl_Size nsubs; /* Number of subexpressions in the compiled
* expression. */
Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */
#if TCL_MAJOR_VERSION > 8
Tcl_Size extendStart; /* The offset at which a subsequent match
* might begin. */
#else
long extendStart;
long reserved; /* Reserved for later use. */
#endif
} Tcl_RegExpInfo;
/*
@@ -562,6 +589,7 @@ typedef void (Tcl_InterpDeleteProc) (void *clientData,
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
int objc, struct Tcl_Obj *const *objv);
#if TCL_MAJOR_VERSION > 8
typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
Tcl_Size objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
@@ -572,6 +600,11 @@ typedef void (Tcl_FreeProc) (void *blockPtr);
#define Tcl_FileFreeProc Tcl_FreeProc
#define Tcl_FileFreeProc Tcl_FreeProc
#define Tcl_EncodingFreeProc Tcl_FreeProc
#else
#define Tcl_ObjCmdProc2 Tcl_ObjCmdProc
#define Tcl_CmdObjTraceProc2 Tcl_CmdObjTraceProc
typedef void (Tcl_FreeProc) (char *blockPtr);
#endif
typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
@@ -640,6 +673,7 @@ typedef struct Tcl_ObjType {
/* Called to convert the object's internal rep
* to this type. Frees the internal rep of the
* old type. Returns TCL_ERROR on failure. */
#if TCL_MAJOR_VERSION > 8
size_t version; /* Version field for future-proofing. */
/* List emulation functions - ObjType Version 1 */
@@ -663,14 +697,21 @@ typedef struct Tcl_ObjType {
/* "in" and "ni" expr list operation.
* Determine if the given string value matches
* an element in the list. */
#endif
} Tcl_ObjType;
#define TCL_OBJTYPE_V0 0, \
0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
#define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
#define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \
a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
#if TCL_MAJOR_VERSION > 8
# define TCL_OBJTYPE_V0 0, \
0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
# define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
# define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \
a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
#else
# define TCL_OBJTYPE_V0 /* just empty */
# define TCL_OBJTYPE_V1(a) /* just empty */
# define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) /* just empty */
#endif
/*
* The following structure stores an internal representation (internalrep) for
@@ -679,7 +720,7 @@ typedef struct Tcl_ObjType {
* the handling of the internalrep.
*/
typedef union Tcl_ObjInternalRep {/* The internal representation: */
typedef union Tcl_ObjInternalRep { /* The internal representation: */
long longValue; /* - an long integer value. */
double doubleValue; /* - a double-precision floating value. */
void *otherValuePtr; /* - another, type-specific value, */
@@ -916,7 +957,11 @@ typedef struct Tcl_DString {
* TCL_COMBINE Combine surrogates
*/
#define TCL_COMBINE 0x1000000
#if TCL_MAJOR_VERSION > 8
# define TCL_COMBINE 0x1000000
#else
# define TCL_COMBINE 0
#endif
/*
*----------------------------------------------------------------------------
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
@@ -1020,15 +1065,19 @@ typedef struct Tcl_DString {
* Forward declarations of Tcl_HashTable and related types.
*/
#if !defined(TCL_HASH_TYPE) && !defined (TCL_NO_DEPRECATED)
# define TCL_HASH_TYPE size_t
#ifndef TCL_HASH_TYPE
#if TCL_MAJOR_VERSION > 8
# define TCL_HASH_TYPE size_t
#else
# define TCL_HASH_TYPE unsigned
#endif
#endif
typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;
typedef size_t (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
void *keyPtr);
@@ -1146,20 +1195,21 @@ struct Tcl_HashTable {
* table. */
Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
#if TCL_MAJOR_VERSION > 8
size_t mask; /* Mask value used in hashing function. */
#endif
int downShift; /* Shift count used in hashing function.
* Designed to use high-order bits of
* randomized keys. */
#if TCL_MAJOR_VERSION < 9
int mask; /* Mask value used in hashing function. */
#endif
int keyType; /* Type of keys used in this table. It's
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
* TCL_ONE_WORD_KEYS, or an integer giving the
* number of ints that is the size of the
* key. */
#ifndef TCL_NO_DEPRECATED
Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
#else
void *unUsed;
#endif
Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
int *newPtr);
const Tcl_HashKeyType *typePtr;
@@ -1215,7 +1265,7 @@ typedef struct Tcl_HashSearch {
typedef struct {
void *next; /* Search position for underlying hash
* table. */
size_t epoch; /* Epoch marker for dictionary being searched,
TCL_HASH_TYPE epoch; /* Epoch marker for dictionary being searched,
* or 0 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
} Tcl_DictSearch;
@@ -1271,8 +1321,12 @@ typedef enum {
*/
typedef struct Tcl_Time {
#if TCL_MAJOR_VERSION > 8
long long sec; /* Seconds. */
#if defined(_CYGWIN_)
#else
long sec; /* Seconds. */
#endif
#if defined(_CYGWIN_) && TCL_MAJOR_VERSION > 8
int usec; /* Microseconds. */
#else
long usec; /* Microseconds. */
@@ -1323,7 +1377,11 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
* interface.
*/
#define TCL_CLOSE2PROC NULL
#if TCL_MAJOR_VERSION > 8
# define TCL_CLOSE2PROC NULL
#else
# define TCL_CLOSE2PROC ((void *) 1)
#endif
/*
* Channel version tag. This was introduced in 8.3.2/8.4.
@@ -1871,10 +1929,12 @@ typedef struct Tcl_Parse {
* *tokenPtr. */
int errorType; /* One of the parsing error types defined
* above. */
#if TCL_MAJOR_VERSION > 8
int incomplete; /* This field is set to 1 by Tcl_ParseCommand
* if the command appears to be incomplete.
* This information is used by
* Tcl_CommandComplete. */
#endif
/*
* The fields below are intended only for the private use of the parser.
@@ -1893,6 +1953,9 @@ typedef struct Tcl_Parse {
* beginning of region where the error
* occurred (e.g. the open brace if the close
* brace is missing). */
#if TCL_MAJOR_VERSION < 9
int incomplete;
#endif
Tcl_Token staticTokens[NUM_STATIC_TOKENS];
/* Initial space for tokens for command. This
* space should be large enough to accommodate
@@ -1973,7 +2036,11 @@ typedef struct Tcl_EncodingType {
#define TCL_ENCODING_START 0x01
#define TCL_ENCODING_END 0x02
#define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */
#if TCL_MAJOR_VERSION > 8
# define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */
#else
# define TCL_ENCODING_STOPONERROR 0x04
#endif
#define TCL_ENCODING_NO_TERMINATE 0x08
#define TCL_ENCODING_CHAR_LIMIT 0x10
/* Internal use bits, do not define bits in this space. See above comment */
@@ -1983,7 +2050,7 @@ typedef struct Tcl_EncodingType {
* changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
* necessary.
*/
#define TCL_ENCODING_PROFILE_STRICT 0x00000000
#define TCL_ENCODING_PROFILE_STRICT TCL_ENCODING_STOPONERROR
#define TCL_ENCODING_PROFILE_TCL8 0x01000000
#define TCL_ENCODING_PROFILE_REPLACE 0x02000000
@@ -2026,7 +2093,11 @@ typedef struct Tcl_EncodingType {
*/
#ifndef TCL_UTF_MAX
# define TCL_UTF_MAX 4
# if defined(BUILD_tcl) || TCL_MAJOR_VERSION > 8
# define TCL_UTF_MAX 4
# else
# define TCL_UTF_MAX 3
# endif
#endif
/*
@@ -2046,13 +2117,6 @@ typedef unsigned short Tcl_UniChar;
#else
# error "This TCL_UTF_MAX value is not supported"
#endif
/*
* Specifiers for Unicode normalization forms.
*/
typedef enum {
TCL_NFC, TCL_NFD, TCL_NFKC, TCL_NFKD
} Tcl_UnicodeNormalizationForm;
/*
*----------------------------------------------------------------------------
@@ -2082,7 +2146,11 @@ typedef struct Tcl_Config {
*/
typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp);
#if TCL_MAJOR_VERSION > 8
#define Tcl_LimitHandlerDeleteProc Tcl_FreeProc
#else
typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData);
#endif
#if 0
/*
@@ -2239,7 +2307,11 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
* stubs tables.
*/
#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
#if TCL_MAJOR_VERSION > 8
# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
#else
# define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
#endif
/*
* The following function is required to be defined in all stubs aware
@@ -2261,15 +2333,35 @@ void * TclStubCall(void *arg);
#endif
#ifdef USE_TCL_STUBS
#if TCL_MAJOR_VERSION < 9
# if TCL_UTF_MAX < 4
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
TCL_STUB_MAGIC)
# else
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, "8.7b1", \
(exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
TCL_STUB_MAGIC)
# endif
#else
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
TCL_STUB_MAGIC)
#endif
#else
#if TCL_MAJOR_VERSION < 9
# define Tcl_InitStubs(interp, version, exact) \
Tcl_Panic(((void)interp, (void)version, \
(void)exact, "Please define -DUSE_TCL_STUBS"))
#else
# define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#endif
#endif
/*
* Public functions that are not accessible via the stubs table.
@@ -2309,7 +2401,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS)
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#define Tcl_SetPanicProc(panicProc) \
TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
#define Tcl_InitSubsystems() \
@@ -2420,12 +2512,12 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
static inline void
TclBounceRefCount(
Tcl_Obj* objPtr,
const char* file,
const char* fn,
int line)
{
if (objPtr) {
if ((objPtr)->refCount == 0) {
Tcl_DbDecrRefCount(objPtr, file, line);
Tcl_DbDecrRefCount(objPtr, fn, line);
}
}
}
@@ -2521,14 +2613,9 @@ TclBounceRefCount(
*/
#define Tcl_FindHashEntry(tablePtr, key) \
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), (int *)-1)
#define Tcl_AttemptCreateHashEntry(tablePtr, key, newPtr) \
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
#ifdef TCL_MEM_DEBUG
#undef Tcl_CreateHashEntry
(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
Tcl_DbCreateHashEntry(tablePtr, key, newPtr, __FILE__, __LINE__)
#endif
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
#endif /* RC_INVOKED */
+90 -135
View File
@@ -168,7 +168,7 @@ ArithSeriesEndDbl(
if (!dblRepPtr->base.len) {
return dblRepPtr->start;
}
d = dblRepPtr->start + ((double)(dblRepPtr->base.len-1) * dblRepPtr->step);
d = dblRepPtr->start + ((dblRepPtr->base.len-1) * dblRepPtr->step);
return ArithRound(d, dblRepPtr->precision);
}
@@ -191,7 +191,7 @@ ArithSeriesIndexDbl(
assert(arithSeriesRepPtr->isDouble);
double d = dblRepPtr->start;
if (index) {
d += ((double)index * dblRepPtr->step);
d += (index * dblRepPtr->step);
}
return ArithRound(d, dblRepPtr->precision);
@@ -217,7 +217,7 @@ ArithSeriesGetInternalRep(
}
/*
* Compute number of significant fractional digits.
* Compute number of significant fractional digits
*/
static inline unsigned
ObjPrecision(
@@ -227,13 +227,15 @@ ObjPrecision(
int type;
if (TclHasInternalRep(numObj, &tclDoubleType) || (
Tcl_GetNumberFromObj(NULL, numObj, &ptr, &type) == TCL_OK
&& type == TCL_NUMBER_DOUBLE)) {
Tcl_GetNumberFromObj(NULL, numObj, &ptr, &type) == TCL_OK &&
type == TCL_NUMBER_DOUBLE
)
) { /* TCL_NUMBER_DOUBLE */
const char *str = TclGetString(numObj);
if (strchr(str, 'e') == NULL && strchr(str, 'E') == NULL) {
str = strchr(str, '.');
return (str ? (unsigned)strlen(str + 1) : 0);
return (str ? strlen(str + 1) : 0);
}
/* don't calculate precision for e-notation */
}
@@ -274,13 +276,15 @@ maxObjPrecision(
*
* ArithSeriesLen --
*
* Compute the length of the equivalent list where every element is
* generated starting from *start*, and adding *step* to generate every
* successive element that's < *end* for positive steps, or > *end* for
* negative steps.
* Compute the length of the equivalent list where
* every element is generated starting from *start*,
* and adding *step* to generate every successive element
* that's < *end* for positive steps, or > *end* for negative
* steps.
*
* Results:
* The length of the list generated by the given range, that may be zero.
* The length of the list generated by the given range,
* that may be zero.
* The function returns -1 if the list is of length infinite.
*
* Side effects:
@@ -334,8 +338,10 @@ ArithSeriesLenDbl(
* To improve numerical stability use wide arithmetic instead of IEEE-754
* when distance and step do not exceed wide-integers.
*/
if (((double)WIDE_MIN <= end && end <= (double)WIDE_MAX) &&
((double)WIDE_MIN <= step && step <= (double)WIDE_MAX)) {
if (
((double)WIDE_MIN <= end && end <= (double)WIDE_MAX) &&
((double)WIDE_MIN <= step && step <= (double)WIDE_MAX)
) {
Tcl_WideInt iend = end < 0 ? end - 0.5 : end + 0.5;
Tcl_WideInt istep = step < 0 ? step - 0.5 : step + 0.5;
if (istep) { /* avoid div by zero, steps like 0.1, precision 0 */
@@ -453,61 +459,21 @@ static Tcl_Obj *
NewArithSeriesInt(
Tcl_WideInt start,
Tcl_WideInt step,
Tcl_WideInt length)
Tcl_WideInt len)
{
Tcl_Obj *arithSeriesObj = NULL;
Tcl_WideInt length;
Tcl_Obj *arithSeriesObj;
ArithSeriesInt *arithSeriesRepPtr;
length = len>=0 ? len : -1;
if (length < 0) {
length = -1;
}
TclNewObj(arithSeriesObj);
if (length <= 0) {
/* TODO - should negative lengths be an error? */
return arithSeriesObj;
} else if (length > 1) {
/* Check for numeric overflow. Not needed for single element lists */
Tcl_WideUInt absoluteStep;
Tcl_WideInt numIntervals = length - 1;
/*
* The checks below can probably be condensed but it is very easy to
* either inadvertently use undefined C behavior or unintended type
* promotion. Separating the cases helps me think more clearly.
*/
if (step >= 0) {
absoluteStep = step;
} else if (step == WIDE_MIN) {
/* -step and abs(step) are both undefined behavior */
absoluteStep = 1 + (Tcl_WideUInt)WIDE_MAX;
} else {
absoluteStep = -step;
}
/* First, step*number of intervals should not overflow */
if ((UWIDE_MAX / absoluteStep) < (Tcl_WideUInt) numIntervals) {
goto invalidRange;
}
if (step > 0) {
/*
* Because of check above and UWIDE_MAX=2*WIDE_MAX+1,
* second term will not underflow a Tcl_WideInt
*/
if (start > (WIDE_MAX - (step * numIntervals))) {
goto invalidRange;
}
} else if (step == WIDE_MIN) {
if (numIntervals > 0 || start < 0) {
goto invalidRange;
}
} else if (step < 0) {
/*
* Because of check above and UWIDE_MAX=2*WIDE_MAX+1 and
* step != WIDE_MIN second term will not underflow a Tcl_WideInt.
* DON'T use absoluteStep here because of unsigned type promotion
*/
if (start < (WIDE_MIN + ((-step) * numIntervals))) {
goto invalidRange;
}
} else /* step == 0 */ {
/* TODO - step == 0 && length > 1 should be error? */
}
}
arithSeriesRepPtr = (ArithSeriesInt *) Tcl_Alloc(sizeof(ArithSeriesInt));
@@ -520,13 +486,11 @@ NewArithSeriesInt(
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
arithSeriesObj->typePtr = &arithSeriesType;
Tcl_InvalidateStringRep(arithSeriesObj);
if (length > 0) {
Tcl_InvalidateStringRep(arithSeriesObj);
}
return arithSeriesObj;
invalidRange:
Tcl_BounceRefCount(arithSeriesObj);
return NULL;
}
/*
@@ -543,7 +507,6 @@ NewArithSeriesInt(
*
* Side Effects:
* None.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
@@ -601,7 +564,6 @@ NewArithSeriesDbl(
*
* Side Effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
@@ -663,26 +625,23 @@ assignNumber(
*
* Side Effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclNewArithSeriesObj(
Tcl_Interp *interp, /* For error reporting */
int useDoubles, /* Flag indicates values start,
* end, step, are treated as doubles */
Tcl_Obj *startObj, /* Starting value */
Tcl_Obj *endObj, /* Ending limit */
Tcl_Obj *stepObj, /* increment value */
Tcl_Obj *lenObj) /* Number of elements */
Tcl_Interp *interp, /* For error reporting */
int useDoubles, /* Flag indicates values start,
** end, step, are treated as doubles */
Tcl_Obj *startObj, /* Starting value */
Tcl_Obj *endObj, /* Ending limit */
Tcl_Obj *stepObj, /* increment value */
Tcl_Obj *lenObj) /* Number of elements */
{
double dstart, dend, dstep = 1.0;
Tcl_WideInt start, end, step = 1;
Tcl_WideInt len = -1;
Tcl_Obj *objPtr;
unsigned precision = (unsigned)-1; /* unknown precision */
const char *description;
char tmp[TCL_DOUBLE_SPACE + 2] = {0};
if (startObj) {
if (assignNumber(interp, useDoubles, &start, &dstart, startObj) != TCL_OK) {
@@ -701,11 +660,15 @@ TclNewArithSeriesObj(
return objPtr;
}
}
if (endObj && assignNumber(interp, useDoubles, &end, &dend, endObj) != TCL_OK) {
return NULL;
if (endObj) {
if (assignNumber(interp, useDoubles, &end, &dend, endObj) != TCL_OK) {
return NULL;
}
}
if (lenObj && Tcl_GetWideIntFromObj(interp, lenObj, &len) != TCL_OK) {
return NULL;
if (lenObj) {
if (Tcl_GetWideIntFromObj(interp, lenObj, &len) != TCL_OK) {
return NULL;
}
}
if (endObj) {
@@ -722,13 +685,24 @@ TclNewArithSeriesObj(
}
}
}
assert(dstep != 0);
assert(dstep!=0);
if (!lenObj) {
if (useDoubles) {
if (isinf(dstart) || isinf(dend)) {
goto exceeded;
} else if (isnan(dstart) || isnan(dend)) {
goto notANumber;
}
if (isnan(dstart) || isnan(dend)) {
const char *description = "non-numeric floating-point value";
char tmp[TCL_DOUBLE_SPACE + 2];
tmp[0] = '\0';
Tcl_PrintDouble(NULL, isnan(dstart)?dstart:dend, tmp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot use %s \"%s\" to estimate length of arith-series",
description, tmp));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description,
(char *)NULL);
return NULL;
}
precision = maxObjPrecision(startObj, endObj, stepObj);
len = ArithSeriesLenDbl(dstart, dend, dstep, precision);
@@ -736,32 +710,43 @@ TclNewArithSeriesObj(
len = ArithSeriesLenInt(start, end, step);
}
}
} else if (useDoubles) {
// Compute precision based on given command argument values
precision = maxObjPrecision(startObj, NULL, stepObj);
} else {
if (useDoubles) {
// Compute precision based on given command argument values
precision = maxObjPrecision(startObj, NULL, stepObj);
dend = dstart + (dstep * (double)(len-1));
// Make computed end value match argument(s) precision
dend = ArithRound(dend, precision);
end = dend;
dend = dstart + (dstep * (len-1));
// Make computed end value match argument(s) precision
dend = ArithRound(dend, precision);
end = dend;
} else {
end = start + (step * (len - 1));
dend = end;
}
}
/*
* todo: check whether the boundary must be rather LIST_MAX, to be more
* similar to plain lists, otherwise it'd generate an error or panic later
* similar to plain lists, otherwise it'd generare an error or panic later
* (0x0ffffffffffffffa instead of 0x7fffffffffffffff by 64bit)
*/
if (len > TCL_SIZE_MAX) {
goto exceeded;
exceeded:
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"max length of a Tcl list exceeded", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
return NULL;
}
if (useDoubles) {
/* ensure we'll not get NaN somewhere in the arith-series,
* so simply check the end of it and behave like [expr {Inf - Inf}] */
double d = dstart + (double)(len - 1) * dstep;
double d = dstart + (len - 1) * dstep;
if (isnan(d)) {
description = "domain error: argument not in valid range";
goto domain;
const char *s = "domain error: argument not in valid range";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *)NULL);
return NULL;
}
if (precision == (unsigned)-1) {
@@ -773,31 +758,7 @@ TclNewArithSeriesObj(
objPtr = NewArithSeriesInt(start, step, len);
}
if (objPtr == NULL && interp) {
description = "invalid arithmetic series parameter values";
goto domain;
}
return objPtr;
exceeded:
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"max length of a Tcl list exceeded", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
return NULL;
domain:
Tcl_SetObjResult(interp, Tcl_NewStringObj(description, TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
return NULL;
notANumber:
description = "non-numeric floating-point value";
Tcl_PrintDouble(NULL, isnan(dstart) ? dstart : dend, tmp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot use %s \"%s\" to estimate length of arith-series",
description, tmp));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
return NULL;
}
/*
@@ -915,11 +876,11 @@ SetArithSeriesFromAny(
int
TclArithSeriesObjRange(
Tcl_Interp *interp, /* For error message(s) */
Tcl_Interp *interp, /* For error message(s) */
Tcl_Obj *arithSeriesObj, /* List object to take a range from. */
Tcl_Size fromIdx, /* Index of first element to include. */
Tcl_Size toIdx, /* Index of last element to include. */
Tcl_Obj **newObjPtr) /* return value */
Tcl_Obj **newObjPtr) /* return value */
{
ArithSeries *arithSeriesRepPtr;
Tcl_WideInt len;
@@ -1105,7 +1066,7 @@ TclArithSeriesGetElements(
*/
int
TclArithSeriesObjReverse(
Tcl_Interp *interp, /* For error message(s) */
Tcl_Interp *interp, /* For error message(s) */
Tcl_Obj *arithSeriesObj, /* List object to reverse. */
Tcl_Obj **newObjPtr)
{
@@ -1217,7 +1178,9 @@ UpdateStringOfArithSeries(
Tcl_PrintDouble(NULL,d,tmp);
elen = strlen(tmp);
if (bytlen > TCL_SIZE_MAX - elen) {
goto repTooLarge;
/* overflow, todo: check we could use some representation instead of the panic
* to signal it is too large for string representation, because too heavy */
Tcl_Panic("UpdateStringOfArithSeries: too large to represent");
}
bytlen += elen;
}
@@ -1228,16 +1191,8 @@ UpdateStringOfArithSeries(
* Pass 2: generate the string repr.
*/
p = srep = TclAttemptInitStringRep(arithSeriesObjPtr, NULL, bytlen);
if (!p) {
repTooLarge:
if (arithSeriesObjPtr->bytes) {
Tcl_Free(arithSeriesObjPtr->bytes);
arithSeriesObjPtr->bytes = 0;
}
arithSeriesObjPtr->length = bytlen;
return;
}
p = srep = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen);
TclOOM(p, bytlen+1);
if (!arithSeriesRepPtr->isDouble) {
for (i = 0; i < arithSeriesRepPtr->len; i++) {
+554 -555
View File
File diff suppressed because it is too large Load Diff
+8 -7
View File
@@ -30,7 +30,7 @@ typedef struct AsyncHandler {
* for the process. */
Tcl_AsyncProc *proc; /* Procedure to call when handler is
* invoked. */
void *clientData; /* Value to pass to handler when it is
void *clientData; /* Value to pass to handler when it is
* invoked. */
struct ThreadSpecificData *originTsd;
/* Used in Tcl_AsyncMark to modify thread-
@@ -38,7 +38,7 @@ typedef struct AsyncHandler {
* associated to. */
Tcl_ThreadId originThrdId; /* Origin thread where this token was created
* and where it will be yielded. */
void *notifierData; /* Platform notifier data or NULL. */
void *notifierData; /* Platform notifier data or NULL. */
} AsyncHandler;
typedef struct ThreadSpecificData {
@@ -142,7 +142,7 @@ Tcl_AsyncHandler
Tcl_AsyncCreate(
Tcl_AsyncProc *proc, /* Procedure to call when handler is
* invoked. */
void *clientData) /* Argument to pass to handler. */
void *clientData) /* Argument to pass to handler. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -190,7 +190,7 @@ Tcl_AsyncCreate(
void
Tcl_AsyncMark(
Tcl_AsyncHandler async) /* Token for handler. */
Tcl_AsyncHandler async) /* Token for handler. */
{
AsyncHandler *token = (AsyncHandler *) async;
@@ -201,6 +201,7 @@ Tcl_AsyncMark(
Tcl_ThreadAlert(token->originThrdId);
}
Tcl_MutexUnlock(&asyncMutex);
}
/*
@@ -223,8 +224,8 @@ Tcl_AsyncMark(
int
Tcl_AsyncMarkFromSignal(
Tcl_AsyncHandler async, /* Token for handler. */
int sigNumber) /* Signal number. */
Tcl_AsyncHandler async, /* Token for handler. */
int sigNumber) /* Signal number. */
{
#if TCL_THREADS
AsyncHandler *token = (AsyncHandler *) async;
@@ -377,7 +378,7 @@ Tcl_AsyncInvoke(
void
Tcl_AsyncDelete(
Tcl_AsyncHandler async) /* Token for handler to delete. */
Tcl_AsyncHandler async) /* Token for handler to delete. */
{
AsyncHandler *asyncPtr = (AsyncHandler *) async;
+98 -96
View File
@@ -207,8 +207,8 @@ static Tcl_ObjCmdProc ExprSrandFunc;
static Tcl_ObjCmdProc ExprUnaryFunc;
static Tcl_ObjCmdProc ExprWideFunc;
static Tcl_ObjCmdProc FloatClassifyObjCmd;
static void MathFuncWrongNumArgs(Tcl_Interp *interp, Tcl_Size expected,
Tcl_Size actual, Tcl_Obj *const *objv);
static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
@@ -237,6 +237,7 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces;
static Tcl_NRPostProc EvalObjvCore;
static Tcl_NRPostProc Dispatch;
static Tcl_NRPostProc NRPostInvoke;
static Tcl_ObjCmdProc CoroTypeObjCmd;
static Tcl_ObjCmdProc TclNRCoroInjectObjCmd;
static Tcl_ObjCmdProc TclNRCoroProbeObjCmd;
@@ -249,10 +250,12 @@ MODULE_SCOPE const TclStubs tclStubs;
* Magical counts for the number of arguments accepted by a coroutine command
* after particular kinds of [yield].
*/
enum CoroutineArgumentTypes {
COROUTINE_ARGUMENTS_SINGLE_OPTIONAL = -1,
COROUTINE_ARGUMENTS_ARBITRARY = -2
};
#define CORO_ACTIVATE_YIELD NULL
#define CORO_ACTIVATE_YIELDM INT2PTR(1)
#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1)
#define COROUTINE_ARGUMENTS_ARBITRARY (-2)
/*
* The following structure define the commands in the Tcl core.
@@ -296,7 +299,7 @@ typedef struct {
*/
static int
ProcObjCmd(
procObjCmd(
void *clientData,
Tcl_Interp *interp,
int objc,
@@ -307,7 +310,7 @@ ProcObjCmd(
static const CmdInfo builtInCmds[] = {
/*
* Commands in the generic core. All are safe.
* Commands in the generic core.
*/
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
@@ -331,26 +334,26 @@ static const CmdInfo builtInCmds[] = {
{"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE},
{"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE},
{"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE},
{"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE},
{"ledit", Tcl_LeditObjCmd, TclCompileLeditCmd, NULL, CMD_IS_SAFE},
{"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE},
{"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE},
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE},
{"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
{"lpop", Tcl_LpopObjCmd, TclCompileLpopCmd, NULL, CMD_IS_SAFE},
{"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE},
{"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
{"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lseq", Tcl_LseqObjCmd, TclCompileLseqCmd, NULL, CMD_IS_SAFE},
{"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
{"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE},
{"proc", ProcObjCmd, NULL, NULL, CMD_IS_SAFE},
{"proc", procObjCmd, NULL, NULL, CMD_IS_SAFE},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE},
{"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE},
{"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE},
@@ -360,17 +363,17 @@ static const CmdInfo builtInCmds[] = {
{"split", Tcl_SplitObjCmd, NULL, NULL, CMD_IS_SAFE},
{"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, CMD_IS_SAFE},
{"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, CMD_IS_SAFE},
{"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, CMD_IS_SAFE},
{"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, CMD_IS_SAFE},
{"trace", Tcl_TraceObjCmd, NULL, NULL, CMD_IS_SAFE},
{"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, CMD_IS_SAFE},
{"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, CMD_IS_SAFE},
{"uplevel", Tcl_UplevelObjCmd, TclCompileUplevelCmd, TclNRUplevelObjCmd, CMD_IS_SAFE},
{"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, CMD_IS_SAFE},
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, CMD_IS_SAFE},
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
{"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
{"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
/*
* Commands in the OS-interface. Note that many of these are unsafe.
@@ -647,7 +650,7 @@ TclFinalizeEvaluation(void)
/*
*----------------------------------------------------------------------
*
* BuildInfoObjCmd --
* buildInfoObjCmd --
*
* Implements tcl::build-info command.
*
@@ -661,7 +664,7 @@ TclFinalizeEvaluation(void)
*/
static int
BuildInfoObjCmd2(
buildInfoObjCmd2(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
@@ -728,8 +731,7 @@ BuildInfoObjCmd2(
}
return TCL_OK;
case ID_COMPILER:
for (p = strchr(buildData, '.'); p != NULL; p = strchr(p, '.')) {
p++;
for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) {
/*
* Does the word begin with one of the standard prefixes?
*/
@@ -750,8 +752,7 @@ BuildInfoObjCmd2(
break;
default: /* Boolean test for other identifiers' presence */
arg = TclGetStringFromObj(objv[1], &len);
for (p = strchr(buildData, '.'); p != NULL; p = strchr(p, '.')) {
p++;
for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) {
if (!strncmp(p, arg, len)
&& ((p[len] == '.') || (p[len] == '-') || (p[len] == '\0'))) {
if (p[len] == '-') {
@@ -775,13 +776,13 @@ BuildInfoObjCmd2(
}
static int
BuildInfoObjCmd(
buildInfoObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return BuildInfoObjCmd2(clientData, interp, objc, objv);
return buildInfoObjCmd2(clientData, interp, objc, objv);
}
/*
@@ -1162,7 +1163,6 @@ Tcl_CreateInterp(void)
TclInitInfoCmd(interp);
TclInitNamespaceCmd(interp);
TclInitStringCmd(interp);
TclInitUnicodeCmd(interp);
TclInitPrefixCmd(interp);
TclInitProcessCmd(interp);
@@ -1325,9 +1325,9 @@ Tcl_CreateInterp(void)
Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_CmdInfo info2;
Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info",
BuildInfoObjCmd, (void *)version, NULL);
buildInfoObjCmd, (void *)version, NULL);
Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2);
info2.objProc2 = BuildInfoObjCmd2;
info2.objProc2 = buildInfoObjCmd2;
info2.objClientData2 = (void *)version;
Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2);
@@ -1385,8 +1385,8 @@ TclRegisterCommandTypeName(
int isNew;
hPtr = Tcl_CreateHashEntry(&commandTypeTable,
(void *)implementationProc, &isNew);
Tcl_SetHashValue(hPtr, nameStr);
implementationProc, &isNew);
Tcl_SetHashValue(hPtr, (void *) nameStr);
} else {
hPtr = Tcl_FindHashEntry(&commandTypeTable,
implementationProc);
@@ -2717,14 +2717,14 @@ Tcl_CreateCommand(
typedef struct {
Tcl_ObjCmdProc2 *proc;
void *clientData; /* Arbitrary value to pass to proc function. */
void *clientData; /* Arbitrary value to pass to proc function. */
Tcl_CmdDeleteProc *deleteProc;
void *deleteData; /* Arbitrary value to pass to deleteProc function. */
void *deleteData; /* Arbitrary value to pass to deleteProc function. */
Tcl_ObjCmdProc2 *nreProc;
} CmdWrapperInfo;
static int
CmdWrapperProc(
cmdWrapperProc(
void *clientData,
Tcl_Interp *interp,
int objc,
@@ -2734,11 +2734,11 @@ CmdWrapperProc(
if (objc < 0) {
objc = -1;
}
return info->proc(info->clientData, interp, (int)objc, objv);
return info->proc(info->clientData, interp, objc, objv);
}
static void
CmdWrapperDeleteProc(
cmdWrapperDeleteProc(
void *clientData)
{
CmdWrapperInfo *info = (CmdWrapperInfo *) clientData;
@@ -2774,8 +2774,8 @@ Tcl_CreateObjCommand2(
info->deleteData = clientData;
return Tcl_CreateObjCommand(interp, cmdName,
(proc ? CmdWrapperProc : NULL),
info, CmdWrapperDeleteProc);
(proc ? cmdWrapperProc : NULL),
info, cmdWrapperDeleteProc);
}
Tcl_Command
@@ -3006,9 +3006,9 @@ TclCreateObjCommandInNs(
int
InvokeStringCommand(
void *clientData, /* Points to command's Command structure. */
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Command *cmdPtr = (Command *)clientData;
@@ -3293,7 +3293,7 @@ Tcl_SetCommandInfo(
*/
static int
InvokeObj2Command(
invokeObj2Command(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
@@ -3315,7 +3315,7 @@ InvokeObj2Command(
}
static int
CmdWrapper2Proc(
cmdWrapper2Proc(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
@@ -3357,10 +3357,10 @@ Tcl_SetCommandInfoFromToken(
}
cmdPtr->objClientData = infoPtr->objClientData;
}
if (cmdPtr->deleteProc == CmdWrapperDeleteProc) {
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData;
if (infoPtr->objProc2 == NULL) {
info->proc = InvokeObj2Command;
info->proc = invokeObj2Command;
info->clientData = cmdPtr;
info->nreProc = NULL;
} else {
@@ -3373,14 +3373,14 @@ Tcl_SetCommandInfoFromToken(
info->deleteProc = infoPtr->deleteProc;
info->deleteData = infoPtr->deleteData;
} else {
if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != CmdWrapper2Proc)) {
if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) {
CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
info->proc = infoPtr->objProc2;
info->clientData = infoPtr->objClientData2;
info->nreProc = NULL;
info->deleteProc = infoPtr->deleteProc;
info->deleteData = infoPtr->deleteData;
cmdPtr->deleteProc = CmdWrapperDeleteProc;
cmdPtr->deleteProc = cmdWrapperDeleteProc;
cmdPtr->deleteData = info;
} else {
cmdPtr->deleteProc = infoPtr->deleteProc;
@@ -3464,19 +3464,19 @@ Tcl_GetCommandInfoFromToken(
infoPtr->objClientData = cmdPtr->objClientData;
infoPtr->proc = cmdPtr->proc;
infoPtr->clientData = cmdPtr->clientData;
if (cmdPtr->deleteProc == CmdWrapperDeleteProc) {
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
infoPtr->deleteProc = info->deleteProc;
infoPtr->deleteData = info->deleteData;
infoPtr->objProc2 = info->proc;
infoPtr->objClientData2 = info->clientData;
if (cmdPtr->objProc == CmdWrapperProc) {
if (cmdPtr->objProc == cmdWrapperProc) {
infoPtr->isNativeObjectProc = 2;
}
} else {
infoPtr->deleteProc = cmdPtr->deleteProc;
infoPtr->deleteData = cmdPtr->deleteData;
infoPtr->objProc2 = CmdWrapper2Proc;
infoPtr->objProc2 = cmdWrapper2Proc;
infoPtr->objClientData2 = cmdPtr;
}
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
@@ -3550,6 +3550,7 @@ Tcl_GetCommandFullName(
* not have been deleted. */
Tcl_Obj *objPtr) /* Points to the object onto which the
* command's full name is appended. */
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = (Command *) command;
@@ -3947,7 +3948,7 @@ CallCommandTraces(
static int
CancelEvalProc(
void *clientData, /* Interp to cancel the script in progress. */
void *clientData, /* Interp to cancel the script in progress. */
TCL_UNUSED(Tcl_Interp *),
int code) /* Current return code from command. */
{
@@ -4437,7 +4438,7 @@ EvalObjvCore(
TCL_UNUSED(int) /*result*/)
{
Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0];
int flags = (int)PTR2INT(data[1]);
int flags = PTR2INT(data[1]);
Tcl_Size objc = PTR2INT(data[2]);
Tcl_Obj **objv = (Tcl_Obj **)data[3];
Interp *iPtr = (Interp *) interp;
@@ -4619,8 +4620,7 @@ Dispatch(
}
if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
const char *a[6];
Tcl_Size i[2];
const char *a[6]; Tcl_Size i[2];
TclDTraceInfo(info, a, i);
TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
@@ -5157,7 +5157,7 @@ TclEvalEx(
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
int line, /* The line the script starts on. */
Tcl_Size line, /* The line the script starts on. */
Tcl_Size *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set only in
* TclSubstTokens(), to properly handle
@@ -5180,8 +5180,8 @@ TclEvalEx(
const char *p, *next;
const int minObjs = 20;
Tcl_Obj **objv, **objvSpace;
char *expand;
int *lines, *lineSpace;
int *expand;
Tcl_Size *lines, *lineSpace;
Tcl_Token *tokenPtr;
int expandRequested, code = TCL_OK;
Tcl_Size bytesLeft, commandLength;
@@ -5197,8 +5197,8 @@ TclEvalEx(
Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
Tcl_Obj **stackObjArray = (Tcl_Obj **)TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
char *expandStack = (char *)TclStackAlloc(interp, minObjs * sizeof(char));
int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size));
/* TIP #280 Structures for tracking of command
* locations. */
Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible
@@ -5323,7 +5323,7 @@ TclEvalEx(
* per-command parsing.
*/
int wordLine = line;
Tcl_Size wordLine = line;
const char *wordStart = parsePtr->commandStart;
Tcl_Size *wordCLNext = clNext;
Tcl_Size objectsNeeded = 0;
@@ -5334,11 +5334,11 @@ TclEvalEx(
*/
if (numWords > minObjs) {
expand = (char *)Tcl_Alloc(numWords * sizeof(char));
expand = (int *)Tcl_Alloc(numWords * sizeof(int));
objvSpace = (Tcl_Obj **)
Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
lineSpace = (int *)
Tcl_Alloc(numWords * sizeof(int));
lineSpace = (Tcl_Size *)
Tcl_Alloc(numWords * sizeof(Tcl_Size));
}
expandRequested = 0;
objv = objvSpace;
@@ -5430,13 +5430,13 @@ TclEvalEx(
*/
Tcl_Obj **copy = objvSpace;
int *lcopy = lineSpace;
Tcl_Size *lcopy = lineSpace;
Tcl_Size wordIdx = numWords;
Tcl_Size objIdx = objectsNeeded - 1;
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
objv = objvSpace = (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size));
}
objectsUsed = 0;
@@ -5575,7 +5575,7 @@ TclEvalEx(
Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
commandLength);
}
posterror:
posterror:
iPtr->flags &= ~ERR_ALREADY_LOGGED;
/*
@@ -5597,7 +5597,7 @@ TclEvalEx(
}
iPtr->varFramePtr = savedVarFramePtr;
cleanup_return:
cleanup_return:
/*
* TIP #280. Release the local CmdFrame, and its contents.
*/
@@ -5635,7 +5635,7 @@ TclEvalEx(
void
TclAdvanceLines(
int *line,
Tcl_Size *line,
const char *start,
const char *end)
{
@@ -5670,9 +5670,9 @@ TclAdvanceLines(
void
TclAdvanceContinuations(
int *line,
Tcl_Size *line,
Tcl_Size **clNextPtrPtr,
Tcl_Size loc)
int loc)
{
/*
* Track the invisible continuation lines embedded in a script, if any.
@@ -5853,7 +5853,7 @@ TclArgumentBCEnter(
Tcl_Size pc)
{
ExtCmdLoc *eclPtr;
int word;
Tcl_Size word;
ECL *ePtr;
CFWordBC *lastPtr = NULL;
Interp *iPtr = (Interp *) interp;
@@ -6125,7 +6125,7 @@ TclNREvalObjEx(
* evaluation of the script. Supported values
* are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
const CmdFrame *invoker, /* Frame of the command doing the eval. */
int word) /* Index of the word which is in objPtr. */
int word) /* Index of the word which is in objPtr. */
{
Interp *iPtr = (Interp *) interp;
int result;
@@ -6294,7 +6294,7 @@ TEOEx_ByteCodeCallback(
Interp *iPtr = (Interp *) interp;
CallFrame *savedVarFramePtr = (CallFrame *)data[0];
Tcl_Obj *objPtr = (Tcl_Obj *)data[1];
int allowExceptions = (int)PTR2INT(data[2]);
int allowExceptions = PTR2INT(data[2]);
if (iPtr->numLevels == 0) {
if (result == TCL_RETURN) {
@@ -6548,7 +6548,7 @@ Tcl_ExprLongObj(
}
resultPtr = Tcl_NewBignumObj(&big);
}
TCL_FALLTHROUGH();
/* FALLTHRU */
case TCL_NUMBER_INT:
case TCL_NUMBER_BIG:
result = TclGetLongFromObj(interp, resultPtr, ptr);
@@ -6740,7 +6740,7 @@ TclNRInvoke(
*/
iPtr->numLevels++;
Tcl_NRAddCallback(interp, TclNRPostInvoke, NULL, NULL, NULL, NULL);
Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
/*
* Normal command resolution of objv[0] isn't going to find cmdPtr.
@@ -6751,8 +6751,8 @@ TclNRInvoke(
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
}
int
TclNRPostInvoke(
static int
NRPostInvoke(
TCL_UNUSED(void **),
Tcl_Interp *interp,
int result)
@@ -7716,7 +7716,7 @@ ExprRandFunc(
* take into consideration the thread this interp is running in.
*/
iPtr->randSeed = (long)TclpGetClicks() + (long)PTR2UINT(Tcl_GetCurrentThread()) * 4093U;
iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U;
/*
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
@@ -7771,7 +7771,7 @@ ExprRandFunc(
* dividing by RAND_IM yields a double in the range (0, 1).
*/
dResult = (double)iPtr->randSeed * (1.0/RAND_IM);
dResult = iPtr->randSeed * (1.0/RAND_IM);
/*
* Push a Tcl object with the result.
@@ -8064,16 +8064,16 @@ DoubleObjClass(
return TCL_ERROR;
}
switch (type) {
case TCL_NUMBER_NAN:
case TCL_NUMBER_NAN:
*fpClsPtr = FP_NAN;
return TCL_OK;
case TCL_NUMBER_DOUBLE:
case TCL_NUMBER_DOUBLE:
d = *((const double *) ptr);
break;
case TCL_NUMBER_INT:
case TCL_NUMBER_INT:
d = (double)*((const Tcl_WideInt *) ptr);
break;
default:
default:
if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
return TCL_ERROR;
}
@@ -8088,7 +8088,7 @@ DoubleObjIsClass(
int objc, /* Actual parameter count */
Tcl_Obj *const *objv, /* Actual parameter list */
int cmpCls, /* FP class to compare. */
int positive) /* 1 if compare positive, 0 - otherwise */
int positive) /* 1 if compare positive, 0 - otherwise */
{
int dCls;
@@ -8179,8 +8179,10 @@ ExprIsUnorderedFunc(
return TCL_ERROR;
}
if (DoubleObjClass(interp, objv[1], &dCls) != TCL_OK ||
DoubleObjClass(interp, objv[2], &dCls2) != TCL_OK) {
if (
DoubleObjClass(interp, objv[1], &dCls) != TCL_OK ||
DoubleObjClass(interp, objv[2], &dCls2) != TCL_OK
) {
return TCL_ERROR;
}
@@ -8261,8 +8263,8 @@ FloatClassifyObjCmd(
static void
MathFuncWrongNumArgs(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size expected, /* Formal parameter count. */
Tcl_Size found, /* Actual parameter count. */
int expected, /* Formal parameter count. */
int found, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
const char *name = TclGetString(objv[0]);
@@ -8460,7 +8462,7 @@ Tcl_NRCallObjProc(
}
static int
WrapperNRObjProc(
wrapperNRObjProc(
void *clientData,
Tcl_Interp *interp,
int objc,
@@ -8494,7 +8496,7 @@ Tcl_NRCallObjProc2(
info->clientData = clientData;
info->proc = objProc;
TclNRAddCallback(interp, Dispatch, WrapperNRObjProc, info,
TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
@@ -8528,7 +8530,7 @@ Tcl_NRCallObjProc2(
*/
static int
CmdWrapperNreProc(
cmdWrapperNreProc(
void *clientData,
Tcl_Interp *interp,
int objc,
@@ -8569,9 +8571,9 @@ Tcl_NRCreateCommand2(
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_NRCreateCommand(interp, cmdName,
(proc ? CmdWrapperProc : NULL),
(nreProc ? CmdWrapperNreProc : NULL),
info, CmdWrapperDeleteProc);
(proc ? cmdWrapperProc : NULL),
(nreProc ? cmdWrapperNreProc : NULL),
info, cmdWrapperDeleteProc);
}
Tcl_Command
@@ -8817,7 +8819,6 @@ TclNRTailcallObjCmd(
listPtr = Tcl_NewListObj(objc, objv);
TclListObjSetElement(NULL, listPtr, 0, TclNewNamespaceObj(nsPtr));
Tcl_IncrRefCount(listPtr);
iPtr->varFramePtr->tailcallPtr = listPtr;
}
@@ -9609,13 +9610,13 @@ TclNRInterpCoroutine(
break;
default:
if (corPtr->nargs + 1 != objc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"wrong coro nargs; how did we get here? "
Tcl_SetObjResult(interp,
Tcl_NewStringObj("wrong coro nargs; how did we get here? "
"not implemented!", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
return TCL_ERROR;
}
TCL_FALLTHROUGH();
/* fallthrough */
case COROUTINE_ARGUMENTS_ARBITRARY:
if (objc > 1) {
Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1));
@@ -9709,10 +9710,11 @@ TclNRCoroutineObjCmd(
for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
int isNew;
Tcl_HashEntry *newPtr =
Tcl_CreateHashEntry(corPtr->lineLABCPtr,
Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr),
NULL);
&isNew);
Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
}
+50 -53
View File
@@ -384,7 +384,7 @@ Tcl_GetBytesFromObj(
return baPtr->bytes;
}
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED)
unsigned char *
TclGetBytesFromObj(
Tcl_Interp *interp, /* For error reporting */
@@ -512,7 +512,7 @@ MakeByteArray(
for (; src < srcEnd && dst < dstEnd; ) {
int ch;
Tcl_Size count = TclUtfToUniChar(src, &ch);
int count = TclUtfToUniChar(src, &ch);
if (ch > 255) {
proper = 0;
@@ -770,9 +770,12 @@ TclAppendBytesToByteArray(
needed = byteArrayPtr->used + len;
if (needed > byteArrayPtr->allocated) {
Tcl_Size newCapacity;
byteArrayPtr = (ByteArray *)
TclReallocElemsEx(byteArrayPtr, needed, 1,
offsetof(ByteArray, bytes), &newCapacity);
byteArrayPtr =
(ByteArray *)TclReallocElemsEx(byteArrayPtr,
needed,
1,
offsetof(ByteArray, bytes),
&newCapacity);
byteArrayPtr->allocated = newCapacity;
SET_BYTEARRAY(irPtr, byteArrayPtr);
}
@@ -1293,22 +1296,22 @@ BinaryFormatCmd(
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
badValue:
badValue:
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected %s string but got \"%s\" instead",
errorString, errorValue));
return TCL_ERROR;
badCount:
badCount:
errorString = "missing count for \"@\" field specifier";
goto error;
badIndex:
badIndex:
errorString = "not enough arguments for all format specifiers";
goto error;
badField:
badField:
{
Tcl_UniChar ch = 0;
char buf[5] = "";
@@ -1320,7 +1323,7 @@ BinaryFormatCmd(
return TCL_ERROR;
}
error:
error:
Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
@@ -1675,21 +1678,21 @@ BinaryScanCmd(
* Set the result to the last position of the cursor.
*/
done:
done:
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(arg - 3));
DeleteScanNumberCache(numberCachePtr);
return TCL_OK;
badCount:
badCount:
errorString = "missing count for \"@\" field specifier";
goto error;
badIndex:
badIndex:
errorString = "not enough arguments for all format specifiers";
goto error;
badField:
badField:
{
Tcl_UniChar ch = 0;
char buf[5] = "";
@@ -1701,7 +1704,7 @@ BinaryScanCmd(
return TCL_ERROR;
}
error:
error:
Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
@@ -2502,8 +2505,6 @@ BinaryDecodeHex(
case OPT_STRICT:
strict = 1;
break;
default:
TCL_UNREACHABLE();
}
}
@@ -2648,8 +2649,6 @@ BinaryEncode64(
wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
}
break;
default:
TCL_UNREACHABLE();
}
}
if (wrapcharlen == 0) {
@@ -2666,7 +2665,7 @@ BinaryEncode64(
size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
if (maxlen > 0 && size > maxlen) {
Tcl_Size adjusted = size + (wrapcharlen * (size / maxlen));
int adjusted = size + (wrapcharlen * (size / maxlen));
if (size % maxlen == 0) {
adjusted -= wrapcharlen;
@@ -2737,13 +2736,13 @@ BinaryEncodeUu(
{
Tcl_Obj *resultObj;
unsigned char *data, *start, *cursor;
int i, bits;
int i, bits, index;
unsigned int n;
int lineLength = 61;
const unsigned char SingleNewline[] = { UCHAR('\n') };
const unsigned char *wrapchar = SingleNewline;
Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
enum { OPT_MAXLEN, OPT_WRAPCHAR } index;
enum { OPT_MAXLEN, OPT_WRAPCHAR };
static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
if (objc < 2 || objc % 2 != 0) {
@@ -2774,33 +2773,35 @@ BinaryEncodeUu(
case OPT_WRAPCHAR:
wrapchar = (const unsigned char *)TclGetStringFromObj(
objv[i + 1], &wrapcharlen);
const unsigned char *p = wrapchar;
Tcl_Size numBytes = wrapcharlen;
{
const unsigned char *p = wrapchar;
Tcl_Size numBytes = wrapcharlen;
while (numBytes) {
switch (*p) {
case '\t':
case '\v':
case '\f':
case '\r':
p++;
numBytes--;
continue;
case '\n':
numBytes--;
break;
default:
while (numBytes) {
switch (*p) {
case '\t':
case '\v':
case '\f':
case '\r':
p++; numBytes--;
continue;
case '\n':
numBytes--;
break;
default:
badwrap:
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"invalid wrapchar; will defeat decoding",
-1));
Tcl_SetErrorCode(interp, "TCL", "BINARY",
"ENCODE", "WRAPCHAR", (char *)NULL);
return TCL_ERROR;
}
}
if (numBytes) {
goto badwrap;
}
}
if (numBytes) {
badwrap:
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"invalid wrapchar; will defeat decoding", -1));
Tcl_SetErrorCode(interp, "TCL", "BINARY",
"ENCODE", "WRAPCHAR", (char *)NULL);
return TCL_ERROR;
}
break;
}
}
@@ -2908,8 +2909,6 @@ BinaryDecodeUu(
case OPT_STRICT:
strict = 1;
break;
default:
TCL_UNREACHABLE();
}
}
@@ -2973,14 +2972,14 @@ BinaryDecodeUu(
*/
if (lineLen > 0) {
*cursor++ = (unsigned char)(((d[0] - 0x20) & 0x3F) << 2)
*cursor++ = (((d[0] - 0x20) & 0x3F) << 2)
| (((d[1] - 0x20) & 0x3F) >> 4);
if (--lineLen > 0) {
*cursor++ = (unsigned char)(((d[1] - 0x20) & 0x3F) << 4)
*cursor++ = (((d[1] - 0x20) & 0x3F) << 4)
| (((d[2] - 0x20) & 0x3F) >> 2);
if (--lineLen > 0) {
*cursor++ = (unsigned char)((((d[2] - 0x20) & 0x3F) << 6)
| (((d[3] - 0x20) & 0x3F)));
*cursor++ = (((d[2] - 0x20) & 0x3F) << 6)
| (((d[3] - 0x20) & 0x3F));
lineLen--;
}
}
@@ -3085,8 +3084,6 @@ BinaryDecode64(
case OPT_STRICT:
strict = 1;
break;
default:
TCL_UNREACHABLE();
}
}
+10 -8
View File
@@ -276,6 +276,7 @@ ValidateMemory(
memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
memset(hiPtr, 0, HIGH_GUARD_SIZE);
}
}
/*
@@ -812,8 +813,7 @@ MemoryCmd(
return TCL_ERROR;
}
if (strcmp(TclGetString(objv[1]), "active") == 0 ||
strcmp(TclGetString(objv[1]), "display") == 0) {
if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) {
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "file");
return TCL_ERROR;
@@ -1257,11 +1257,12 @@ TclAllocElemsEx(
* non-NULL. Only modified on success */
{
void *ptr = TclAttemptReallocElemsEx(
NULL, elemCount, elemSize, leadSize, capacityPtr);
NULL, elemCount, elemSize, leadSize, capacityPtr);
if (ptr == NULL) {
Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER
"d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
elemCount, elemSize);
"d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
elemCount,
elemSize);
}
return ptr;
}
@@ -1362,11 +1363,12 @@ TclReallocElemsEx(
* non-NULL. Only modified on success */
{
void *ptr = TclAttemptReallocElemsEx(
oldPtr, elemCount, elemSize, leadSize, capacityPtr);
oldPtr, elemCount, elemSize, leadSize, capacityPtr);
if (ptr == NULL) {
Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER
"d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
elemCount, elemSize);
"d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
elemCount,
elemSize);
}
return ptr;
}
+13 -22
View File
@@ -129,10 +129,10 @@ static const struct ClockCommand clockCommands[] = {
{"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL},
{"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(CLOCK_READ_MICROS)},
{"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(CLOCK_READ_MILLIS)},
{"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)},
{"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)},
{"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL},
{"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(CLOCK_READ_SECS)},
{"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)},
{"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL},
{"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL},
{"GetJulianDayFromEraYearMonthDay",
@@ -988,11 +988,7 @@ ClockConfigureObjCmd(
TclSetObjRef(dataPtr->systemTimeZone, objv[i]);
TclUnsetObjRef(dataPtr->systemSetupTZData);
}
if (dataPtr->lastTZEpoch != lastTZEpoch) {
dataPtr->lastTZEpoch = lastTZEpoch;
/* TZ epoch changed - invalidate base-cache */
TclUnsetObjRef(dataPtr->lastBase.timezoneObj);
}
dataPtr->lastTZEpoch = lastTZEpoch;
}
if (i + 1 >= objc && dataPtr->systemTimeZone != NULL
&& dataPtr->lastTZEpoch == lastTZEpoch) {
@@ -1158,8 +1154,6 @@ ClockConfigureObjCmd(
}
break;
}
default:
TCL_UNREACHABLE();
}
}
@@ -3165,8 +3159,6 @@ ClockClicksObjCmd(
case CLICKS_MICROS:
clicks = TclpGetMicroseconds();
break;
default:
TCL_UNREACHABLE();
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
@@ -3379,8 +3371,6 @@ ClockParseFmtScnArgs(
}
}
break;
default:
TCL_UNREACHABLE();
}
saw |= 1 << optionIndex;
}
@@ -3441,8 +3431,8 @@ ClockParseFmtScnArgs(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad seconds \"%s\": must be now or integer",
TclGetString(baseObj)));
"bad seconds \"%s\": must be now or integer",
TclGetString(baseObj)));
i = baseIdx;
goto badOption;
}
@@ -3484,7 +3474,7 @@ ClockParseFmtScnArgs(
/* extact fields from base */
date->seconds = baseVal;
if (ClockGetDateFields(dataPtr, interp, date, opts->timezoneObj,
GREGORIAN_CHANGE_DATE) != TCL_OK) {
GREGORIAN_CHANGE_DATE) != TCL_OK) {
/* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */
return TCL_ERROR;
}
@@ -3634,8 +3624,7 @@ ClockScanObjCmd(
}
/* seconds are in localSeconds (relative base date), so reset time here */
yyHour = yyMinutes = yySeconds = yySecondOfDay = 0;
yyMeridian = MER24;
yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; yyMeridian = MER24;
/* If free scan */
if (opts.formatObj == NULL) {
@@ -4276,7 +4265,7 @@ ClockCalcRelTime(
yyRelSeconds = 0;
/* Convert it back */
if (ClockGetDateFields(opts->dataPtr, opts->interp, &yydate,
opts->timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) {
opts->timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) {
/* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */
return TCL_ERROR;
}
@@ -4548,8 +4537,6 @@ ClockAddObjCmd(
case CLC_ADD_SECONDS:
yyRelSeconds += offs;
break;
default:
TCL_UNREACHABLE();
}
if (unitIndex < CLC_ADD_HOURS) { /* date units only */
info->flags |= CLF_RELCONV;
@@ -4719,7 +4706,11 @@ ClockSafeCatchCmd(
typedef struct ClockTzStatic {
WCHAR *was; /* Previous value of TZ. */
#if TCL_MAJOR_VERSION > 8
long long lastRefresh; /* Used for latency before next refresh. */
#else
long lastRefresh; /* Used for latency before next refresh. */
#endif
size_t epoch; /* Epoch, signals that TZ changed. */
size_t envEpoch; /* Last env epoch, for faster signaling,
* that TZ changed via TCL */
+30 -43
View File
@@ -565,10 +565,7 @@ ClockFmtScnStorageAllocProc(
allocsize -= sizeof(hPtr->key);
}
fss = (ClockFmtScnStorage *)Tcl_AttemptAlloc(allocsize);
if (!fss) {
return NULL;
}
fss = (ClockFmtScnStorage *)Tcl_Alloc(allocsize);
/* initialize */
memset(fss, 0, sizeof(*fss));
@@ -844,7 +841,7 @@ FindOrCreateFmtScnStorage(
}
/* get or create entry (and alocate storage) */
hPtr = Tcl_AttemptCreateHashEntry(&FmtScnHashTable, strFmt, &isNew);
hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &isNew);
if (hPtr != NULL) {
fss = FmtScn4HashEntry(hPtr);
@@ -1027,7 +1024,7 @@ static const char *
FindTokenBegin(
const char *p,
const char *end,
const ClockScanToken *tok,
ClockScanToken *tok,
int flags)
{
if (p < end) {
@@ -1040,14 +1037,10 @@ FindTokenBegin(
if (!(flags & CLF_STRICT)) {
/* should match at least one digit or space */
while (!isdigit(UCHAR(*p)) && !isspace(UCHAR(*p)) &&
(p = Tcl_UtfNext(p)) < end) {
// Empty
}
(p = Tcl_UtfNext(p)) < end) {}
} else {
/* should match at least one digit */
while (!isdigit(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {
// Empty
}
while (!isdigit(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {}
}
return p;
@@ -1056,25 +1049,19 @@ FindTokenBegin(
goto findChar;
case CTOKT_SPACE:
while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {
// Empty
}
while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {}
return p;
case CTOKT_CHAR:
c = *((char *)tok->map->data);
findChar:
findChar:
if (!(flags & CLF_STRICT)) {
/* should match the char or space */
while (*p != c && !isspace(UCHAR(*p)) &&
(p = Tcl_UtfNext(p)) < end) {
// Empty
}
(p = Tcl_UtfNext(p)) < end) {}
} else {
/* should match the char */
while (*p != c && (p = Tcl_UtfNext(p)) < end) {
// Empty
}
while (*p != c && (p = Tcl_UtfNext(p)) < end) {}
}
return p;
}
@@ -1102,7 +1089,7 @@ static void
DetermineGreedySearchLen(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok,
ClockScanToken *tok,
int *minLenPtr,
int *maxLenPtr)
{
@@ -1154,7 +1141,7 @@ DetermineGreedySearchLen(
/* try to get max length more precise for greedy match,
* check the next ahead token available there */
if (minLen < maxLen && tok->lookAhTok) {
const ClockScanToken *laTok = tok + tok->lookAhTok + 1;
ClockScanToken *laTok = tok + tok->lookAhTok + 1;
p = yyInput + maxLen;
/* regards all possible spaces here (because they are optional) */
@@ -1168,7 +1155,7 @@ DetermineGreedySearchLen(
/* try to find laTok between [lookAhMin, lookAhMax] */
while (minLen < maxLen) {
const char *f = FindTokenBegin(p, end, laTok,
TCL_CLOCK_FULL_COMPAT ? opts->flags : CLF_STRICT);
TCL_CLOCK_FULL_COMPAT ? opts->flags : CLF_STRICT);
/* if found (not below lookAhMax) */
if (f < end) {
break;
@@ -1504,7 +1491,7 @@ StaticListSearch(
static inline const char *
FindWordEnd(
const ClockScanToken *tok,
ClockScanToken *tok,
const char *p,
const char *end)
{
@@ -1529,7 +1516,7 @@ static int
ClockScnToken_Month_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
#if 0
/* currently unused, test purposes only */
@@ -1579,7 +1566,7 @@ static int
ClockScnToken_DayOfWeek_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0};
@@ -1653,7 +1640,7 @@ static int
ClockScnToken_amPmInd_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
int ret, val;
int minLen, maxLen;
@@ -1686,7 +1673,7 @@ static int
ClockScnToken_LocaleERA_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
ClockClientData *dataPtr = opts->dataPtr;
@@ -1725,7 +1712,7 @@ static int
ClockScnToken_LocaleListMatcher_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
int ret, val;
int minLen, maxLen;
@@ -1756,7 +1743,7 @@ static int
ClockScnToken_JDN_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
int minLen, maxLen;
const char *p = yyInput, *end, *s;
@@ -1827,7 +1814,7 @@ static int
ClockScnToken_TimeZone_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
int minLen, maxLen;
int len = 0;
@@ -1919,7 +1906,7 @@ static int
ClockScnToken_StarDate_Proc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok)
ClockScanToken *tok)
{
int minLen, maxLen;
const char *p = yyInput, *end, *s;
@@ -2313,7 +2300,8 @@ ClockGetOrParseScanFormat(
tokCnt++;
continue;
}
word_tok: {
word_tok:
{
/* try continue with previous word token */
ClockScanToken *wordTok = tok - 1;
@@ -2336,9 +2324,9 @@ ClockGetOrParseScanFormat(
AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *);
tokCnt++;
}
}
break;
}
}
}
/* calculate end distance value for each tokens */
@@ -2385,8 +2373,8 @@ ClockScan(
ClockFmtScnCmdArgs *opts) /* Command options */
{
ClockClientData *dataPtr = opts->dataPtr;
const ClockFmtScnStorage *fss;
const ClockScanToken *tok;
ClockFmtScnStorage *fss;
ClockScanToken *tok;
const ClockScanTokenMap *map;
const char *p, *x, *end;
unsigned short flags = 0;
@@ -2566,8 +2554,6 @@ ClockScan(
}
p++;
break;
default:
TCL_UNREACHABLE();
}
}
/* check end was reached */
@@ -2616,7 +2602,7 @@ ClockScan(
case (CLF_DAYOFYEAR | CLF_DAYOFMONTH):
/* miss month: ddd over dd (without month) */
flags &= ~CLF_DAYOFMONTH;
TCL_FALLTHROUGH();
/* fallthrough */
case CLF_DAYOFYEAR:
/* ddd over naked weekday */
if (!(flags & CLF_ISO8601YEAR)) {
@@ -3357,7 +3343,8 @@ ClockGetOrParseFmtFormat(
continue;
}
default:
word_tok: {
word_tok:
{
/* try continue with previous word token */
ClockFormatToken *wordTok = tok - 1;
@@ -3376,9 +3363,9 @@ ClockGetOrParseFmtFormat(
AllocTokenInChain(tok, fmtTok, fss->fmtTokC, ClockFormatToken *);
tokCnt++;
}
}
break;
}
}
}
/* correct count of real used tokens and free mem if desired
+80 -77
View File
@@ -485,8 +485,6 @@ EncodingConvertParseOptions(
case FAILINDEX:
failVarObj = objv[argIndex];
break;
default:
TCL_UNREACHABLE();
}
}
/* Get encoding after opts so no need to free it on option error */
@@ -528,7 +526,7 @@ EncodingConvertfromObjCmd(
Tcl_Obj *data; /* Byte array to convert */
Tcl_DString ds; /* Buffer to hold the string */
Tcl_Encoding encoding; /* Encoding to use */
Tcl_Size length = 0; /* Length of the byte array being converted */
Tcl_Size length = 0; /* Length of the byte array being converted */
const char *bytesPtr; /* Pointer to the first byte of the array */
int flags;
int result;
@@ -551,14 +549,14 @@ EncodingConvertfromObjCmd(
result = Tcl_ExternalToUtfDStringEx(interp, encoding, bytesPtr, length, flags,
&ds, failVarObj ? &errorLocation : NULL);
/* NOTE: ds must be freed beyond this point even on error */
switch (result) {
case TCL_OK:
errorLocation = TCL_INDEX_NONE;
break;
case TCL_ERROR:
/* Error in parameters. Should not happen. interp will have error */
goto done;
Tcl_DStringFree(&ds);
return TCL_ERROR;
default:
/*
* One of the TCL_CONVERT_* errors. If we were not interested in the
@@ -567,8 +565,8 @@ EncodingConvertfromObjCmd(
* what could be decoded and the returned error location.
*/
if (failVarObj == NULL) {
result = TCL_ERROR;
goto done;
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
break;
}
@@ -582,8 +580,8 @@ EncodingConvertfromObjCmd(
TclNewIndexObj(failIndex, errorLocation);
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, failIndex,
TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
goto done;
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
}
/*
@@ -592,14 +590,12 @@ EncodingConvertfromObjCmd(
*/
Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));
result = TCL_OK;
done:
Tcl_DStringFree(&ds);
if (encoding) {
Tcl_FreeEncoding(encoding);
}
return result;
/* We're done with the encoding */
Tcl_FreeEncoding(encoding);
return TCL_OK;
}
/*
@@ -653,7 +649,8 @@ EncodingConverttoObjCmd(
break;
case TCL_ERROR:
/* Error in parameters. Should not happen. interp will have error */
goto done;
Tcl_DStringFree(&ds);
return TCL_ERROR;
default:
/*
* One of the TCL_CONVERT_* errors. If we were not interested in the
@@ -662,8 +659,8 @@ EncodingConverttoObjCmd(
* what could be decoded and the returned error location.
*/
if (failVarObj == NULL) {
result = TCL_ERROR;
goto done;
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
break;
}
@@ -677,23 +674,21 @@ EncodingConverttoObjCmd(
TclNewIndexObj(failIndex, errorLocation);
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, failIndex,
TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
goto done;
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
(unsigned char*) Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds)));
result = TCL_OK;
done:
Tcl_DStringFree(&ds);
if (encoding) {
Tcl_FreeEncoding(encoding);
}
return result;
/* We're done with the encoding */
Tcl_FreeEncoding(encoding);
return TCL_OK;
}
/*
@@ -759,9 +754,9 @@ EncodingDirsObjCmd(
int
EncodingNamesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
{
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -855,14 +850,19 @@ EncodingUserObjCmd(
int objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
{
if (objc > 1) {
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
Tcl_DString ds;
Tcl_GetEncodingNameForUser(&ds);
Tcl_DStringResult(interp, &ds);
#ifdef _WIN32
const char *encodingName = Tcl_GetEncodingName(TclWinGetUserEncoding(interp));
if (encodingName) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(encodingName, -1));
}
return TCL_OK;
#else
return EncodingSystemObjCmd(NULL, interp, objc, objv);
#endif
}
/*
@@ -2157,7 +2157,8 @@ PathTypeCmd(
TclNewLiteralStringObj(typeName, "volumerelative");
break;
default:
TCL_UNREACHABLE();
/* Should be unreachable */
return TCL_OK;
}
Tcl_SetObjResult(interp, typeName);
return TCL_OK;
@@ -2377,30 +2378,34 @@ StoreStatData(
* store in varName. */
{
Tcl_Obj *field, *value, *result;
unsigned short modeVal = (unsigned short) statPtr->st_mode;
unsigned short mode;
if (varName == NULL) {
TclNewObj(result);
Tcl_IncrRefCount(result);
#define D_PUT(key, objValue) TclDictPut(NULL, result, #key, (objValue))
D_PUT(dev, Tcl_NewWideIntObj((long)statPtr->st_dev));
D_PUT(ino, Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
D_PUT(nlink, Tcl_NewWideIntObj((long)statPtr->st_nlink));
D_PUT(uid, Tcl_NewWideIntObj((long)statPtr->st_uid));
D_PUT(gid, Tcl_NewWideIntObj((long)statPtr->st_gid));
D_PUT(size, Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#define DOBJPUT(key, objValue) \
Tcl_DictObjPut(NULL, result, \
Tcl_NewStringObj((key), -1), \
(objValue));
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
D_PUT(blocks, Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
D_PUT(blksize, Tcl_NewWideIntObj((long)statPtr->st_blksize));
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
D_PUT(atime, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
D_PUT(mtime, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
D_PUT(ctime, Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
D_PUT(mode, Tcl_NewWideIntObj(modeVal));
D_PUT(type, Tcl_NewStringObj(GetTypeFromMode(modeVal), -1));
#undef D_PUT
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
mode = (unsigned short) statPtr->st_mode;
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef DOBJPUT
Tcl_SetObjResult(interp, result);
Tcl_DecrRefCount(result);
return TCL_OK;
@@ -2413,45 +2418,44 @@ StoreStatData(
*/
#define STORE_ARY(fieldName, object) \
do { \
TclNewLiteralStringObj(field, #fieldName); \
Tcl_IncrRefCount(field); \
value = (object); \
if (Tcl_ObjSetVar2(interp, varName, field, value, \
TCL_LEAVE_ERR_MSG) == NULL) { \
TclDecrRefCount(field); \
return TCL_ERROR; \
} \
TclNewLiteralStringObj(field, fieldName); \
Tcl_IncrRefCount(field); \
value = (object); \
if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
TclDecrRefCount(field); \
} while (0)
return TCL_ERROR; \
} \
TclDecrRefCount(field);
/*
* Watch out porters; the inode is meant to be an *unsigned* value, so the
* cast might fail when there isn't a real arithmetic 'long long' type...
*/
STORE_ARY(dev, Tcl_NewWideIntObj((long)statPtr->st_dev));
STORE_ARY(ino, Tcl_NewWideIntObj(statPtr->st_ino));
STORE_ARY(nlink, Tcl_NewWideIntObj((long)statPtr->st_nlink));
STORE_ARY(uid, Tcl_NewWideIntObj((long)statPtr->st_uid));
STORE_ARY(gid, Tcl_NewWideIntObj((long)statPtr->st_gid));
STORE_ARY(size, Tcl_NewWideIntObj(statPtr->st_size));
STORE_ARY("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
STORE_ARY("ino", Tcl_NewWideIntObj(statPtr->st_ino));
STORE_ARY("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
STORE_ARY("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
STORE_ARY("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
STORE_ARY("size", Tcl_NewWideIntObj(statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
STORE_ARY(blocks, Tcl_NewWideIntObj(statPtr->st_blocks));
STORE_ARY("blocks", Tcl_NewWideIntObj(statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
STORE_ARY(blksize, Tcl_NewWideIntObj((long)statPtr->st_blksize));
STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
#ifdef HAVE_STRUCT_STAT_ST_RDEV
if (S_ISCHR(statPtr->st_mode) || S_ISBLK(statPtr->st_mode)) {
STORE_ARY("rdev", Tcl_NewWideIntObj((long) statPtr->st_rdev));
}
#endif
STORE_ARY(atime, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
STORE_ARY(mtime, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
STORE_ARY(ctime, Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
STORE_ARY(mode, Tcl_NewWideIntObj(modeVal));
STORE_ARY(type, Tcl_NewStringObj(GetTypeFromMode(modeVal), -1));
STORE_ARY("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
STORE_ARY("mtime", Tcl_NewWideIntObj(
Tcl_GetModificationTimeFromStat(statPtr)));
STORE_ARY("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
mode = (unsigned short) statPtr->st_mode;
STORE_ARY("mode", Tcl_NewWideIntObj(mode));
STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY
return TCL_OK;
@@ -2963,7 +2967,6 @@ ForeachLoopStep(
"\n (\"%s\" body line %d)",
(statePtr->resultList != NULL ? "lmap" : "foreach"),
Tcl_GetErrorLine(interp)));
TCL_FALLTHROUGH();
default:
goto done;
}
+232 -72
View File
@@ -106,7 +106,7 @@ typedef enum {
LSEQ_DOTS, LSEQ_TO, LSEQ_COUNT, LSEQ_BY
} SequenceOperators;
typedef enum {
NoneArg, NumericArg, RangeKeywordArg, ErrArg, LastArg = 8
NoneArg, NumericArg, RangeKeywordArg, ErrArg, LastArg = 8
} SequenceDecoded;
/*
@@ -818,7 +818,7 @@ InfoCommandsCmd(
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
(void) Tcl_CreateHashEntry(&addedCommandsTable,
elemObjPtr, NULL);
elemObjPtr, &isNew);
}
entryPtr = Tcl_NextHashEntry(&search);
}
@@ -1259,7 +1259,7 @@ TclInfoFrame(
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *tmpObj;
Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to
Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to
* the dict. */
int lc = 0;
/*
@@ -1304,7 +1304,7 @@ TclInfoFrame(
break;
case TCL_LOCATION_PREBC:
precompiled:
precompiled:
/*
* Precompiled. Result contains the type as signal, nothing else.
*/
@@ -1607,7 +1607,7 @@ InfoLevelCmd(
}
for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr;
framePtr=framePtr->callerVarPtr) {
if (framePtr->level == level) {
if ((int)framePtr->level == level) {
break;
}
}
@@ -2327,14 +2327,22 @@ Tcl_LassignObjCmd(
}
if (listObjc > 0) {
Tcl_Obj *resultObj = NULL;
Tcl_Size first = origListObjc - listObjc;
Tcl_Size last = origListObjc - 1;
int result = Tcl_ListObjRange(interp, listPtr, first, last, &resultObj);
if (result != TCL_OK) {
return result;
Tcl_Obj *resultObjPtr = NULL;
Tcl_Size fromIdx = origListObjc - listObjc;
Tcl_Size toIdx = origListObjc - 1;
if (TclObjTypeHasProc(listPtr, sliceProc)) {
if (TclObjTypeSlice(
interp, listPtr, fromIdx, toIdx, &resultObjPtr) != TCL_OK) {
return TCL_ERROR;
}
} else {
resultObjPtr = TclListObjRange(
interp, listPtr, origListObjc - listObjc, origListObjc - 1);
if (resultObjPtr == NULL) {
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, resultObj);
Tcl_SetObjResult(interp, resultObjPtr);
}
return TCL_OK;
@@ -2419,7 +2427,7 @@ int
Tcl_LinsertObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
@@ -2512,8 +2520,9 @@ int
Tcl_ListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* The argument objects. */
{
/*
* If there are no list elements, the result is an empty object.
@@ -2548,7 +2557,8 @@ Tcl_LlengthObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
Tcl_Size listLen;
int result;
@@ -2596,7 +2606,8 @@ Tcl_LpopObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
Tcl_Size listLen;
int copied = 0, result;
@@ -2714,7 +2725,8 @@ Tcl_LrangeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
int result;
Tcl_Size listLen, first, last;
@@ -2740,12 +2752,22 @@ Tcl_LrangeObjCmd(
return result;
}
Tcl_Obj *resultObj;
result = Tcl_ListObjRange(interp, objv[1], first, last, &resultObj);
if (result == TCL_OK) {
if (TclObjTypeHasProc(objv[1], sliceProc)) {
Tcl_Obj *resultObj;
int status = TclObjTypeSlice(interp, objv[1], first, last, &resultObj);
if (status == TCL_OK) {
Tcl_SetObjResult(interp, resultObj);
} else {
return TCL_ERROR;
}
} else {
Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
if (resultObj == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, resultObj);
}
return result;
return TCL_OK;
}
/*
@@ -2915,27 +2937,96 @@ int
Tcl_LrepeatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* The argument objects. */
{
Tcl_Size repeatCount;
Tcl_Obj *resultPtr;
Tcl_WideInt elementCount, i;
Tcl_Size totalElems;
Tcl_Obj *listPtr, **dataArray = NULL;
/*
* Check arguments for legality:
* lrepeat count ?value ...?
*/
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
return TCL_ERROR;
}
if (Tcl_GetSizeIntFromObj(interp, objv[1], &repeatCount) != TCL_OK) {
if (TCL_OK != TclGetWideIntFromObj(interp, objv[1], &elementCount)) {
return TCL_ERROR;
}
if (elementCount < 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", elementCount));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
(char *)NULL);
return TCL_ERROR;
}
if (Tcl_ListObjRepeat(
interp, repeatCount, objc - 2, objv + 2, &resultPtr) != TCL_OK) {
/*
* Skip forward to the interesting arguments now we've finished parsing.
*/
objc -= 2;
objv += 2;
/* Final sanity check. Do not exceed limits on max list length. */
if (elementCount && objc > LIST_MAX/elementCount) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", LIST_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
return TCL_ERROR;
}
totalElems = objc * elementCount;
Tcl_SetObjResult(interp, resultPtr);
/*
* Get an empty list object that is allocated large enough to hold each
* init value elementCount times.
*/
listPtr = Tcl_NewListObj(totalElems, NULL);
if (totalElems) {
ListRep listRep;
ListObjGetRep(listPtr, &listRep);
dataArray = ListRepElementsBase(&listRep);
listRep.storePtr->numUsed = totalElems;
if (listRep.spanPtr) {
/* Future proofing in case Tcl_NewListObj returns a span */
listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
}
}
/*
* Set the elements. Note that we handle the common degenerate case of a
* single value being repeated separately to permit the compiler as much
* room as possible to optimize a loop that might be run a very large
* number of times.
*/
CLANG_ASSERT(dataArray || totalElems == 0 );
if (objc == 1) {
Tcl_Obj *tmpPtr = objv[0];
tmpPtr->refCount += elementCount;
for (i=0 ; i<elementCount ; i++) {
dataArray[i] = tmpPtr;
}
} else {
Tcl_Size j, k = 0;
for (i=0 ; i<elementCount ; i++) {
for (j=0 ; j<objc ; j++) {
Tcl_IncrRefCount(objv[j]);
dataArray[k++] = objv[j];
}
}
}
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -3066,16 +3157,82 @@ Tcl_LreverseObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tcl_Obj **elemv;
Tcl_Size elemc, i, j;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
Tcl_Obj *resultObj = NULL;
if (Tcl_ListObjReverse(interp, objv[1], &resultObj) != TCL_OK) {
/*
* Handle AbstractList special case - do not shimmer into a list, if it
* supports a private Reverse function, just to reverse it.
*/
if (TclObjTypeHasProc(objv[1], reverseProc)) {
Tcl_Obj *resultObj;
if (TclObjTypeReverse(interp, objv[1], &resultObj) == TCL_OK) {
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
} /* end Abstract List */
if (TclListObjLength(interp, objv[1], &elemc) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, resultObj);
/*
* If the list is empty, just return it. [Bug 1876793]
*/
if (!elemc) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_IsShared(objv[1])
|| ListObjRepIsShared(objv[1])) { /* Bug 1675044 */
Tcl_Obj *resultObj, **dataArray;
ListRep listRep;
resultObj = Tcl_NewListObj(elemc, NULL);
/* Modify the internal rep in-place */
ListObjGetRep(resultObj, &listRep);
listRep.storePtr->numUsed = elemc;
dataArray = ListRepElementsBase(&listRep);
if (listRep.spanPtr) {
/* Future proofing */
listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
}
for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
dataArray[j] = elemv[i];
Tcl_IncrRefCount(elemv[i]);
}
Tcl_SetObjResult(interp, resultObj);
} else {
/*
* Not shared, so swap "in place". This relies on Tcl_LOGE above
* returning a pointer to the live array of Tcl_Obj values.
*/
for (i=0,j=elemc-1 ; i<j ; i++,j--) {
Tcl_Obj *tmp = elemv[i];
elemv[i] = elemv[j];
elemv[j] = tmp;
}
TclInvalidateStringRep(objv[1]);
Tcl_SetObjResult(interp, objv[1]);
}
return TCL_OK;
}
@@ -3352,8 +3509,6 @@ Tcl_LsearchObjCmd(
}
break;
}
default:
TCL_UNREACHABLE();
}
}
@@ -3774,7 +3929,7 @@ Tcl_LsearchObjCmd(
} else if (returnSubindices && (sortInfo.indexc == 0) && (groupSize > 1)) {
Tcl_BounceRefCount(itemPtr);
itemPtr = listv[i + groupOffset];
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else if (groupSize > 1) {
Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
groupSize, &listv[i]);
@@ -3822,8 +3977,8 @@ Tcl_LsearchObjCmd(
}
Tcl_SetObjResult(interp, itemPtr);
} else {
Tcl_Obj *elObj;
TclNewIndexObj(elObj, index);
Tcl_Obj *elObj;
TclNewIndexObj(elObj, index);
Tcl_SetObjResult(interp, elObj);
}
} else if (index < 0) {
@@ -3882,11 +4037,11 @@ Tcl_LsearchObjCmd(
static SequenceDecoded
SequenceIdentifyArgument(
Tcl_Interp *interp, /* for error reporting */
Tcl_Obj *argPtr, /* Argument to decode */
int allowedArgs, /* Flags if keyword or numeric allowed. */
Tcl_Obj **numValuePtr, /* Return numeric value */
int *keywordIndexPtr) /* Return keyword enum */
Tcl_Interp *interp, /* for error reporting */
Tcl_Obj *argPtr, /* Argument to decode */
int allowedArgs, /* Flags if keyword or numeric allowed. */
Tcl_Obj **numValuePtr, /* Return numeric value */
int *keywordIndexPtr) /* Return keyword enum */
{
int result = TCL_ERROR;
SequenceOperators opmode;
@@ -3895,7 +4050,7 @@ SequenceIdentifyArgument(
if (allowedArgs & NumericArg) {
/* speed-up a bit (and avoid shimmer for compiled expressions) */
if (TclHasInternalRep(argPtr, &tclExprCodeType)) {
goto doExpr;
goto doExpr;
}
result = Tcl_GetNumberFromObj(NULL, argPtr, &internalPtr, keywordIndexPtr);
if (result == TCL_OK) {
@@ -3906,13 +4061,13 @@ SequenceIdentifyArgument(
}
if (allowedArgs & RangeKeywordArg) {
result = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
"range operation", 0, &opmode);
"range operation", 0, &opmode);
}
if (result == TCL_OK) {
if (allowedArgs & LastArg) {
/* keyword found, but no followed number */
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"missing \"%s\" value.", TclGetString(argPtr)));
"missing \"%s\" value.", TclGetString(argPtr)));
return ErrArg;
}
*keywordIndexPtr = opmode;
@@ -3930,7 +4085,8 @@ SequenceIdentifyArgument(
int keyword;
/* Determine if result of expression is double or int */
if (Tcl_GetNumberFromObj(interp, exprValueObj, &internalPtr,
&keyword) != TCL_OK) {
&keyword) != TCL_OK
) {
return ErrArg;
}
*numValuePtr = exprValueObj; /* incremented in Tcl_ExprObj */
@@ -3978,9 +4134,9 @@ SequenceIdentifyArgument(
int
Tcl_LseqObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *elementCount = NULL;
Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
@@ -3995,8 +4151,8 @@ Tcl_LseqObjCmd(
SequenceDecoded decoded;
int i, arg_key = 0, value_i = 0;
/* Default constants */
#define zero ((Interp *)interp)->execEnvPtr->constants[0];
#define one ((Interp *)interp)->execEnvPtr->constants[1];
#define zero ((Interp *)interp)->execEnvPtr->constants[0];
#define one ((Interp *)interp)->execEnvPtr->constants[1];
/*
* Create a decoding key by looping through the arguments and identify
@@ -4011,19 +4167,19 @@ Tcl_LseqObjCmd(
arg_key = (arg_key * 10);
numValues[value_i] = NULL;
decoded = SequenceIdentifyArgument(interp, objv[i],
allowedArgs | (i == objc-1 ? LastArg : 0),
&numberObj, &keyword);
allowedArgs | (i == objc-1 ? LastArg : 0),
&numberObj, &keyword);
switch (decoded) {
case NoneArg:
case NoneArg:
/*
* Unrecognizable argument
* Reproduce operation error message
*/
status = Tcl_GetIndexFromObj(interp, objv[i], seq_operations,
"operation", 0, &opmode);
"operation", 0, &opmode);
goto done;
case NumericArg:
case NumericArg:
remNums--;
arg_key += NumericArg;
allowedArgs = RangeKeywordArg;
@@ -4039,14 +4195,14 @@ Tcl_LseqObjCmd(
value_i++;
break;
case RangeKeywordArg:
case RangeKeywordArg:
arg_key += RangeKeywordArg;
allowedArgs = NumericArg; /* after keyword always numeric only */
values[value_i] = keyword; /* SequenceOperators */
value_i++;
break;
default: /* Error state */
default: /* Error state */
status = TCL_ERROR;
goto done;
}
@@ -4128,8 +4284,10 @@ Tcl_LseqObjCmd(
case LSEQ_BY:
/* Error case */
goto syntax;
break;
default:
goto syntax;
break;
}
break;
@@ -4147,6 +4305,7 @@ Tcl_LseqObjCmd(
case LSEQ_COUNT:
default:
goto syntax;
break;
}
break;
@@ -4161,6 +4320,7 @@ Tcl_LseqObjCmd(
break;
default:
goto syntax;
break;
}
opmode = (SequenceOperators)values[1];
switch (opmode) {
@@ -4175,14 +4335,16 @@ Tcl_LseqObjCmd(
break;
default:
goto syntax;
break;
}
break;
/* All other argument errors */
default:
syntax:
Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
goto done;
syntax:
Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
goto done;
break;
}
/* Count needs to be integer, so try to convert if possible */
@@ -4211,7 +4373,7 @@ Tcl_LseqObjCmd(
* Success! Now lets create the series object.
*/
arithSeriesPtr = TclNewArithSeriesObj(interp,
useDoubles, start, end, step, elementCount);
useDoubles, start, end, step, elementCount);
status = TCL_ERROR;
if (arithSeriesPtr) {
@@ -4219,7 +4381,7 @@ Tcl_LseqObjCmd(
Tcl_SetObjResult(interp, arithSeriesPtr);
}
done:
done:
// Free number arguments.
while (--value_i>=0) {
if (numValues[value_i]) {
@@ -4234,8 +4396,8 @@ Tcl_LseqObjCmd(
}
/* Undef constants */
#undef zero
#undef one
#undef zero
#undef one
return status;
}
@@ -4296,13 +4458,13 @@ Tcl_LsetObjCmd(
} else {
if (TclObjTypeHasProc(listPtr, setElementProc)) {
finalValuePtr = TclObjTypeSetElement(interp, listPtr,
objc-3, objv+2, objv[objc-1]);
objc-3, objv+2, objv[objc-1]);
if (finalValuePtr) {
Tcl_IncrRefCount(finalValuePtr);
}
} else {
finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
objv[objc-1]);
objv[objc-1]);
}
}
@@ -4528,8 +4690,6 @@ Tcl_LsortObjCmd(
group = 1;
i++;
break;
default:
TCL_UNREACHABLE();
}
}
if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
@@ -5202,7 +5362,7 @@ DictionaryCompare(
int secondaryDiff = 0;
while (1) {
if (isdigit(UCHAR(*right)) /* INTL: digit */
if (isdigit(UCHAR(*right)) /* INTL: digit */
&& isdigit(UCHAR(*left))) { /* INTL: digit */
/*
* There are decimal numbers embedded in the two strings. Compare
+25 -163
View File
@@ -21,7 +21,6 @@
#include "tclRegexp.h"
#include "tclStringTrim.h"
#include "tclTomMath.h"
#include "../utf8proc/utf8proc.h"
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
@@ -133,8 +132,7 @@ Tcl_RegexpObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size offset, stringLength, matchLength, cflags, eflags;
Tcl_Size i;
int indices, match, about, all, doinline, numMatchesSaved;
int i, indices, match, about, all, doinline, numMatchesSaved;
Tcl_RegExp regExpr;
Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
Tcl_RegExpInfo info;
@@ -213,8 +211,6 @@ Tcl_RegexpObjCmd(
case REGEXP_LAST:
i++;
goto endOfForLoop;
default:
TCL_UNREACHABLE();
}
}
@@ -379,7 +375,7 @@ Tcl_RegexpObjCmd(
* area. (Scriptics Bug 4391/SF Bug #219232)
*/
if (i <= info.nsubs && info.matches[i].start >= 0) {
if (i <= (int)info.nsubs && info.matches[i].start >= 0) {
start = offset + info.matches[i].start;
end = offset + info.matches[i].end;
@@ -401,7 +397,7 @@ Tcl_RegexpObjCmd(
newPtr = Tcl_NewListObj(2, objs);
} else {
if ((i <= info.nsubs) && (info.matches[i].end > 0)) {
if ((i <= (int)info.nsubs) && (info.matches[i].end > 0)) {
newPtr = Tcl_GetRange(objPtr,
offset + info.matches[i].start,
offset + info.matches[i].end - 1);
@@ -570,8 +566,6 @@ Tcl_RegsubObjCmd(
case REGSUB_LAST:
idx++;
goto endOfForLoop;
default:
TCL_UNREACHABLE();
}
}
@@ -1325,20 +1319,13 @@ StringFirstCmd(
}
if (objc == 4) {
Tcl_Size end = Tcl_AttemptGetCharLength(objv[2]) - 1;
if (end == -1) {
return TclCannotAllocateError(interp, objv[2]);
}
Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1;
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) {
return TCL_ERROR;
}
}
Tcl_Obj *objPtr = TclStringFirst(objv[1], objv[2], start);
if (!objPtr) {
return TclCannotAllocateError(interp, objPtr);
}
Tcl_SetObjResult(interp, objPtr);
Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
return TCL_OK;
}
@@ -1593,8 +1580,6 @@ StringIsCmd(
}
failVarObj = objv[++i];
break;
default:
TCL_UNREACHABLE();
}
}
}
@@ -1892,8 +1877,6 @@ StringIsCmd(
case STR_IS_XDIGIT:
chcomp = UniCharIsHexDigit;
break;
default:
TCL_UNREACHABLE();
}
if (chcomp != NULL) {
@@ -1921,7 +1904,7 @@ StringIsCmd(
* valid fail index (>= 0).
*/
str_is_done:
str_is_done:
if ((result == 0) && (failVarObj != NULL)) {
TclNewIndexObj(objPtr, failat);
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) {
@@ -2057,8 +2040,8 @@ StringMapCmd(
* The charMap must be an even number of key/value items.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"char map list unbalanced", -1));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("char map list unbalanced", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
"UNBALANCED", (char *)NULL);
return TCL_ERROR;
@@ -2310,11 +2293,7 @@ StringRangeCmd(
* 'end' refers to the last character, not one past it.
*/
end = Tcl_AttemptGetCharLength(objv[1]);
if (end < 0) {
return TclCannotAllocateError(interp, objv[1]);
}
end--;
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
@@ -2490,11 +2469,7 @@ StringRevCmd(
return TCL_ERROR;
}
Tcl_Obj *objPtr = TclStringReverse(objv[1], TCL_STRING_IN_PLACE);
if (!objPtr) {
return TclCannotAllocateError(interp, objv[1]);
}
Tcl_SetObjResult(interp, objPtr);
Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
return TCL_OK;
}
@@ -2706,10 +2681,6 @@ StringEqualCmd(
objv += objc-2;
match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength);
if (match == INT_MIN) {
Tcl_AppendResult(interp, "memory allocation error", (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
return TCL_OK;
}
@@ -2755,10 +2726,6 @@ StringCmpCmd(
objv += objc-2;
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
if (match == INT_MIN) {
Tcl_AppendResult(interp, "memory allocation error", (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
return TCL_OK;
}
@@ -3370,18 +3337,12 @@ TclSubstOptions(
int *flagPtr)
{
static const char *const substOptions[] = {
"-backslashes", "-commands", "-variables",
"-nobackslashes", "-nocommands", "-novariables", NULL
};
static const int optionFlags[] = {
TCL_SUBST_BACKSLASHES, /* -backslashes */
TCL_SUBST_COMMANDS, /* -commands */
TCL_SUBST_VARIABLES, /* -variables */
TCL_SUBST_BACKSLASHES << 16, /* -nobackslashes */
TCL_SUBST_COMMANDS << 16, /* -nocommands */
TCL_SUBST_VARIABLES << 16 /* -novariables */
TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES
};
int flags = numOpts ? 0 : TCL_SUBST_ALL;
int flags = TCL_SUBST_ALL;
for (Tcl_Size i = 0; i < numOpts; i++) {
int optionIndex;
@@ -3390,18 +3351,7 @@ TclSubstOptions(
&optionIndex) != TCL_OK) {
return TCL_ERROR;
}
flags |= optionFlags[optionIndex];
}
if (flags >> 16) { /* negative options specified */
if (flags & 0xFFFF) { /* positive options specified too */
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot combine positive and negative options", -1));
}
return TCL_ERROR;
}
/* mask default flags using negative options */
flags = TCL_SUBST_ALL & ~(flags >> 16);
flags &= ~optionFlags[optionIndex];
}
*flagPtr = flags;
return TCL_OK;
@@ -3428,7 +3378,6 @@ TclNRSubstObjCmd(
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-backslashes? ?-commands? ?-variables? "
"?-nobackslashes? ?-nocommands? ?-novariables? string");
return TCL_ERROR;
}
@@ -3891,7 +3840,7 @@ TclNRSwitchObjCmd(
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
int bline = ctxPtr->line[bidx];
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
ctxPtr->nline = objc;
TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
@@ -3905,7 +3854,7 @@ TclNRSwitchObjCmd(
int k;
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
ctxPtr->nline = objc;
for (k=0; k < objc; k++) {
ctxPtr->line[k] = -1;
@@ -4237,8 +4186,6 @@ Tcl_TimeRateObjCmd(
break;
case TMRT_LAST:
break;
default:
TCL_UNREACHABLE();
}
}
@@ -4324,7 +4271,7 @@ Tcl_TimeRateObjCmd(
maxms = -1000;
do {
lastMeasureOverhead = measureOverhead;
TclNewIntObj(clobjv[i], maxms);
TclNewIntObj(clobjv[i], (int) maxms);
Tcl_IncrRefCount(clobjv[i]);
result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
Tcl_DecrRefCount(clobjv[i]);
@@ -4463,7 +4410,7 @@ Tcl_TimeRateObjCmd(
*/
threshold = 1;
maxcnt = 0;
TCL_FALLTHROUGH();
/* FALLTHRU */
case TCL_CONTINUE:
result = TCL_OK;
break;
@@ -4552,8 +4499,7 @@ Tcl_TimeRateObjCmd(
lastIterTm = avgIterTm;
}
estIterTm *= lastIterTm;
last = middle;
lastCount = count;
last = middle; lastCount = count;
/*
* Calculate next threshold to check.
@@ -4561,10 +4507,10 @@ Tcl_TimeRateObjCmd(
* considering last known iteration growth factor.
*/
threshold = (Tcl_WideUInt)(stop - middle) * TR_SCALE;
/*
* Estimated count of iteration til the end of execution.
* Thereby 2.5% longer execution time would be OK.
*/
/*
* Estimated count of iteration til the end of execution.
* Thereby 2.5% longer execution time would be OK.
*/
if (threshold / estIterTm < 0.975) {
/* estimated time for next iteration is too large */
break;
@@ -4890,8 +4836,6 @@ TclNRTryObjCmd(
haveHandlers = 1;
i += 3;
break;
default:
TCL_UNREACHABLE();
}
}
if (bodyShared) {
@@ -5393,10 +5337,10 @@ TclListLines(
Tcl_Obj *listObj, /* Pointer to obj holding a string with list
* structure. Assumed to be valid. Assumed to
* contain n elements. */
int line, /* Line the list as a whole starts on. */
Tcl_Size line, /* Line the list as a whole starts on. */
Tcl_Size n, /* #elements in lines */
int *lines, /* Array of line numbers, to fill. */
Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
Tcl_Size *lines, /* Array of line numbers, to fill. */
Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
* derived continuation data */
{
const char *listStr = TclGetString(listObj);
@@ -5427,88 +5371,6 @@ TclListLines(
}
}
}
/*
* TclUnicodeNormalizeCmd --
*
* This procedure implements the "unicode tonfc|tonfd|tonfkc|tonfkd"
* commands. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Stores the normalized string in the interpreter result.
*/
static int
TclUnicodeNormalizeCmd(
void *clientData, /* TCL_{NFC,NFD,NFKC,NFKD} */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *optNames[] = {"-profile", NULL};
enum { OPT_PROFILE } opt;
int profile = TCL_ENCODING_PROFILE_STRICT;
if (objc == 4) {
if (Tcl_GetIndexFromObj(interp, objv[1], optNames, "option", 0, &opt) !=
TCL_OK) {
return TCL_ERROR;
}
const char *s = Tcl_GetString(objv[2]);
if (!strcmp(s, "replace")) {
profile = TCL_ENCODING_PROFILE_REPLACE;
} else if (!strcmp(s, "strict")) {
profile = TCL_ENCODING_PROFILE_STRICT;
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Invalid value \"%s\" supplied for option \"-profile\". "
"Must be \"strict\" or \"replace\".", s));
return TCL_ERROR;
}
} else if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?-profile PROFILE? STRING");
return TCL_ERROR;
}
Tcl_DString ds;
if (Tcl_UtfToNormalizedDString(interp, Tcl_GetString(objv[objc - 1]),
TCL_INDEX_NONE, (Tcl_UnicodeNormalizationForm)PTR2INT(clientData), profile,
&ds) != TCL_OK) {
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
/*
* TclInitUnicodeCmd --
*
* This procedure creates the "unicode" Tcl ensemble command. See user
* documentation for details on implemented commands.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Stores the result in the interpreter result.
*/
Tcl_Command
TclInitUnicodeCmd(
Tcl_Interp *interp)
{
static const EnsembleImplMap unicodeImplMap[] = {
{"tonfc", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFC, 0},
{"tonfd", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFD, 0},
{"tonfkc", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFKC, 0},
{"tonfkd", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFKD, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "unicode", unicodeImplMap);
}
/*
* Local Variables:
+1060 -821
View File
File diff suppressed because it is too large Load Diff
+488 -1028
View File
File diff suppressed because it is too large Load Diff
+1275 -1975
View File
File diff suppressed because it is too large Load Diff
+191 -182
View File
@@ -61,11 +61,11 @@ typedef struct {
*/
enum OperandTypes {
OT_LITERAL = -3, /* Operand is a literal in the literal list */
OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */
OT_EMPTY = -1 /* "Operand" is an empty string. This is a
* special case used only to represent the
* EMPTY lexeme. See below. */
OT_LITERAL = -3, /* Operand is a literal in the literal list */
OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */
OT_EMPTY = -1 /* "Operand" is an empty string. This is a special
* case used only to represent the EMPTY lexeme. See
* below. */
};
/*
@@ -106,9 +106,9 @@ enum OperandTypes {
*/
enum Marks {
MARK_LEFT, /* Next step of traversal is to visit left subtree */
MARK_RIGHT, /* Next step of traversal is to visit right subtree */
MARK_PARENT /* Next step of traversal is to return to parent */
MARK_LEFT, /* Next step of traversal is to visit left subtree */
MARK_RIGHT, /* Next step of traversal is to visit right subtree */
MARK_PARENT /* Next step of traversal is to return to parent */
};
/*
@@ -162,7 +162,7 @@ enum LexemeCodes {
* FUNCTION or a parse error according to
* context and value. */
INCOMPLETE = 4, /* A parse error. Used only when the single
* "=" is encountered. */
* "=" is encountered. */
INVALID = 5, /* A parse error. Used when any punctuation
* appears that's not a supported operator. */
COMMENT = 6, /* Comment. Lasts to end of line or end of
@@ -223,7 +223,7 @@ enum LexemeCodes {
* that this operator can only legally appear
* at the right places within a function call
* argument list are hard coded within
* ParseExpr(). */
* ParseExpr(). */
MULT = BINARY | 4,
DIVIDE = BINARY | 5,
MOD = BINARY | 6,
@@ -292,24 +292,24 @@ enum LexemeCodes {
*/
enum Precedence {
PREC_END = 1, /* END */
PREC_START, /* START */
PREC_CLOSE_PAREN, /* ")" */
PREC_OPEN_PAREN, /* "(" */
PREC_COMMA, /* "," */
PREC_CONDITIONAL, /* "?", ":" */
PREC_OR, /* "||" */
PREC_AND, /* "&&" */
PREC_BIT_OR, /* "|" */
PREC_BIT_XOR, /* "^" */
PREC_BIT_AND, /* "&" */
PREC_EQUAL, /* "==", "!=", "eq", "ne", "in", "ni" */
PREC_COMPARE, /* "<", ">", "<=", ">=" */
PREC_SHIFT, /* "<<", ">>" */
PREC_ADD, /* "+", "-" */
PREC_MULT, /* "*", "/", "%" */
PREC_EXPON, /* "**" */
PREC_UNARY /* "+", "-", FUNCTION, "!", "~" */
PREC_END = 1, /* END */
PREC_START, /* START */
PREC_CLOSE_PAREN, /* ")" */
PREC_OPEN_PAREN, /* "(" */
PREC_COMMA, /* "," */
PREC_CONDITIONAL, /* "?", ":" */
PREC_OR, /* "||" */
PREC_AND, /* "&&" */
PREC_BIT_OR, /* "|" */
PREC_BIT_XOR, /* "^" */
PREC_BIT_AND, /* "&" */
PREC_EQUAL, /* "==", "!=", "eq", "ne", "in", "ni" */
PREC_COMPARE, /* "<", ">", "<=", ">=" */
PREC_SHIFT, /* "<<", ">>" */
PREC_ADD, /* "+", "-" */
PREC_MULT, /* "*", "/", "%" */
PREC_EXPON, /* "**" */
PREC_UNARY /* "+", "-", FUNCTION, "!", "~" */
};
/*
@@ -326,49 +326,49 @@ static const unsigned char prec[] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,
/* Binary operator lexemes */
PREC_ADD, /* BINARY_PLUS */
PREC_ADD, /* BINARY_MINUS */
PREC_COMMA, /* COMMA */
PREC_MULT, /* MULT */
PREC_MULT, /* DIVIDE */
PREC_MULT, /* MOD */
PREC_COMPARE, /* LESS */
PREC_COMPARE, /* GREATER */
PREC_BIT_AND, /* BIT_AND */
PREC_BIT_XOR, /* BIT_XOR */
PREC_BIT_OR, /* BIT_OR */
PREC_CONDITIONAL, /* QUESTION */
PREC_CONDITIONAL, /* COLON */
PREC_SHIFT, /* LEFT_SHIFT */
PREC_SHIFT, /* RIGHT_SHIFT */
PREC_COMPARE, /* LEQ */
PREC_COMPARE, /* GEQ */
PREC_EQUAL, /* EQUAL */
PREC_EQUAL, /* NEQ */
PREC_AND, /* AND */
PREC_OR, /* OR */
PREC_EQUAL, /* STREQ */
PREC_EQUAL, /* STRNEQ */
PREC_EXPON, /* EXPON */
PREC_EQUAL, /* IN_LIST */
PREC_EQUAL, /* NOT_IN_LIST */
PREC_CLOSE_PAREN, /* CLOSE_PAREN */
PREC_COMPARE, /* STR_LT */
PREC_COMPARE, /* STR_GT */
PREC_COMPARE, /* STR_LEQ */
PREC_COMPARE, /* STR_GEQ */
PREC_END, /* END */
PREC_ADD, /* BINARY_PLUS */
PREC_ADD, /* BINARY_MINUS */
PREC_COMMA, /* COMMA */
PREC_MULT, /* MULT */
PREC_MULT, /* DIVIDE */
PREC_MULT, /* MOD */
PREC_COMPARE, /* LESS */
PREC_COMPARE, /* GREATER */
PREC_BIT_AND, /* BIT_AND */
PREC_BIT_XOR, /* BIT_XOR */
PREC_BIT_OR, /* BIT_OR */
PREC_CONDITIONAL, /* QUESTION */
PREC_CONDITIONAL, /* COLON */
PREC_SHIFT, /* LEFT_SHIFT */
PREC_SHIFT, /* RIGHT_SHIFT */
PREC_COMPARE, /* LEQ */
PREC_COMPARE, /* GEQ */
PREC_EQUAL, /* EQUAL */
PREC_EQUAL, /* NEQ */
PREC_AND, /* AND */
PREC_OR, /* OR */
PREC_EQUAL, /* STREQ */
PREC_EQUAL, /* STRNEQ */
PREC_EXPON, /* EXPON */
PREC_EQUAL, /* IN_LIST */
PREC_EQUAL, /* NOT_IN_LIST */
PREC_CLOSE_PAREN, /* CLOSE_PAREN */
PREC_COMPARE, /* STR_LT */
PREC_COMPARE, /* STR_GT */
PREC_COMPARE, /* STR_LEQ */
PREC_COMPARE, /* STR_GEQ */
PREC_END, /* END */
/* Expansion room for more binary operators */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
/* Unary operator lexemes */
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
PREC_UNARY, /* FUNCTION */
PREC_START, /* START */
PREC_OPEN_PAREN, /* OPEN_PAREN */
PREC_UNARY, /* NOT*/
PREC_UNARY, /* BIT_NOT*/
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
PREC_UNARY, /* FUNCTION */
PREC_START, /* START */
PREC_OPEN_PAREN, /* OPEN_PAREN */
PREC_UNARY, /* NOT*/
PREC_UNARY, /* BIT_NOT*/
};
/*
@@ -383,49 +383,49 @@ static const unsigned char instruction[] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,
/* Binary operator lexemes */
INST_ADD, /* BINARY_PLUS */
INST_SUB, /* BINARY_MINUS */
0, /* COMMA */
INST_MULT, /* MULT */
INST_DIV, /* DIVIDE */
INST_MOD, /* MOD */
INST_LT, /* LESS */
INST_GT, /* GREATER */
INST_BITAND, /* BIT_AND */
INST_BITXOR, /* BIT_XOR */
INST_BITOR, /* BIT_OR */
0, /* QUESTION */
0, /* COLON */
INST_LSHIFT, /* LEFT_SHIFT */
INST_RSHIFT, /* RIGHT_SHIFT */
INST_LE, /* LEQ */
INST_GE, /* GEQ */
INST_EQ, /* EQUAL */
INST_NEQ, /* NEQ */
0, /* AND */
0, /* OR */
INST_STR_EQ, /* STREQ */
INST_STR_NEQ, /* STRNEQ */
INST_EXPON, /* EXPON */
INST_LIST_IN, /* IN_LIST */
INST_LIST_NOT_IN, /* NOT_IN_LIST */
0, /* CLOSE_PAREN */
INST_STR_LT, /* STR_LT */
INST_STR_GT, /* STR_GT */
INST_STR_LE, /* STR_LEQ */
INST_STR_GE, /* STR_GEQ */
0, /* END */
INST_ADD, /* BINARY_PLUS */
INST_SUB, /* BINARY_MINUS */
0, /* COMMA */
INST_MULT, /* MULT */
INST_DIV, /* DIVIDE */
INST_MOD, /* MOD */
INST_LT, /* LESS */
INST_GT, /* GREATER */
INST_BITAND, /* BIT_AND */
INST_BITXOR, /* BIT_XOR */
INST_BITOR, /* BIT_OR */
0, /* QUESTION */
0, /* COLON */
INST_LSHIFT, /* LEFT_SHIFT */
INST_RSHIFT, /* RIGHT_SHIFT */
INST_LE, /* LEQ */
INST_GE, /* GEQ */
INST_EQ, /* EQUAL */
INST_NEQ, /* NEQ */
0, /* AND */
0, /* OR */
INST_STR_EQ, /* STREQ */
INST_STR_NEQ, /* STRNEQ */
INST_EXPON, /* EXPON */
INST_LIST_IN, /* IN_LIST */
INST_LIST_NOT_IN, /* NOT_IN_LIST */
0, /* CLOSE_PAREN */
INST_STR_LT, /* STR_LT */
INST_STR_GT, /* STR_GT */
INST_STR_LE, /* STR_LEQ */
INST_STR_GE, /* STR_GEQ */
0, /* END */
/* Expansion room for more binary operators */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
/* Unary operator lexemes */
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
0, /* FUNCTION */
0, /* START */
0, /* OPEN_PAREN */
INST_LNOT, /* NOT*/
INST_BITNOT, /* BIT_NOT*/
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
0, /* FUNCTION */
0, /* START */
0, /* OPEN_PAREN */
INST_LNOT, /* NOT*/
INST_BITNOT, /* BIT_NOT*/
};
/*
@@ -721,7 +721,7 @@ ParseExpr(
* is a legal literal boolean value, we accept that as well.
*/
if (literal && start[scanned+TclParseAllWhiteSpace(
if (start[scanned+TclParseAllWhiteSpace(
start+scanned, numBytes-scanned)] == '(') {
lexeme = FUNCTION;
@@ -733,14 +733,14 @@ ParseExpr(
*/
Tcl_ListObjAppendElement(NULL, funcList, literal);
} else if (literal && Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
lexeme = BOOL_LIT;
} else {
/*
* Tricky case: see test expr-62.10
*/
Tcl_Size scanned2 = scanned;
int scanned2 = scanned;
do {
scanned2 += TclParseAllWhiteSpace(
start + scanned2, numBytes - scanned2);
@@ -748,7 +748,7 @@ ParseExpr(
start + scanned2, numBytes - scanned2, &lexeme,
NULL);
} while (lexeme == COMMENT);
if (literal && lexeme == OPEN_PAREN) {
if (lexeme == OPEN_PAREN) {
/*
* Actually a function call, but with obscuring
* comments. Skip to the start of the parentheses.
@@ -762,9 +762,7 @@ ParseExpr(
break;
}
if (literal) {
Tcl_DecrRefCount(literal);
}
Tcl_DecrRefCount(literal);
msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
(int)((scanned < limit) ? scanned : limit - 3), start,
(scanned < limit) ? "" : "...");
@@ -787,16 +785,14 @@ ParseExpr(
switch (start[1]) {
case 'b':
Tcl_AppendToObj(post,
" (invalid binary number?)",
TCL_AUTO_LENGTH);
" (invalid binary number?)", -1);
parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
errCode = "BADNUMBER";
subErrCode = "BINARY";
break;
case 'o':
Tcl_AppendToObj(post,
" (invalid octal number?)",
TCL_AUTO_LENGTH);
" (invalid octal number?)", -1);
parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
errCode = "BADNUMBER";
subErrCode = "OCTAL";
@@ -804,8 +800,7 @@ ParseExpr(
default:
if (isdigit(UCHAR(start[1]))) {
Tcl_AppendToObj(post,
" (invalid octal number?)",
TCL_AUTO_LENGTH);
" (invalid octal number?)", -1);
parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
errCode = "BADNUMBER";
subErrCode = "OCTAL";
@@ -847,7 +842,7 @@ ParseExpr(
Tcl_Token *tokenPtr;
const char *end = start;
Tcl_Size wordIndex;
int wordIndex;
int code = TCL_OK;
/*
@@ -1454,7 +1449,7 @@ ParseExpr(
*/
if (post != NULL) {
Tcl_AppendToObj(msg, ";\n", TCL_AUTO_LENGTH);
Tcl_AppendToObj(msg, ";\n", -1);
Tcl_AppendObjToObj(msg, post);
Tcl_DecrRefCount(post);
}
@@ -1509,13 +1504,13 @@ ConvertTreeToTokens(
Tcl_Token *tokenPtr,
Tcl_Parse *parsePtr)
{
Tcl_Size subExprTokenIdx = 0;
int subExprTokenIdx = 0;
OpNode *nodePtr = nodes;
int next = nodePtr->right;
while (1) {
Tcl_Token *subExprTokenPtr;
Tcl_Size scanned, parentIdx;
int scanned, parentIdx;
unsigned char lexeme;
/*
@@ -1582,7 +1577,7 @@ ConvertTreeToTokens(
* do better.
*/
Tcl_Size toCopy = tokenPtr->numComponents + 1;
int toCopy = tokenPtr->numComponents + 1;
if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
/*
@@ -1798,7 +1793,7 @@ ConvertTreeToTokens(
*/
subExprTokenPtr->numComponents =
(parsePtr->numTokens - subExprTokenIdx) - 1;
((int)parsePtr->numTokens - subExprTokenIdx) - 1;
/*
* Finally, as we return up the tree to our parent, pop the
@@ -1861,10 +1856,10 @@ Tcl_ParseExpr(
{
int code;
OpNode *opTree = NULL; /* Will point to the tree of operators. */
Tcl_Obj *litList; /* List to hold the literals. */
Tcl_Obj *funcList; /* List to hold the functon names. */
Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp,
sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */
Tcl_Obj *litList; /* List to hold the literals. */
Tcl_Obj *funcList; /* List to hold the functon names. */
Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
/* Holds the Tcl_Tokens of substitutions. */
TclNewObj(litList);
TclNewObj(funcList);
@@ -2087,10 +2082,7 @@ ParseLexeme(
number:
*lexemePtr = NUMBER;
if (literalPtr) {
if(!TclAttemptInitStringRep(literal, start, end-start)) {
Tcl_DecrRefCount(literal);
literal = NULL;
}
TclInitStringRep(literal, start, end-start);
*literalPtr = literal;
} else {
Tcl_DecrRefCount(literal);
@@ -2276,7 +2268,7 @@ ExecConstantExprTree(
TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
0 /* optimize */);
OP( DONE);
TclEmitOpcode(INST_DONE, envPtr);
byteCodePtr = TclInitByteCode(envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
@@ -2341,12 +2333,19 @@ CompileExprTree(
switch (nodePtr->lexeme) {
case FUNCTION: {
Tcl_Obj *cmdName;
Tcl_DString cmdName;
const char *p;
Tcl_Size length;
TclNewLiteralStringObj(cmdName, "tcl::mathfunc::");
Tcl_AppendObjToObj(cmdName, *funcObjv);
Tcl_DStringInit(&cmdName);
TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
p = TclGetStringFromObj(*funcObjv, &length);
funcObjv++;
PUSH_OBJ_FLAGS(cmdName, LITERAL_CMD_NAME);
Tcl_DStringAppend(&cmdName, p, length);
TclEmitPush(TclRegisterLiteral(envPtr,
Tcl_DStringValue(&cmdName),
Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
Tcl_DStringFree(&cmdName);
/*
* Start a count of the number of words in this function
@@ -2371,7 +2370,7 @@ CompileExprTree(
jumpPtr = newJump;
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
&jumpPtr->jump);
STKDELTA(-1);
TclAdjustStackDepth(-1, envPtr);
if (convert) {
jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
}
@@ -2387,14 +2386,13 @@ CompileExprTree(
break;
}
} else {
Tcl_Size target;
Tcl_BytecodeLabel pc1, pc2;
int pc1, pc2, target;
switch (nodePtr->lexeme) {
case START:
case QUESTION:
if (convert && (nodePtr == rootPtr)) {
OP( TRY_CVT_TO_NUMERIC);
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
}
break;
case OPEN_PAREN:
@@ -2407,7 +2405,11 @@ CompileExprTree(
* command with the correct number of arguments.
*/
INVOKE4( INVOKE_STK, numWords);
if (numWords < 255) {
TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
} else {
TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
}
/*
* Restore any saved numWords value.
@@ -2429,13 +2431,15 @@ CompileExprTree(
jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
convert = 1;
}
target = jumpPtr->jump.codeOffset + 5;
TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump);
target = jumpPtr->jump.codeOffset + 2;
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
target += 3;
}
freePtr = jumpPtr;
jumpPtr = jumpPtr->next;
TclStackFree(interp, freePtr);
TclFixupForwardJump(envPtr, &jumpPtr->jump,
target - jumpPtr->jump.codeOffset);
target - jumpPtr->jump.codeOffset, 127);
freePtr = jumpPtr;
jumpPtr = jumpPtr->next;
@@ -2444,18 +2448,23 @@ CompileExprTree(
case AND:
case OR:
CLANG_ASSERT(jumpPtr);
if (nodePtr->lexeme == AND) {
FWDJUMP( JUMP_FALSE, pc1);
} else {
FWDJUMP( JUMP_TRUE, pc1);
pc1 = CurrentOffset(envPtr);
TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
: INST_JUMP_TRUE1, 0, envPtr);
TclEmitPush(TclRegisterLiteral(envPtr,
(nodePtr->lexeme == AND) ? "1" : "0", 1, 0), envPtr);
pc2 = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP1, 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
envPtr->codeStart + pc1 + 1);
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
pc2 += 3;
}
PUSH_STRING( (nodePtr->lexeme == AND) ? "1" : "0");
FWDJUMP( JUMP, pc2);
STKDELTA(-1);
FWDLABEL(pc1);
TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump);
PUSH_STRING( (nodePtr->lexeme == AND) ? "0" : "1");
FWDLABEL(pc2);
TclEmitPush(TclRegisterLiteral(envPtr,
(nodePtr->lexeme == AND) ? "0" : "1", 1, 0), envPtr);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
envPtr->codeStart + pc2 + 1);
convert = 0;
freePtr = jumpPtr;
jumpPtr = jumpPtr->next;
@@ -2485,7 +2494,9 @@ CompileExprTree(
Tcl_Obj *literal = *litObjv;
if (optimize) {
int idx = PUSH_OBJ_FLAGS(literal, 0);
Tcl_Size length;
const char *bytes = TclGetStringFromObj(literal, &length);
int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
@@ -2506,6 +2517,7 @@ CompileExprTree(
objPtr->internalRep = literal->internalRep;
literal->typePtr = NULL;
}
TclEmitPush(idx, envPtr);
} else {
/*
* When optimize==0, we know the expression is a one-off and
@@ -2516,7 +2528,7 @@ CompileExprTree(
* that preserves internalreps.
*/
PUSH_OBJ( literal);
TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
}
(*litObjvPtr)++;
break;
@@ -2660,8 +2672,7 @@ TclSortingOpCmd(
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
2 * (objc-2) * sizeof(Tcl_Obj *));
OpNode *nodes = (OpNode *)TclStackAlloc(interp,
2 * (objc-2) * sizeof(OpNode));
OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
unsigned char lexeme;
int i, lastAnd = 1;
Tcl_Obj *const *litObjPtrPtr = litObjv;
@@ -2672,30 +2683,29 @@ TclSortingOpCmd(
nodes[0].lexeme = START;
nodes[0].mark = MARK_RIGHT;
for (i=2; i<objc-1; i++) {
int j = 2 * (i - 1);
litObjv[j - 1] = objv[i];
nodes[j - 1].lexeme = lexeme;
nodes[j - 1].mark = MARK_LEFT;
nodes[j - 1].left = OT_LITERAL;
nodes[j - 1].right = OT_LITERAL;
litObjv[2*(i-1)-1] = objv[i];
nodes[2*(i-1)-1].lexeme = lexeme;
nodes[2*(i-1)-1].mark = MARK_LEFT;
nodes[2*(i-1)-1].left = OT_LITERAL;
nodes[2*(i-1)-1].right = OT_LITERAL;
litObjv[j] = objv[i];
nodes[j].lexeme = AND;
nodes[j].mark = MARK_LEFT;
nodes[j].left = lastAnd;
nodes[lastAnd].p.parent = j;
litObjv[2*(i-1)] = objv[i];
nodes[2*(i-1)].lexeme = AND;
nodes[2*(i-1)].mark = MARK_LEFT;
nodes[2*(i-1)].left = lastAnd;
nodes[lastAnd].p.parent = 2*(i-1);
nodes[j].right = j + 1;
nodes[j + 1].p.parent= j;
nodes[2*(i-1)].right = 2*(i-1)+1;
nodes[2*(i-1)+1].p.parent= 2*(i-1);
lastAnd = j;
lastAnd = 2*(i-1);
}
litObjv[2 * (objc - 2) - 1] = objv[objc - 1];
litObjv[2*(objc-2)-1] = objv[objc-1];
nodes[2 * (objc - 2) - 1].lexeme = lexeme;
nodes[2 * (objc - 2) - 1].mark = MARK_LEFT;
nodes[2 * (objc - 2) - 1].left = OT_LITERAL;
nodes[2 * (objc - 2) - 1].right = OT_LITERAL;
nodes[2*(objc-2)-1].lexeme = lexeme;
nodes[2*(objc-2)-1].mark = MARK_LEFT;
nodes[2*(objc-2)-1].left = OT_LITERAL;
nodes[2*(objc-2)-1].right = OT_LITERAL;
nodes[0].right = lastAnd;
nodes[lastAnd].p.parent = 0;
@@ -2789,8 +2799,7 @@ TclVariadicOpCmd(
return code;
} else {
Tcl_Obj *const *litObjv = objv + 1;
OpNode *nodes = (OpNode *)TclStackAlloc(interp,
(objc - 1) * sizeof(OpNode));
OpNode *nodes = (OpNode *)TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
int i, lastOp = OT_LITERAL;
nodes[0].lexeme = START;
+543 -1134
View File
File diff suppressed because it is too large Load Diff
+322 -816
View File
File diff suppressed because it is too large Load Diff
+3 -2
View File
@@ -299,7 +299,8 @@ QueryConfigObjCmd(
return TCL_OK;
default:
TCL_UNREACHABLE();
Tcl_Panic("QueryConfigObjCmd: Unknown subcommand to 'pkgconfig'. This can't happen");
break;
}
return TCL_ERROR;
}
@@ -390,7 +391,7 @@ GetConfigDict(
static void
ConfigDictDeleteProc(
void *clientData, /* Pointer to Tcl_Obj. */
void *clientData, /* Pointer to Tcl_Obj. */
TCL_UNUSED(Tcl_Interp *))
{
Tcl_DecrRefCount((Tcl_Obj *)clientData);
+1 -1
View File
@@ -393,7 +393,7 @@ typedef struct ClockScanToken ClockScanToken;
typedef int ClockScanTokenProc(
ClockFmtScnCmdArgs *opts,
DateInfo *info,
const ClockScanToken *tok);
ClockScanToken *tok);
typedef enum _CLCKTOK_TYPE {
CTOKT_INT = 1, CTOKT_WIDE, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR,
+172 -157
View File
@@ -61,18 +61,18 @@ EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp,
/* 2 */
EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN void * Tcl_Alloc(size_t size);
EXTERN void * Tcl_Alloc(TCL_HASH_TYPE size);
/* 4 */
EXTERN void Tcl_Free(void *ptr);
/* 5 */
EXTERN void * Tcl_Realloc(void *ptr, size_t size);
EXTERN void * Tcl_Realloc(void *ptr, TCL_HASH_TYPE size);
/* 6 */
EXTERN void * Tcl_DbCkalloc(size_t size, const char *file,
EXTERN void * Tcl_DbCkalloc(TCL_HASH_TYPE size, const char *file,
int line);
/* 7 */
EXTERN void Tcl_DbCkfree(void *ptr, const char *file, int line);
/* 8 */
EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t size,
EXTERN void * Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE size,
const char *file, int line);
/* 9 */
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
@@ -107,10 +107,7 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
/* 21 */
EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
int line);
/* 22 */
EXTERN char * Tcl_DbGetStringFromObj(Tcl_Obj *objPtr,
Tcl_Size *lengthPtr, const char *file,
int line);
/* Slot 22 is reserved */
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
Tcl_Size numBytes, const char *file,
@@ -131,9 +128,15 @@ EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes,
EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
EXTERN void TclFreeObj(Tcl_Obj *objPtr);
/* Slot 31 is reserved */
/* Slot 32 is reserved */
/* Slot 33 is reserved */
/* 31 */
EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
int *intPtr);
/* 32 */
EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *intPtr);
/* 33 */
EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
Tcl_Size *numBytesPtr);
/* 34 */
EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
double *doublePtr);
@@ -192,9 +195,7 @@ EXTERN Tcl_Obj * Tcl_NewListObj(Tcl_Size objc, Tcl_Obj *const objv[]);
EXTERN Tcl_Obj * Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, Tcl_Size length);
/* 57 */
EXTERN Tcl_Obj * Tcl_AttemptNewStringObj(const char *bytes,
Tcl_Size length);
/* Slot 57 is reserved */
/* 58 */
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr,
Tcl_Size numBytes);
@@ -204,8 +205,7 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
Tcl_Size numBytes);
/* 60 */
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
EXTERN Tcl_Size Tcl_AttemptGetCharLength(Tcl_Obj *objPtr);
/* Slot 61 is reserved */
/* 62 */
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, Tcl_Size objc,
Tcl_Obj *const objv[]);
@@ -247,7 +247,8 @@ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp,
/* 80 */
EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
void *clientData);
/* Slot 81 is reserved */
/* 81 */
EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
EXTERN int Tcl_CommandComplete(const char *cmd);
/* 83 */
@@ -901,13 +902,9 @@ EXTERN Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src,
/* 339 */
EXTERN Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char * Tcl_AttemptGetStringFromObj(Tcl_Obj *objPtr,
Tcl_Size *lengthPtr);
/* 341 */
EXTERN char * Tcl_AttemptSetStringObj(Tcl_Obj *objPtr,
const char *bytes, Tcl_Size length);
/* 342 */
EXTERN Tcl_Obj * Tcl_AttemptDuplicateObj(Tcl_Obj *objPtr);
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
/* Slot 341 is reserved */
/* Slot 342 is reserved */
/* 343 */
EXTERN void Tcl_AlertNotifier(void *clientData);
/* 344 */
@@ -1039,7 +1036,7 @@ EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr,
Tcl_ThreadCreateProc *proc, void *clientData,
size_t stackSize, int flags);
TCL_HASH_TYPE stackSize, int flags);
/* 394 */
EXTERN Tcl_Size Tcl_ReadRaw(Tcl_Channel chan, char *dst,
Tcl_Size bytesToRead);
@@ -1104,13 +1101,8 @@ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel);
EXTERN int Tcl_IsChannelExisting(const char *channelName);
/* Slot 419 is reserved */
/* Slot 420 is reserved */
/* 421 */
EXTERN Tcl_HashEntry * Tcl_DbCreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr,
const char *file, int line);
/* 422 */
EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr);
/* Slot 421 is reserved */
/* Slot 422 is reserved */
/* 423 */
EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
int keyType, const Tcl_HashKeyType *typePtr);
@@ -1130,14 +1122,14 @@ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp,
const char *varName, int flags,
Tcl_CommandTraceProc *proc, void *clientData);
/* 428 */
EXTERN void * Tcl_AttemptAlloc(size_t size);
EXTERN void * Tcl_AttemptAlloc(TCL_HASH_TYPE size);
/* 429 */
EXTERN void * Tcl_AttemptDbCkalloc(size_t size, const char *file,
int line);
EXTERN void * Tcl_AttemptDbCkalloc(TCL_HASH_TYPE size,
const char *file, int line);
/* 430 */
EXTERN void * Tcl_AttemptRealloc(void *ptr, size_t size);
EXTERN void * Tcl_AttemptRealloc(void *ptr, TCL_HASH_TYPE size);
/* 431 */
EXTERN void * Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
EXTERN void * Tcl_AttemptDbCkrealloc(void *ptr, TCL_HASH_TYPE size,
const char *file, int line);
/* 432 */
EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
@@ -1416,7 +1408,7 @@ EXTERN void Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
/* 531 */
EXTERN void Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
/* 532 */
EXTERN Tcl_Size Tcl_LimitGetCommands(Tcl_Interp *interp);
EXTERN int Tcl_LimitGetCommands(Tcl_Interp *interp);
/* 533 */
EXTERN void Tcl_LimitGetTime(Tcl_Interp *interp,
Tcl_Time *timeLimitPtr);
@@ -1719,7 +1711,7 @@ EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp,
EXTERN void Tcl_FreeInternalRep(Tcl_Obj *objPtr);
/* 637 */
EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
size_t numBytes);
TCL_HASH_TYPE numBytes);
/* 638 */
EXTERN Tcl_ObjInternalRep * Tcl_FetchInternalRep(Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr);
@@ -1882,33 +1874,6 @@ EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue);
EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr,
Tcl_WideUInt uwideValue);
/* 690 */
EXTERN int Tcl_IsEmpty(Tcl_Obj *obj);
/* 691 */
EXTERN const char * Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr);
/* 692 */
EXTERN int Tcl_ListObjReverse(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr);
/* 693 */
EXTERN int Tcl_ListObjRepeat(Tcl_Interp *interp,
Tcl_Size repeatCount, Tcl_Size objc,
Tcl_Obj *const objv[],
Tcl_Obj **resultPtrPtr);
/* 694 */
EXTERN int Tcl_ListObjRange(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Size start, Tcl_Size end,
Tcl_Obj **resultPtrPtr);
/* 695 */
EXTERN int Tcl_UtfToNormalizedDString(Tcl_Interp *interp,
const char *bytes, Tcl_Size length,
Tcl_UnicodeNormalizationForm normForm,
int profile, Tcl_DString *dsPtr);
/* 696 */
EXTERN int Tcl_UtfToNormalized(Tcl_Interp *interp,
const char *bytes, Tcl_Size length,
Tcl_UnicodeNormalizationForm normForm,
int profile, char *bufPtr, Tcl_Size bufLen,
Tcl_Size *lengthPtr);
/* 697 */
EXTERN void TclUnusedStubEntry(void);
typedef struct {
@@ -1924,12 +1889,12 @@ typedef struct TclStubs {
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
void * (*tcl_Alloc) (size_t size); /* 3 */
void * (*tcl_Alloc) (TCL_HASH_TYPE size); /* 3 */
void (*tcl_Free) (void *ptr); /* 4 */
void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */
void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */
void * (*tcl_Realloc) (void *ptr, TCL_HASH_TYPE size); /* 5 */
void * (*tcl_DbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 6 */
void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */
void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */
void * (*tcl_DbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 8 */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
@@ -1943,7 +1908,7 @@ typedef struct TclStubs {
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
char * (*tcl_DbGetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr, const char *file, int line); /* 22 */
void (*reserved22)(void);
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (Tcl_Size objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
@@ -1952,9 +1917,9 @@ typedef struct TclStubs {
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, Tcl_Size length, const char *file, int line); /* 28 */
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
void (*reserved31)(void);
void (*reserved32)(void);
void (*reserved33)(void);
int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *intPtr); /* 31 */
int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
void (*reserved36)(void);
@@ -1978,11 +1943,11 @@ typedef struct TclStubs {
void (*reserved54)(void);
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, Tcl_Size length); /* 56 */
Tcl_Obj * (*tcl_AttemptNewStringObj) (const char *bytes, Tcl_Size length); /* 57 */
void (*reserved57)(void);
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, Tcl_Size numBytes); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size numBytes); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
Tcl_Size (*tcl_AttemptGetCharLength) (Tcl_Obj *objPtr); /* 61 */
void (*reserved61)(void);
void (*tcl_SetListObj) (Tcl_Obj *objPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 62 */
void (*reserved63)(void);
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 64 */
@@ -2002,7 +1967,7 @@ typedef struct TclStubs {
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */
void (*reserved81)(void);
int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
char * (*tcl_Concat) (Tcl_Size argc, const char *const *argv); /* 83 */
Tcl_Size (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
@@ -2261,9 +2226,9 @@ typedef struct TclStubs {
Tcl_Size (*tcl_UtfToUpper) (char *src); /* 337 */
Tcl_Size (*tcl_WriteChars) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 338 */
Tcl_Size (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
char * (*tcl_AttemptGetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 340 */
char * (*tcl_AttemptSetStringObj) (Tcl_Obj *objPtr, const char *bytes, Tcl_Size length); /* 341 */
Tcl_Obj * (*tcl_AttemptDuplicateObj) (Tcl_Obj *objPtr); /* 342 */
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
void (*reserved341)(void);
void (*reserved342)(void);
void (*tcl_AlertNotifier) (void *clientData); /* 343 */
void (*tcl_ServiceModeHook) (int mode); /* 344 */
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
@@ -2314,7 +2279,7 @@ typedef struct TclStubs {
int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); /* 390 */
void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); /* 393 */
int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, TCL_HASH_TYPE stackSize, int flags); /* 393 */
Tcl_Size (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, Tcl_Size bytesToRead); /* 394 */
Tcl_Size (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 395 */
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
@@ -2342,17 +2307,17 @@ typedef struct TclStubs {
int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
void (*reserved419)(void);
void (*reserved420)(void);
Tcl_HashEntry * (*tcl_DbCreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr, const char *file, int line); /* 421 */
Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
void (*reserved421)(void);
void (*reserved422)(void);
void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */
int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */
void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */
void * (*tcl_AttemptAlloc) (size_t size); /* 428 */
void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */
void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */
void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */
void * (*tcl_AttemptAlloc) (TCL_HASH_TYPE size); /* 428 */
void * (*tcl_AttemptDbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 429 */
void * (*tcl_AttemptRealloc) (void *ptr, TCL_HASH_TYPE size); /* 430 */
void * (*tcl_AttemptDbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 434 */
@@ -2453,7 +2418,7 @@ typedef struct TclStubs {
int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type); /* 529 */
void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type); /* 530 */
void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type); /* 531 */
Tcl_Size (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */
int (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */
void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 533 */
int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type); /* 534 */
Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 535 */
@@ -2558,7 +2523,7 @@ typedef struct TclStubs {
Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const void *data, size_t datalen, const char *mountPoint, int copy); /* 635 */
void (*tcl_FreeInternalRep) (Tcl_Obj *objPtr); /* 636 */
char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */
char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, TCL_HASH_TYPE numBytes); /* 637 */
Tcl_ObjInternalRep * (*tcl_FetchInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
void (*tcl_StoreInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 639 */
int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
@@ -2611,14 +2576,7 @@ typedef struct TclStubs {
int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */
Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 688 */
void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 689 */
int (*tcl_IsEmpty) (Tcl_Obj *obj); /* 690 */
const char * (*tcl_GetEncodingNameForUser) (Tcl_DString *bufPtr); /* 691 */
int (*tcl_ListObjReverse) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 692 */
int (*tcl_ListObjRepeat) (Tcl_Interp *interp, Tcl_Size repeatCount, Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Obj **resultPtrPtr); /* 693 */
int (*tcl_ListObjRange) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size start, Tcl_Size end, Tcl_Obj **resultPtrPtr); /* 694 */
int (*tcl_UtfToNormalizedDString) (Tcl_Interp *interp, const char *bytes, Tcl_Size length, Tcl_UnicodeNormalizationForm normForm, int profile, Tcl_DString *dsPtr); /* 695 */
int (*tcl_UtfToNormalized) (Tcl_Interp *interp, const char *bytes, Tcl_Size length, Tcl_UnicodeNormalizationForm normForm, int profile, char *bufPtr, Tcl_Size bufLen, Tcl_Size *lengthPtr); /* 696 */
void (*tclUnusedStubEntry) (void); /* 697 */
void (*tclUnusedStubEntry) (void); /* 690 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -2677,8 +2635,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#define Tcl_DbIsShared \
(tclStubsPtr->tcl_DbIsShared) /* 21 */
#define Tcl_DbGetStringFromObj \
(tclStubsPtr->tcl_DbGetStringFromObj) /* 22 */
/* Slot 22 is reserved */
#define Tcl_DbNewByteArrayObj \
(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#define Tcl_DbNewDoubleObj \
@@ -2694,9 +2651,12 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DuplicateObj) /* 29 */
#define TclFreeObj \
(tclStubsPtr->tclFreeObj) /* 30 */
/* Slot 31 is reserved */
/* Slot 32 is reserved */
/* Slot 33 is reserved */
#define Tcl_GetBoolean \
(tclStubsPtr->tcl_GetBoolean) /* 31 */
#define Tcl_GetBooleanFromObj \
(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#define Tcl_GetByteArrayFromObj \
(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
#define Tcl_GetDouble \
(tclStubsPtr->tcl_GetDouble) /* 34 */
#define Tcl_GetDoubleFromObj \
@@ -2739,16 +2699,14 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_NewObj) /* 55 */
#define Tcl_NewStringObj \
(tclStubsPtr->tcl_NewStringObj) /* 56 */
#define Tcl_AttemptNewStringObj \
(tclStubsPtr->tcl_AttemptNewStringObj) /* 57 */
/* Slot 57 is reserved */
#define Tcl_SetByteArrayLength \
(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#define Tcl_SetByteArrayObj \
(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#define Tcl_SetDoubleObj \
(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
#define Tcl_AttemptGetCharLength \
(tclStubsPtr->tcl_AttemptGetCharLength) /* 61 */
/* Slot 61 is reserved */
#define Tcl_SetListObj \
(tclStubsPtr->tcl_SetListObj) /* 62 */
/* Slot 63 is reserved */
@@ -2782,7 +2740,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
#define Tcl_CancelIdleCall \
(tclStubsPtr->tcl_CancelIdleCall) /* 80 */
/* Slot 81 is reserved */
#define Tcl_Close \
(tclStubsPtr->tcl_Close) /* 81 */
#define Tcl_CommandComplete \
(tclStubsPtr->tcl_CommandComplete) /* 82 */
#define Tcl_Concat \
@@ -3264,12 +3223,10 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_WriteChars) /* 338 */
#define Tcl_WriteObj \
(tclStubsPtr->tcl_WriteObj) /* 339 */
#define Tcl_AttemptGetStringFromObj \
(tclStubsPtr->tcl_AttemptGetStringFromObj) /* 340 */
#define Tcl_AttemptSetStringObj \
(tclStubsPtr->tcl_AttemptSetStringObj) /* 341 */
#define Tcl_AttemptDuplicateObj \
(tclStubsPtr->tcl_AttemptDuplicateObj) /* 342 */
#define Tcl_GetString \
(tclStubsPtr->tcl_GetString) /* 340 */
/* Slot 341 is reserved */
/* Slot 342 is reserved */
#define Tcl_AlertNotifier \
(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#define Tcl_ServiceModeHook \
@@ -3419,10 +3376,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_IsChannelExisting) /* 418 */
/* Slot 419 is reserved */
/* Slot 420 is reserved */
#define Tcl_DbCreateHashEntry \
(tclStubsPtr->tcl_DbCreateHashEntry) /* 421 */
#define Tcl_CreateHashEntry \
(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
/* Slot 421 is reserved */
/* Slot 422 is reserved */
#define Tcl_InitCustomHashTable \
(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
#define Tcl_InitObjHashTable \
@@ -3954,22 +3909,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_NewWideUIntObj) /* 688 */
#define Tcl_SetWideUIntObj \
(tclStubsPtr->tcl_SetWideUIntObj) /* 689 */
#define Tcl_IsEmpty \
(tclStubsPtr->tcl_IsEmpty) /* 690 */
#define Tcl_GetEncodingNameForUser \
(tclStubsPtr->tcl_GetEncodingNameForUser) /* 691 */
#define Tcl_ListObjReverse \
(tclStubsPtr->tcl_ListObjReverse) /* 692 */
#define Tcl_ListObjRepeat \
(tclStubsPtr->tcl_ListObjRepeat) /* 693 */
#define Tcl_ListObjRange \
(tclStubsPtr->tcl_ListObjRange) /* 694 */
#define Tcl_UtfToNormalizedDString \
(tclStubsPtr->tcl_UtfToNormalizedDString) /* 695 */
#define Tcl_UtfToNormalized \
(tclStubsPtr->tcl_UtfToNormalized) /* 696 */
#define TclUnusedStubEntry \
(tclStubsPtr->tclUnusedStubEntry) /* 697 */
(tclStubsPtr->tclUnusedStubEntry) /* 690 */
#endif /* defined(USE_TCL_STUBS) */
@@ -4039,6 +3980,23 @@ extern const TclStubs *tclStubsPtr;
} while(0)
#if defined(USE_TCL_STUBS)
# if defined(_WIN32) && defined(_WIN64) && TCL_MAJOR_VERSION < 9
# undef Tcl_GetTime
/* Handle Win64 tk.dll being loaded in Cygwin64 (only needed for Tcl 8). */
# define Tcl_GetTime(t) \
do { \
struct { \
Tcl_Time now; \
long long reserved; \
} _t; \
_t.reserved = -1; \
tclStubsPtr->tcl_GetTime((&_t.now)); \
if (_t.reserved != -1) { \
_t.now.usec = (long) _t.reserved; \
} \
*(t) = _t.now; \
} while (0)
# endif
# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
* we have to make sure that all stub entries on Cygwin64 follow the
@@ -4068,10 +4026,10 @@ extern const TclStubs *tclStubsPtr;
# endif
#endif
#undef Tcl_GetString
#undef Tcl_GetUnicode
#define Tcl_GetString(objPtr) \
Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
#define Tcl_AttemptGetString(objPtr) \
Tcl_AttemptGetStringFromObj(objPtr, (Tcl_Size *)NULL)
#define Tcl_GetUnicode(objPtr) \
Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)
#undef Tcl_GetIndexFromObjStruct
@@ -4091,22 +4049,26 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) ((sizeof(*(boolPtr)) <= sizeof(int)) \
? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) \
: (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))
#define Tcl_GetBoolean(interp, src, boolPtr) ((sizeof(*(boolPtr)) <= sizeof(int)) \
? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) \
: (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
#else
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) ((sizeof(*(boolPtr)) <= sizeof(int)) \
? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) \
: (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))
#define Tcl_GetBoolean(interp, src, boolPtr) ((sizeof(*(boolPtr)) <= sizeof(int)) \
? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) \
: (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \
(TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR)))
#endif
#ifdef TCL_MEM_DEBUG
@@ -4125,9 +4087,6 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_AttemptRealloc
# define Tcl_AttemptRealloc(x,y) \
(Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__))
# undef Tcl_GetStringFromObj
# define Tcl_GetStringFromObj(x,y) \
(Tcl_DbGetStringFromObj((x), (y), __FILE__, __LINE__))
#endif /* !TCL_MEM_DEBUG */
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
@@ -4206,7 +4165,11 @@ extern const TclStubs *tclStubsPtr;
Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#if TCL_MAJOR_VERSION > 8
# undef Tcl_Close
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#endif
#undef TclUtfCharComplete
#undef TclUtfNext
@@ -4230,7 +4193,55 @@ extern const TclStubs *tclStubsPtr;
#undef TclParseArgsObjv
#undef TclGetAliasObj
#if defined(TCL_8_API)
#if TCL_MAJOR_VERSION < 9
/* TIP #627 for 8.7 */
# undef Tcl_CreateObjCommand2
# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
# undef Tcl_CreateObjTrace2
# define Tcl_CreateObjTrace2 Tcl_CreateObjTrace
# undef Tcl_NRCreateCommand2
# define Tcl_NRCreateCommand2 Tcl_NRCreateCommand
# undef Tcl_NRCallObjProc2
# define Tcl_NRCallObjProc2 Tcl_NRCallObjProc
/* TIP #660 for 8.7 */
# undef Tcl_GetSizeIntFromObj
# define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
# undef Tcl_GetBytesFromObj
# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr))
# undef Tcl_GetStringFromObj
# define Tcl_GetStringFromObj(objPtr, sizePtr) \
tclStubsPtr->tclGetStringFromObj((objPtr), (sizePtr))
# undef Tcl_GetUnicodeFromObj
# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
tclStubsPtr->tclGetUnicodeFromObj((objPtr), (sizePtr))
# undef Tcl_ListObjGetElements
# define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))
# undef Tcl_ListObjLength
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) \
tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr))
# undef Tcl_DictObjSize
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) \
tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr))
# undef Tcl_SplitList
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) \
tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr))
# undef Tcl_SplitPath
# define Tcl_SplitPath(path, argcPtr, argvPtr) \
tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr))
# undef Tcl_FSSplitPath
# define Tcl_FSSplitPath(pathPtr, lenPtr) \
tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr))
# undef Tcl_ParseArgsObjv
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \
tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv))
# undef Tcl_GetAliasObj
# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) \
tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv))
#elif defined(TCL_8_API)
# undef Tcl_GetByteArrayFromObj
# undef Tcl_GetBytesFromObj
# undef Tcl_GetStringFromObj
# undef Tcl_GetUnicodeFromObj
@@ -4243,6 +4254,9 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_ParseArgsObjv
# undef Tcl_GetAliasObj
# if !defined(USE_TCL_STUBS)
# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
(Tcl_GetBytesFromObj)(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \
(Tcl_GetBytesFromObj)((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr)))
@@ -4277,6 +4291,9 @@ extern const TclStubs *tclStubsPtr;
TclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
(Tcl_GetAliasObj)((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
# elif !defined(BUILD_tcl)
# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \
tclStubsPtr->tcl_GetBytesFromObj((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr)))
@@ -4311,12 +4328,10 @@ extern const TclStubs *tclStubsPtr;
tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
# endif /* defined(USE_TCL_STUBS) */
#else /* !defined(TCL_8_API) */
# undef Tcl_GetByteArrayFromObj
# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))
#endif /* defined(TCL_8_API) */
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))
#if TCL_MINOR_VERSION < 1
# undef Tcl_IsEmpty
#endif
#endif /* _TCLDECLS */
+30 -53
View File
@@ -82,8 +82,8 @@ static const EnsembleImplMap implementationMap[] = {
{"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
{"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
{"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
{"remove", DictRemoveCmd, TclCompileDictRemoveCmd, NULL, NULL, 0 },
{"replace", DictReplaceCmd, TclCompileDictReplaceCmd, NULL, NULL, 0 },
{"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
{"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
{"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
@@ -177,7 +177,7 @@ const Tcl_ObjType tclDictType = {
static const Tcl_HashKeyType chainHashType = {
TCL_HASH_KEY_TYPE_VERSION,
TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */
TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */
TclHashObjKey,
TclCompareObjKeys,
AllocChainEntry,
@@ -520,17 +520,7 @@ UpdateStringOfDict(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
flagPtr = (char *)Tcl_AttemptAlloc(numElems);
if (!flagPtr) {
dictPtr->length = numElems - 1;
allocError:
/* Allocation error. Just give up. */
if (dictPtr->bytes) {
Tcl_Free(dictPtr->bytes);
dictPtr->bytes = NULL;
}
return;
}
flagPtr = (char *)Tcl_Alloc(numElems);
}
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
@@ -540,19 +530,11 @@ UpdateStringOfDict(
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclAttemptGetStringFromObj(keyPtr, &length);
if (!elem) {
dictPtr->length = keyPtr->length;
goto allocError;
}
elem = TclGetStringFromObj(keyPtr, &length);
bytesNeeded += TclScanElement(elem, length, flagPtr+i);
flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
elem = TclAttemptGetStringFromObj(valuePtr, &length);
if (!elem) {
dictPtr->length = valuePtr->length;
goto allocError;
}
elem = TclGetStringFromObj(valuePtr, &length);
bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
}
bytesNeeded += numElems;
@@ -562,14 +544,9 @@ UpdateStringOfDict(
*/
dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
if (!dst) {
dictPtr->length = bytesNeeded;
goto allocError;
}
TclOOM(dst, bytesNeeded);
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
if (i) {
flagPtr[i] |= TCL_DONT_QUOTE_HASH;
}
flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
@@ -1288,7 +1265,7 @@ Tcl_DictObjNext(
void
Tcl_DictObjDone(
Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */
Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */
{
Dict *dict;
@@ -1493,7 +1470,7 @@ Tcl_DbNewDictObj(
TclDbNewObj(dictPtr, file, line);
TclInvalidateStringRep(dictPtr);
dict = (Dict *)Tcl_DbCkalloc(sizeof(Dict), file, line);
dict = (Dict *)Tcl_Alloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 1;
dict->chain = NULL;
@@ -1990,8 +1967,8 @@ DictMergeCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
int done, allocatedDict = 0;
int i;
int allocatedDict = 0;
int i, done;
Tcl_DictSearch search;
if (objc == 1) {
@@ -2516,8 +2493,7 @@ DictLappendCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int allocatedDict = 0, allocatedValue = 0;
int i;
int i, allocatedDict = 0, allocatedValue = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
@@ -3252,7 +3228,7 @@ DictFilterCmd(
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
0, &index) != TCL_OK) {
0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -3445,7 +3421,7 @@ DictFilterCmd(
Tcl_ResetResult(interp);
Tcl_DictObjDone(&search);
TCL_FALLTHROUGH();
/* FALLTHRU */
case TCL_CONTINUE:
result = TCL_OK;
break;
@@ -3453,7 +3429,6 @@ DictFilterCmd(
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"dict filter\" script line %d)",
Tcl_GetErrorLine(interp)));
TCL_FALLTHROUGH();
default:
goto abnormalResult;
}
@@ -3479,18 +3454,20 @@ DictFilterCmd(
TclDecrRefCount(resultObj);
}
return result;
}
TCL_UNREACHABLE();
abnormalResult:
Tcl_DictObjDone(&search);
TclDecrRefCount(keyObj);
TclDecrRefCount(valueObj);
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
TclDecrRefCount(resultObj);
return result;
abnormalResult:
Tcl_DictObjDone(&search);
TclDecrRefCount(keyObj);
TclDecrRefCount(valueObj);
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
TclDecrRefCount(resultObj);
return result;
}
Tcl_Panic("unexpected fallthrough");
/* Control never reaches this point. */
return TCL_ERROR;
}
/*
@@ -3878,10 +3855,10 @@ TclDictWithFinish(
* parameter is >= 0 */
Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
* in the array part1. */
Tcl_Size index, /* Index into the local variable table of the
int index, /* Index into the local variable table of the
* variable, or -1. Only used when part1Ptr is
* NULL. */
Tcl_Size pathc, /* The number of elements in the path into the
int pathc, /* The number of elements in the path into the
* dictionary. */
Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */
Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is
+168 -207
View File
@@ -13,7 +13,6 @@
*/
#include "tclInt.h"
#define ALLOW_DEPRECATED_OPCODES
#include "tclCompile.h"
#include "tclOOInt.h"
#include <assert.h>
@@ -133,7 +132,7 @@ void
TclDebugPrintByteCodeObj(
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
if (tclTraceCompile >= TCL_TRACE_BYTECODE_COMPILE_DETAIL) {
if (tclTraceCompile >= 2) {
Tcl_Obj *bufPtr = DisassembleByteCodeObj(objPtr);
fprintf(stdout, "\n%s", TclGetString(bufPtr));
@@ -281,11 +280,8 @@ DisassembleByteCodeObj(
*/
Tcl_AppendPrintfToObj(bufferObj,
"ByteCode %p, refCt %" TCL_SIZE_MODIFIER "d, "
"epoch %" TCL_SIZE_MODIFIER "d, interp %p "
"(epoch %" TCL_SIZE_MODIFIER "d)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
"ByteCode %p, refCt %" TCL_SIZE_MODIFIER "d, epoch %" TCL_SIZE_MODIFIER "d, interp %p (epoch %" TCL_SIZE_MODIFIER "d)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
@@ -295,10 +291,7 @@ DisassembleByteCodeObj(
TclGetString(fileObj), line);
}
Tcl_AppendPrintfToObj(bufferObj,
"\n Cmds %d, src %" TCL_SIZE_MODIFIER "d, "
"inst %" TCL_SIZE_MODIFIER "d, litObjs %" TCL_SIZE_MODIFIER "d, "
"aux %" TCL_SIZE_MODIFIER "d, stkDepth %" TCL_SIZE_MODIFIER "d, "
"code/src %.2f\n",
"\n Cmds %d, src %" TCL_SIZE_MODIFIER "d, inst %" TCL_SIZE_MODIFIER "d, litObjs %" TCL_SIZE_MODIFIER "d, aux %" TCL_SIZE_MODIFIER "d, stkDepth %" TCL_SIZE_MODIFIER "d, code/src %.2f\n",
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
codePtr->numLitObjects, codePtr->numAuxDataItems,
codePtr->maxStackDepth,
@@ -310,10 +303,8 @@ DisassembleByteCodeObj(
#ifdef TCL_COMPILE_STATS
Tcl_AppendPrintfToObj(bufferObj,
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+"
"inst %" TCL_SIZE_MODIFIER "d+litObj %" TCL_Z_MODIFIER "u+"
"exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+"
"cmdMap %" TCL_SIZE_MODIFIER "d\n",
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "d+litObj %"
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "d\n",
codePtr->structureSize,
offsetof(ByteCode, localCachePtr),
codePtr->numCodeBytes,
@@ -334,9 +325,7 @@ DisassembleByteCodeObj(
Tcl_Size numCompiledLocals = procPtr->numCompiledLocals;
Tcl_AppendPrintfToObj(bufferObj,
" Proc %p, refCt %" TCL_SIZE_MODIFIER "d, "
"args %" TCL_SIZE_MODIFIER "d, "
"compiled locals %" TCL_SIZE_MODIFIER "d\n",
" Proc %p, refCt %" TCL_SIZE_MODIFIER "d, args %" TCL_SIZE_MODIFIER "d, compiled locals %" TCL_SIZE_MODIFIER "d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
@@ -367,31 +356,24 @@ DisassembleByteCodeObj(
*/
if ((int)codePtr->numExceptRanges > 0) {
Tcl_AppendPrintfToObj(bufferObj,
" Exception ranges %" TCL_SIZE_MODIFIER "d, "
"depth %" TCL_SIZE_MODIFIER "d:\n",
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "d, depth %" TCL_SIZE_MODIFIER "d:\n",
codePtr->numExceptRanges, codePtr->maxExceptDepth);
for (i = 0; i < (int)codePtr->numExceptRanges; i++) {
ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
Tcl_AppendPrintfToObj(bufferObj,
" %" TCL_SIZE_MODIFIER "d: "
"level %" TCL_SIZE_MODIFIER "d, %s, "
"pc %" TCL_SIZE_MODIFIER "d-%" TCL_SIZE_MODIFIER "d, ",
" %" TCL_SIZE_MODIFIER "d: level %" TCL_SIZE_MODIFIER "d, %s, pc %" TCL_SIZE_MODIFIER "d-%" TCL_SIZE_MODIFIER "d, ",
i, rangePtr->nestingLevel,
(rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
rangePtr->codeOffset,
(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj,
"continue %" TCL_SIZE_MODIFIER "d, "
"break %" TCL_SIZE_MODIFIER "d\n",
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "d, break %" TCL_SIZE_MODIFIER "d\n",
rangePtr->continueOffset, rangePtr->breakOffset);
break;
case CATCH_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj,
"catch %" TCL_SIZE_MODIFIER "d\n",
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "d\n",
rangePtr->catchOffset);
break;
default:
@@ -465,8 +447,7 @@ DisassembleByteCodeObj(
srcLengthNext++;
}
Tcl_AppendPrintfToObj(bufferObj,
"%s%4" TCL_SIZE_MODIFIER "d: pc %d-%d, src %d-%d",
Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "d: pc %d-%d, src %d-%d",
((i % 2)? " " : "\n "),
(i+1), codeOffset, (codeOffset + codeLen - 1),
srcOffset, (srcOffset + srcLen - 1));
@@ -578,69 +559,56 @@ FormatInstruction(
for (i = 0; i < instDesc->numOperands; i++) {
switch (instDesc->opTypes[i]) {
case OPERAND_INT1:
opnd = TclGetInt1AtPtr(pc+numBytes);
numBytes++;
opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_INT4:
opnd = TclGetInt4AtPtr(pc+numBytes);
numBytes += 4;
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_UINT1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
break;
case OPERAND_UINT4:
opnd = TclGetUInt4AtPtr(pc+numBytes);
numBytes += 4;
opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_START_CMD) {
snprintf(suffixBuffer+strlen(suffixBuffer),
sizeof(suffixBuffer) - strlen(suffixBuffer),
snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer),
", %u cmds start here", opnd);
}
Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
break;
case OPERAND_OFFSET1:
opnd = TclGetInt1AtPtr(pc+numBytes);
numBytes++;
opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd);
Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_OFFSET4:
opnd = TclGetInt4AtPtr(pc+numBytes);
numBytes += 4;
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_START_CMD) {
snprintf(suffixBuffer, sizeof(suffixBuffer),
"next cmd at pc %u", pcOffset+opnd);
snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd);
} else {
snprintf(suffixBuffer, sizeof(suffixBuffer),
"pc %u", pcOffset+opnd);
snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd);
}
Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_LIT1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
suffixObj = codePtr->objArrayPtr[opnd];
Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
break;
case OPERAND_LIT4:
opnd = TclGetUInt4AtPtr(pc+numBytes);
numBytes += 4;
opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
suffixObj = codePtr->objArrayPtr[opnd];
Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
break;
case OPERAND_AUX4:
opnd = TclGetUInt4AtPtr(pc+numBytes);
numBytes += 4;
opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
auxPtr = &codePtr->auxDataArrayPtr[opnd];
break;
case OPERAND_IDX4:
opnd = TclGetInt4AtPtr(pc+numBytes);
numBytes += 4;
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
if (opnd >= -1) {
Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
} else if (opnd == -2) {
@@ -659,16 +627,14 @@ FormatInstruction(
printLVTindex:
if (localPtr != NULL) {
if (opnd >= localCt) {
Tcl_Panic("FormatInstruction: bad local var index %u "
"(%" TCL_SIZE_MODIFIER "d locals)",
Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "d locals)",
opnd, localCt);
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
}
if (TclIsVarTemporary(localPtr)) {
snprintf(suffixBuffer, sizeof(suffixBuffer),
"temp var %u", opnd);
snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd);
} else {
snprintf(suffixBuffer, sizeof(suffixBuffer), "var ");
suffixSrc = localPtr->name;
@@ -677,57 +643,10 @@ FormatInstruction(
Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd);
break;
case OPERAND_SCLS1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
Tcl_AppendPrintfToObj(bufferObj, "%s ",
tclStringClassTable[opnd].name);
break;
case OPERAND_UNSF1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
Tcl_AppendPrintfToObj(bufferObj, "silent=%s ", opnd?"no":"yes");
break;
case OPERAND_CLK1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
switch (opnd) {
case CLOCK_READ_CLICKS:
Tcl_AppendPrintfToObj(bufferObj, "clicks " );
break;
case CLOCK_READ_MICROS:
Tcl_AppendPrintfToObj(bufferObj, "micros " );
break;
case CLOCK_READ_MILLIS:
Tcl_AppendPrintfToObj(bufferObj, "millis " );
break;
case CLOCK_READ_SECS:
Tcl_AppendPrintfToObj(bufferObj, "secs " );
break;
default:
Tcl_Panic("unknown clock type");
}
break;
case OPERAND_LRPL1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
switch (opnd) {
case 0:
Tcl_AppendPrintfToObj(bufferObj, "0 ");
break;
case TCL_LREPLACE_END_IS_LAST:
Tcl_AppendPrintfToObj(bufferObj, "endLast ");
break;
case TCL_LREPLACE_SINGLE_INDEX:
Tcl_AppendPrintfToObj(bufferObj, "singleIdx ");
break;
case TCL_LREPLACE_END_IS_LAST | TCL_LREPLACE_NEED_IN_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "endLast,indexTest ");
break;
default:
Tcl_AppendPrintfToObj(bufferObj, "endLast,singleIdx ");
break;
}
break;
case OPERAND_NONE:
default:
break;
@@ -827,15 +746,13 @@ TclGetInnerContext(
objc = 2;
break;
case INST_INVOKE_STK:
objc = TclGetUInt4AtPtr(pc + 1);
case INST_INVOKE_STK4:
objc = TclGetUInt4AtPtr(pc+1);
break;
#ifndef REMOVE_DEPRECATED_OPCODES
case INST_INVOKE_STK1:
objc = TclGetUInt1AtPtr(pc + 1);
objc = TclGetUInt1AtPtr(pc+1);
break;
#endif
}
result = iPtr->innerContext;
@@ -1109,9 +1026,6 @@ DisassembleByteCodeAsDicts(
val = TclGetInt1AtPtr(opnd);
opnd += 1;
goto formatNumber;
case OPERAND_UNSF1: // TODO: decode
case OPERAND_CLK1: // TODO: decode
case OPERAND_LRPL1: // TODO: decode
case OPERAND_UINT1:
val = TclGetUInt1AtPtr(opnd);
opnd += 1;
@@ -1234,19 +1148,14 @@ DisassembleByteCodeAsDicts(
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
"type %s level %" TCL_SIZE_MODIFIER "d "
"from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d "
"break %" TCL_SIZE_MODIFIER "d "
"continue %" TCL_SIZE_MODIFIER "d",
"type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d break %" TCL_SIZE_MODIFIER "d continue %" TCL_SIZE_MODIFIER "d",
"loop", rangePtr->nestingLevel, rangePtr->codeOffset,
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
rangePtr->breakOffset, rangePtr->continueOffset));
break;
case CATCH_EXCEPTION_RANGE:
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
"type %s level %" TCL_SIZE_MODIFIER "d "
"from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d "
"catch %" TCL_SIZE_MODIFIER "d",
"type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d catch %" TCL_SIZE_MODIFIER "d",
"catch", rangePtr->nestingLevel, rangePtr->codeOffset,
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
rangePtr->catchOffset));
@@ -1370,12 +1279,9 @@ Tcl_DisassembleObjCmd(
Tcl_Obj *codeObjPtr = NULL;
Proc *procPtr = NULL;
Tcl_HashEntry *hPtr;
Tcl_Obj *ooWhat = NULL;
Object *oPtr;
Class *classPtr;
ByteCode *codePtr;
Method *methodPtr;
const char *bodyType;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "type ...");
@@ -1473,17 +1379,23 @@ Tcl_DisassembleObjCmd(
* Look up the body of a constructor.
*/
ooWhat = objv[2];
classPtr = TclOOGetClassFromObj(interp, ooWhat);
if (classPtr == NULL) {
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
methodPtr = classPtr->constructorPtr;
methodPtr = oPtr->classPtr->constructorPtr;
if (methodPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" has no defined constructor",
TclGetString(ooWhat)));
TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"CONSRUCTOR", (char *)NULL);
return TCL_ERROR;
@@ -1497,9 +1409,30 @@ Tcl_DisassembleObjCmd(
return TCL_ERROR;
}
oPtr = classPtr->thisPtr;
bodyType = "body of constructor";
goto compileMethodIfNeeded;
/*
* Compile if necessary.
*/
if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
* Yes, this is ugly, but we need to pass the namespace in to the
* compiler in two places.
*/
cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
procPtr->cmdPtr = &cmd;
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
(Namespace *) oPtr->namespacePtr, "body of constructor",
TclGetString(objv[2]));
procPtr->cmdPtr = NULL;
if (result != TCL_OK) {
return result;
}
}
codeObjPtr = procPtr->bodyPtr;
break;
case DISAS_CLASS_DESTRUCTOR:
if (objc != 3) {
@@ -1511,17 +1444,23 @@ Tcl_DisassembleObjCmd(
* Look up the body of a destructor.
*/
ooWhat = objv[2];
classPtr = TclOOGetClassFromObj(interp, ooWhat);
if (classPtr == NULL) {
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
methodPtr = classPtr->destructorPtr;
methodPtr = oPtr->classPtr->destructorPtr;
if (methodPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" has no defined destructor",
TclGetString(ooWhat)));
TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"DESRUCTOR", (char *)NULL);
return TCL_ERROR;
@@ -1535,73 +1474,10 @@ Tcl_DisassembleObjCmd(
return TCL_ERROR;
}
oPtr = classPtr->thisPtr;
bodyType = "body of destructor";
goto compileMethodIfNeeded;
case DISAS_CLASS_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
return TCL_ERROR;
}
/*
* Look up the body of a class method.
* Compile if necessary.
*/
ooWhat = objv[3];
classPtr = TclOOGetClassFromObj(interp, objv[2]);
if (classPtr == NULL) {
return TCL_ERROR;
}
oPtr = classPtr->thisPtr;
hPtr = Tcl_FindHashEntry(&classPtr->classMethods, ooWhat);
goto methodBody;
case DISAS_OBJECT_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
return TCL_ERROR;
}
/*
* Look up the body of an instance method.
*/
ooWhat = objv[3];
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
ooWhat = objv[3];
if (oPtr->methodsPtr == NULL) {
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, ooWhat);
/*
* Compile (if necessary) and disassemble a method body.
*/
methodBody:
if (hPtr == NULL) {
unknownMethod:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown method \"%s\"", TclGetString(ooWhat)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(ooWhat), (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
bodyType = "body of method";
compileMethodIfNeeded:
if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
@@ -1613,8 +1489,93 @@ Tcl_DisassembleObjCmd(
cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
procPtr->cmdPtr = &cmd;
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
(Namespace *) oPtr->namespacePtr, bodyType,
TclGetString(ooWhat));
(Namespace *) oPtr->namespacePtr, "body of destructor",
TclGetString(objv[2]));
procPtr->cmdPtr = NULL;
if (result != TCL_OK) {
return result;
}
}
codeObjPtr = procPtr->bodyPtr;
break;
case DISAS_CLASS_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
return TCL_ERROR;
}
/*
* Look up the body of a class method.
*/
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
objv[3]);
goto methodBody;
case DISAS_OBJECT_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
return TCL_ERROR;
}
/*
* Look up the body of an instance method.
*/
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->methodsPtr == NULL) {
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[3]);
/*
* Compile (if necessary) and disassemble a method body.
*/
methodBody:
if (hPtr == NULL) {
unknownMethod:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown method \"%s\"", TclGetString(objv[3])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[3]), (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
* Yes, this is ugly, but we need to pass the namespace in to the
* compiler in two places.
*/
cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
procPtr->cmdPtr = &cmd;
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
(Namespace *) oPtr->namespacePtr, "body of method",
TclGetString(objv[3]));
procPtr->cmdPtr = NULL;
if (result != TCL_OK) {
return result;
@@ -1623,7 +1584,7 @@ Tcl_DisassembleObjCmd(
codeObjPtr = procPtr->bodyPtr;
break;
default:
TCL_UNREACHABLE();
CLANG_ASSERT(0);
}
/*
+71 -305
View File
@@ -11,7 +11,6 @@
#include "tclInt.h"
#include <assert.h>
#include "../utf8proc/utf8proc.h" /* Relative path to ignore system include */
typedef size_t (LengthProc)(const char *src);
@@ -882,7 +881,7 @@ Tcl_GetEncodingNames(
Tcl_HashEntry *hPtr;
Tcl_Obj *map, *name, *result;
Tcl_DictSearch mapSearch;
int done = 0;
int dummy, done = 0;
TclNewObj(result);
Tcl_InitObjHashTable(&table);
@@ -897,7 +896,7 @@ Tcl_GetEncodingNames(
Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);
Tcl_CreateHashEntry(&table,
Tcl_NewStringObj(encodingPtr->name, TCL_INDEX_NONE), NULL);
Tcl_NewStringObj(encodingPtr->name, TCL_INDEX_NONE), &dummy);
}
Tcl_MutexUnlock(&encodingMutex);
@@ -910,7 +909,7 @@ Tcl_GetEncodingNames(
Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done);
for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) {
Tcl_CreateHashEntry(&table, name, NULL);
Tcl_CreateHashEntry(&table, name, &dummy);
}
/*
@@ -970,11 +969,9 @@ Tcl_GetEncodingNulLength(
* unless interp was NULL.
*
* Side effects:
* If the passed encoding is the same as the current system
* encoding, the call is effectively a no-op. Otherwise, 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.
* 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.
*
*------------------------------------------------------------------------
*/
@@ -986,34 +983,25 @@ Tcl_SetSystemEncoding(
* to reset to default encoding. */
{
Tcl_Encoding encoding;
Encoding *encodingPtr;
Tcl_MutexLock(&encodingMutex);
if (name == NULL || name[0] == '\0') {
if (defaultEncoding == systemEncoding) {
Tcl_MutexUnlock(&encodingMutex);
return TCL_OK;
}
if (!name || !*name) {
Tcl_MutexLock(&encodingMutex);
encoding = defaultEncoding;
((Encoding *)encoding)->refCount += 1;
encodingPtr = (Encoding *) encoding;
encodingPtr->refCount++;
Tcl_MutexUnlock(&encodingMutex);
} else {
encoding = Tcl_GetEncoding(interp, name);
if (encoding == NULL) {
Tcl_MutexUnlock(&encodingMutex);
return TCL_ERROR;
}
if (encoding == systemEncoding) {
FreeEncoding(encoding);
Tcl_MutexUnlock(&encodingMutex);
return TCL_OK;
}
}
assert(encoding != systemEncoding);
Tcl_MutexLock(&encodingMutex);
FreeEncoding(systemEncoding);
systemEncoding = encoding;
Tcl_MutexUnlock(&encodingMutex);
/* Checks above ensure this is only called when system encoding changes */
Tcl_FSMountsChanged(NULL);
return TCL_OK;
@@ -1240,7 +1228,7 @@ Tcl_ExternalToUtfDStringEx(
* and loop. Otherwise, return the result we got.
*/
if ((result != TCL_CONVERT_NOSPACE) &&
(result != TCL_CONVERT_MULTIBYTE || (flags & TCL_ENCODING_END))) {
!(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) {
Tcl_Size nBytesProcessed = (src - srcStart);
Tcl_DStringSetLength(dstPtr, soFar);
@@ -1556,7 +1544,7 @@ Tcl_UtfToExternalDStringEx(
* and loop. Otherwise, return the result we got.
*/
if ((result != TCL_CONVERT_NOSPACE) &&
(result != TCL_CONVERT_MULTIBYTE || (flags & TCL_ENCODING_END))) {
!(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) {
Tcl_Size nBytesProcessed = (src - srcStart);
Tcl_Size i = soFar + encodingPtr->nullSize - 1;
/* Loop as DStringSetLength only stores one nul byte at a time */
@@ -1965,22 +1953,22 @@ LoadTableEncoding(
*/
static const char staticHex[] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0 ... 15 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 16 ... 31 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 32 ... 47 */
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 48 ... 63 */
0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 64 ... 79 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 80 ... 95 */
0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 96 ... 111 */
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 112 ... 127 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 128 ... 143 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 144 ... 159 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 160 ... 175 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 176 ... 191 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0 ... 15 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 16 ... 31 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 32 ... 47 */
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 48 ... 63 */
0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 64 ... 79 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 80 ... 95 */
0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 96 ... 111 */
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 112 ... 127 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 128 ... 143 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 144 ... 159 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 160 ... 175 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 176 ... 191 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */
};
Tcl_DStringInit(&lineString);
@@ -2493,19 +2481,19 @@ UtfToUtfProc(
* by a low surrogate. NOT to be called for strict profile since
* that should raise an error.
*/
#define OUTPUT_ISOLATEDSURROGATE() \
do { \
Tcl_UniChar high; \
if (PROFILE_REPLACE(profile)) { \
high = UNICODE_REPLACE_CHAR; \
} else { \
high = (Tcl_UniChar)(ptrdiff_t) *statePtr; \
} \
assert(!(flags & ENCODING_UTF)); /* Must be CESU-8 */ \
assert(HIGH_SURROGATE(high)); \
assert(!PROFILE_STRICT(profile)); \
dst += Tcl_UniCharToUtf(high, dst); \
*statePtr = 0; /* Reset state */ \
#define OUTPUT_ISOLATEDSURROGATE \
do { \
Tcl_UniChar high; \
if (PROFILE_REPLACE(profile)) { \
high = UNICODE_REPLACE_CHAR; \
} else { \
high = (Tcl_UniChar)(ptrdiff_t) *statePtr; \
} \
assert(!(flags & ENCODING_UTF)); /* Must be CESU-8 */ \
assert(HIGH_SURROGATE(high)); \
assert(!PROFILE_STRICT(profile)); \
dst += Tcl_UniCharToUtf(high, dst); \
*statePtr = 0; /* Reset state */ \
} while (0)
/*
@@ -2513,19 +2501,20 @@ UtfToUtfProc(
* an error if profile is strict, or output an appropriate
* character for replace and tcl8 profiles and continue.
*/
#define CHECK_ISOLATEDSURROGATE() \
if (*statePtr) { \
if (PROFILE_STRICT(profile)) { \
result = TCL_CONVERT_SYNTAX; \
break; \
} \
OUTPUT_ISOLATEDSURROGATE(); \
continue; /* Rerun loop so length checks etc. repeated */ \
} else \
#define CHECK_ISOLATEDSURROGATE \
if (*statePtr) { \
if (PROFILE_STRICT(profile)) { \
result = TCL_CONVERT_SYNTAX; \
break; \
} \
OUTPUT_ISOLATEDSURROGATE; \
continue; /* Rerun loop so length checks etc. repeated */ \
} else \
(void) 0
profile = ENCODING_PROFILE_GET(flags);
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
@@ -2540,18 +2529,19 @@ UtfToUtfProc(
break;
}
if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) {
CHECK_ISOLATEDSURROGATE();
CHECK_ISOLATEDSURROGATE;
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to \xC0\x80.
*/
*dst++ = *src++;
} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd) &&
(UCHAR(src[1]) == 0x80) &&
(!(flags & ENCODING_INPUT) || !PROFILE_TCL8(profile))) {
(UCHAR(src[1]) == 0x80) &&
(!(flags & ENCODING_INPUT) || !PROFILE_TCL8(profile))) {
/* Special sequence \xC0\x80 */
CHECK_ISOLATEDSURROGATE();
CHECK_ISOLATEDSURROGATE;
if (!PROFILE_TCL8(profile) && (flags & ENCODING_INPUT)) {
if (PROFILE_REPLACE(profile)) {
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
@@ -2577,7 +2567,7 @@ UtfToUtfProc(
* because the UTF-8 sequence is truncated.
*/
CHECK_ISOLATEDSURROGATE();
CHECK_ISOLATEDSURROGATE;
if (flags & ENCODING_INPUT) {
/* Incomplete bytes for modified UTF-8 target */
@@ -2594,8 +2584,7 @@ UtfToUtfProc(
} else {
/* TCL_ENCODING_PROFILE_TCL8 */
char chbuf[2];
chbuf[0] = UCHAR(*src++);
chbuf[1] = 0;
chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
TclUtfToUniChar(chbuf, &ch);
}
dst += Tcl_UniCharToUtf(ch, dst);
@@ -2621,8 +2610,8 @@ UtfToUtfProc(
src += len;
if (!(flags & ENCODING_UTF) && !(flags & ENCODING_INPUT)
&& (ch > 0x7FF)) {
assert(savedSurrogate == 0); /* Since this flag combo
* will never set *statePtr */
assert(savedSurrogate == 0); /* Since this flag combo
will never set *statePtr */
if (ch > 0xFFFF) {
/* CESU-8 6-byte sequence for chars > U+FFFF */
ch -= 0x10000;
@@ -2640,7 +2629,7 @@ UtfToUtfProc(
/* UTF-8, not CESU-8, so surrogates should not appear */
if (PROFILE_STRICT(profile)) {
result = (flags & ENCODING_INPUT)
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
} else if (PROFILE_REPLACE(profile)) {
@@ -2658,7 +2647,7 @@ UtfToUtfProc(
/* Isolated low surrogate */
if (PROFILE_STRICT(profile)) {
result = (flags & ENCODING_INPUT)
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
} else if (PROFILE_REPLACE(profile)) {
@@ -2675,7 +2664,7 @@ UtfToUtfProc(
assert(HIGH_SURROGATE(savedSurrogate));
if (PROFILE_STRICT(profile)) {
result = (flags & ENCODING_INPUT)
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
} else if (PROFILE_REPLACE(profile)) {
@@ -2693,7 +2682,7 @@ UtfToUtfProc(
}
} else {
/* Normal character */
CHECK_ISOLATEDSURROGATE();
CHECK_ISOLATEDSURROGATE;
}
dst += Tcl_UniCharToUtf(ch, dst);
@@ -2709,7 +2698,7 @@ UtfToUtfProc(
/* No more data coming */
if (PROFILE_STRICT(profile)) {
result = (flags & ENCODING_INPUT)
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN;
} else {
if (PROFILE_REPLACE(profile)) {
ch = UNICODE_REPLACE_CHAR;
@@ -3068,7 +3057,7 @@ Utf16ToUtfProc(
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_SYNTAX;
src -= 2; /* Go back to beginning of high surrogate */
dst--; /* Also undo writing a single byte too much */
dst--; /* Also undo writing a single byte too much */
break;
}
if (PROFILE_REPLACE(flags)) {
@@ -3521,8 +3510,7 @@ TableToUtfProc(
ch = UNICODE_REPLACE_CHAR;
} else {
char chbuf[2];
chbuf[0] = byte;
chbuf[1] = 0;
chbuf[0] = byte; chbuf[1] = 0;
TclUtfToUniChar(chbuf, &ch);
}
}
@@ -4079,30 +4067,6 @@ EscapeToUtfProc(
numChars++;
}
if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
/* We have a code fragment left-over at the end */
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
} else {
/* destination is not full, so we really are at the end now */
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_SYNTAX;
} else {
/*
* PROFILE_REPLACE or PROFILE_TCL8. The latter is treated
* similar to former because Tcl8 was broken in this regard
* as it just ignored the byte and truncated which is really
* a no-no as per Unicode recommendations.
*/
result = TCL_OK;
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
numChars++;
/* TCL_CONVERT_MULTIBYTE means all source consumed */
src = srcEnd;
}
}
}
*statePtr = (Tcl_EncodingState) INT2PTR(state);
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
@@ -4648,205 +4612,7 @@ TclGetEncodingProfiles(
}
Tcl_SetObjResult(interp, objPtr);
}
static utf8proc_ssize_t
TclUtfNormalize(
Tcl_Interp *interp, /* Error messages. May be NULL */
const char *bytes, /* Operand encoded in Tcl internal UTF8 */
Tcl_Size numBytes, /* Length bytes[], or -1 if NUL terminated */
Tcl_Encoding encoding, /* Encoding - must be UTF-8. Caller passed for reuse */
Tcl_UnicodeNormalizationForm normForm, /* TCL_{NFC,NFD,NFKC,NFKC} */
int profile, /* TCL_ENCODING_PROFILE_{STRICT,REPLACE} */
utf8proc_uint8_t **bufPtrPtr) /* On success, output length excluding nul */
{
if (profile != TCL_ENCODING_PROFILE_REPLACE &&
profile != TCL_ENCODING_PROFILE_STRICT) {
if (interp) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Invalid value %d passed for encoding profile.",
profile));
}
return -1;
}
utf8proc_option_t options = UTF8PROC_STABLE;
switch (normForm) {
case TCL_NFC:
options |= UTF8PROC_COMPOSE;
break;
case TCL_NFD:
options |= UTF8PROC_DECOMPOSE;
break;
case TCL_NFKC:
options |= UTF8PROC_COMPOSE | UTF8PROC_COMPAT;
break;
case TCL_NFKD:
options |= UTF8PROC_DECOMPOSE | UTF8PROC_COMPAT;
break;
default:
if (interp) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Invalid value %d passed for normalization form.",
normForm));
}
return -1;
}
if (numBytes < 0) {
numBytes = -1;
}
int result;
Tcl_DString dsExt;
result = Tcl_UtfToExternalDStringEx(interp, encoding, bytes, numBytes,
profile, &dsExt, NULL);
/* !!! dsExt needs to be freed even in case of error returns */
utf8proc_ssize_t normLength = -1;
if (result == TCL_OK) {
normLength =
utf8proc_map_custom((utf8proc_uint8_t *)Tcl_DStringValue(&dsExt),
Tcl_DStringLength(&dsExt), bufPtrPtr, options, NULL, NULL);
if (normLength < 0) {
if (interp) {
const char *errorMsg = utf8proc_errmsg(normLength);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(
errorMsg ? errorMsg : "Unicode normalization failed.",
-1));
}
}
}
Tcl_DStringFree(&dsExt);
return normLength;
}
/*
* Tcl_UtfToNormalizedDString --
*
* Converts the passed string to a Unicode normalization form storing
* it in dsPtr.
*
* Results:
* A standard Tcl error code.
*
* Side effects:
* The output string is stored in dsPtr, which is initialized.
*/
int
Tcl_UtfToNormalizedDString(
Tcl_Interp *interp, /* Used for error messages. May be NULL */
const char *bytes, /* Operand encoded in Tcl internal UTF8 */
Tcl_Size numBytes, /* Length of bytes[], or -1 if NUL terminated */
Tcl_UnicodeNormalizationForm normForm, /* TCL_{NFC,NFD,NFKC,NFKC} */
int profile, /* TCL_ENCODING_PROFILE_{STRICT,REPLACE} */
Tcl_DString *dsPtr) /* Converted output string in Tcl internal
* UTF8 encoding. Init'ed by function */
{
Tcl_DStringInit(dsPtr);
Tcl_Encoding encoding = Tcl_GetEncoding(interp, "utf-8");
if (encoding == NULL) {
return TCL_ERROR;
}
utf8proc_uint8_t *normUtf8;
utf8proc_ssize_t normLength;
normLength = TclUtfNormalize(interp, bytes, numBytes, encoding, normForm,
profile, &normUtf8);
if (normLength >= 0) {
assert(normUtf8);
/* Convert standard UTF8 to internal UTF8 */
int result = Tcl_ExternalToUtfDStringEx(interp, encoding,
(const char *)normUtf8, normLength, profile, dsPtr, NULL);
if (result != TCL_OK) {
normLength = -1;
}
free(normUtf8); /* NOT Tcl_Free! */
}
Tcl_FreeEncoding(encoding);
return normLength >= 0 ? TCL_OK : TCL_ERROR;
}
/*
* Tcl_UtfToNormalized --
*
* Converts the passed string to a Unicode normalization form storing
* it in the caller provided buffer.
*
* Results:
* A standard Tcl error code.
*
* Side effects:
* The output string is stored in bufPtr.
*/
int
Tcl_UtfToNormalized(
Tcl_Interp *interp, /* Used for error messages. May be NULL */
const char *bytes, /* Operand encoded in Tcl internal UTF8 */
Tcl_Size numBytes, /* Length of bytes[], or -1 if NUL terminated */
Tcl_UnicodeNormalizationForm normForm, /* TCL_{NFC,NFD,NFKC,NFKC} */
int profile, /* TCL_ENCODING_PROFILE_{STRICT,REPLACE} */
char *bufPtr, /* Pointer to output buffer. Must not be NULL. */
Tcl_Size bufLen, /* Size of bufPtr storage. */
Tcl_Size *lengthPtr) /* Length of the output string in bytes excluding
* the trailing NUL byte. May be NULL */
{
Tcl_Encoding encoding = Tcl_GetEncoding(interp, "utf-8");
if (encoding == NULL) {
return TCL_ERROR;
}
utf8proc_uint8_t *normUtf8;
utf8proc_ssize_t normLength;
normLength = TclUtfNormalize(interp, bytes, numBytes, encoding, normForm,
profile, &normUtf8);
Tcl_FreeEncoding(encoding);
if (normLength < 0) {
return TCL_ERROR;
}
assert(normUtf8);
/* Convert standard UTF8 to internal UTF8 */
int result;
utf8proc_uint8_t *from = normUtf8;
utf8proc_uint8_t *fromEnd = from + normLength;
char *to = bufPtr;
char *toEnd = to + bufLen - 1; /* -1 for trailing NUL */
while (from < fromEnd && to < toEnd) {
/*
* The only difference between UTF-8 and internal UTF-8 is that
* internal UTF-8 does not allow NUL bytes in the middle of the string.
*/
if (*from) {
*to++ = *from++;
} else {
*to++ = 0xC0; /* NUL byte in internal UTF-8 is encoded as C080 */
if (to == toEnd) {
break;
}
*to++ = 0x80;
from++;
}
}
if (from < fromEnd) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Output buffer too small.", -1));
result = TCL_CONVERT_NOSPACE;
} else {
assert(to <= toEnd);
*to = '\0'; /* NUL terminate the output */
if (lengthPtr) {
*lengthPtr = to-bufPtr;
}
result = TCL_OK;
}
free(normUtf8); /* NOT Tcl_Free! */
return result;
}
/*
* Local Variables:
* mode: c
+36 -23
View File
@@ -24,7 +24,7 @@ static int ReadOneEnsembleOption(Tcl_Interp *interp,
static int ReadAllEnsembleOptions(Tcl_Interp *interp,
Tcl_Command token);
static int SetEnsembleConfigOptions(Tcl_Interp *interp,
Tcl_Command token, Tcl_Size objc,
Tcl_Command token, int objc,
Tcl_Obj *const objv[]);
static inline int EnsembleUnknownCallback(Tcl_Interp *interp,
EnsembleConfig *ensemblePtr, int objc,
@@ -230,8 +230,9 @@ TclNamespaceEnsembleCmd(
}
default:
TCL_UNREACHABLE();
Tcl_Panic("unexpected ensemble command");
}
return TCL_OK;
}
/*
@@ -386,8 +387,6 @@ InitEnsembleFromOptions(
}
unknownObj = (len > 0 ? objv[1] : NULL);
continue;
default:
TCL_UNREACHABLE();
}
}
@@ -486,8 +485,6 @@ ReadOneEnsembleOption(
Tcl_SetObjResult(interp, resultObj);
}
break;
default:
TCL_UNREACHABLE();
}
return TCL_OK;
}
@@ -588,7 +585,7 @@ static int
SetEnsembleConfigOptions(
Tcl_Interp *interp,
Tcl_Command token, /* The ensemble to configure. */
Tcl_Size objc, /* The count of option-related arguments. */
int objc, /* The count of option-related arguments. */
Tcl_Obj *const objv[]) /* Option-related arguments. */
{
Tcl_Size len;
@@ -718,8 +715,6 @@ SetEnsembleConfigOptions(
}
unknownObj = (len > 0 ? objv[1] : NULL);
continue;
default:
TCL_UNREACHABLE();
}
}
@@ -1583,8 +1578,7 @@ TclMakeEnsemble(
const char **nameParts = NULL;
const char *cmdName = NULL;
Tcl_Size i, nameCount = 0;
int ensembleFlags = 0;
Tcl_Size hiddenLen;
int ensembleFlags = 0, hiddenLen;
/*
* Construct the path for the ensemble namespace and create it.
@@ -2749,7 +2743,7 @@ BuildEnsembleConfig(
while (!done) {
const char *name = TclGetString(keyObj);
hPtr = Tcl_CreateHashEntry(hash, name, NULL);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
Tcl_SetHashValue(hPtr, valueObj);
Tcl_IncrRefCount(valueObj);
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
@@ -3260,7 +3254,18 @@ TclCompileEnsemble(
* Throw out any line information generated by the failed compile attempt.
*/
ClearFailedCompile(envPtr);
while (mapPtr->nuloc > eclIndex + 1) {
mapPtr->nuloc--;
Tcl_Free(mapPtr->loc[mapPtr->nuloc].line);
mapPtr->loc[mapPtr->nuloc].line = NULL;
}
/*
* Reset the index of next command. Toss out any from failed nested
* partial compiles.
*/
envPtr->numCommands = mapPtr->nuloc;
/*
* Failed to do a full compile for some reason. Try to do a direct invoke
@@ -3320,7 +3325,7 @@ TclAttemptCompileProc(
Tcl_Size i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
Tcl_Size savedStackDepth = envPtr->currStackDepth;
Tcl_Size savedCodeNext = CurrentOffset(envPtr);
Tcl_Size savedCodeNext = envPtr->codeNext - envPtr->codeStart;
Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
@@ -3348,8 +3353,8 @@ TclAttemptCompileProc(
* index values.
*/
ExtCmdLocation.line += (depth - 1);
ExtCmdLocation.next += (depth - 1);
mapPtr->loc[eclIndex].line += (depth - 1);
mapPtr->loc[eclIndex].next += (depth - 1);
/*
* Hand off compilation to the subcommand compiler. At last!
@@ -3361,8 +3366,8 @@ TclAttemptCompileProc(
* Undo the shift.
*/
ExtCmdLocation.line -= (depth - 1);
ExtCmdLocation.next -= (depth - 1);
mapPtr->loc[eclIndex].line -= (depth - 1);
mapPtr->loc[eclIndex].next -= (depth - 1);
parsePtr->numWords += (depth - 1);
parsePtr->tokenPtr = saveTokenPtr;
@@ -3452,8 +3457,9 @@ CompileToInvokedCommand(
DefineLineInformation;
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
const char *bytes;
int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
Tcl_Size i, numWords;
Tcl_Size i, numWords, length;
/*
* Push the words of the command. Take care; the command words may be
@@ -3465,13 +3471,15 @@ CompileToInvokedCommand(
for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
i++, tokPtr = TokenAfter(tokPtr)) {
if (i > 0 && i <= numWords) {
PUSH_OBJ( words[i - 1]);
bytes = TclGetStringFromObj(words[i - 1], &length);
PushLiteral(envPtr, bytes, length);
continue;
}
SetLineInformation(i);
if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
int literal = PUSH_SIMPLE_TOKEN(tokPtr);
int literal = TclRegisterLiteral(envPtr,
tokPtr[1].start, tokPtr[1].size, 0);
if (envPtr->clNext) {
TclContinuationsEnterDerived(
@@ -3479,6 +3487,7 @@ CompileToInvokedCommand(
tokPtr[1].start - envPtr->source,
envPtr->clNext);
}
TclEmitPush(literal, envPtr);
} else {
CompileTokens(envPtr, tokPtr, interp);
}
@@ -3491,17 +3500,21 @@ CompileToInvokedCommand(
TclNewObj(objPtr);
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
bytes = TclGetStringFromObj(objPtr, &length);
if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
extraLiteralFlags |= LITERAL_UNSHARED;
}
cmdLit = PUSH_OBJ_FLAGS(objPtr, extraLiteralFlags);
cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
TclEmitPush(cmdLit, envPtr);
TclDecrRefCount(objPtr);
/*
* Do the replacing dispatch.
*/
INVOKE41( INVOKE_REPLACE, parsePtr->numWords, numWords+1);
TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,
numWords + 1);
}
/*
+1 -1
View File
@@ -45,7 +45,7 @@ static struct {
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
techar **ourEnviron; /* Cache of the array that we allocate. We
techar **ourEnviron; /* Cache of the array that we allocate. We
* need to track this in case another
* subsystem swaps around the environ array
* like we do. */
+17 -26
View File
@@ -35,13 +35,6 @@ typedef struct BgError {
* list. */
} BgError;
/*
* The assoc data key used in this file. The data associated with it is a
* reference to an ErrAssocData structure, and will be deallocated with
* BgErrorDeleteProc at the appropriate time.
*/
#define ASSOC_KEY "tclBgError"
/*
* One of the structures below is associated with the "tclBgError" assoc data
* for each interpreter. It keeps track of the head and tail of the list of
@@ -79,7 +72,7 @@ typedef struct {
typedef struct ExitHandler {
Tcl_ExitProc *proc; /* Function to call when process exits. */
void *clientData; /* One word of information to pass to proc. */
void *clientData; /* One word of information to pass to proc. */
struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
* application, or NULL for end of list. */
} ExitHandler;
@@ -129,7 +122,7 @@ static Tcl_ThreadDataKey dataKey;
#if TCL_THREADS
typedef struct {
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
void *clientData; /* The one argument to Main() */
void *clientData; /* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(void *clientData);
#endif /* TCL_THREADS */
@@ -189,7 +182,7 @@ Tcl_BackgroundException(
errPtr->nextPtr = NULL;
(void) TclGetBgErrorHandler(interp);
assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr->firstBgPtr == NULL) {
assocPtr->firstBgPtr = errPtr;
Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
@@ -219,7 +212,7 @@ Tcl_BackgroundException(
static void
HandleBgErrors(
void *clientData) /* Pointer to ErrAssocData structure. */
void *clientData) /* Pointer to ErrAssocData structure. */
{
ErrAssocData *assocPtr = (ErrAssocData *)clientData;
Tcl_Interp *interp = assocPtr->interp;
@@ -529,7 +522,7 @@ TclSetBgErrorHandler(
Tcl_Interp *interp,
Tcl_Obj *cmdPrefix)
{
ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
if (cmdPrefix == NULL) {
Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
@@ -544,7 +537,7 @@ TclSetBgErrorHandler(
assocPtr->cmdPrefix = NULL;
assocPtr->firstBgPtr = NULL;
assocPtr->lastBgPtr = NULL;
Tcl_SetAssocData(interp, ASSOC_KEY, BgErrorDeleteProc, assocPtr);
Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
}
if (assocPtr->cmdPrefix) {
Tcl_DecrRefCount(assocPtr->cmdPrefix);
@@ -574,14 +567,14 @@ Tcl_Obj *
TclGetBgErrorHandler(
Tcl_Interp *interp)
{
ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr == NULL) {
Tcl_Obj *bgerrorObj;
TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
TclSetBgErrorHandler(interp, bgerrorObj);
assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
}
return assocPtr->cmdPrefix;
}
@@ -607,7 +600,7 @@ TclGetBgErrorHandler(
static void
BgErrorDeleteProc(
void *clientData, /* Pointer to ErrAssocData structure. */
void *clientData, /* Pointer to ErrAssocData structure. */
TCL_UNUSED(Tcl_Interp *))
{
ErrAssocData *assocPtr = (ErrAssocData *)clientData;
@@ -646,7 +639,7 @@ BgErrorDeleteProc(
void
Tcl_CreateExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
void *clientData) /* Arbitrary value to pass to proc. */
void *clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
@@ -679,7 +672,7 @@ Tcl_CreateExitHandler(
void
TclCreateLateExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
void *clientData) /* Arbitrary value to pass to proc. */
void *clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
@@ -712,7 +705,7 @@ TclCreateLateExitHandler(
void
Tcl_DeleteExitHandler(
Tcl_ExitProc *proc, /* Function that was previously registered. */
void *clientData) /* Arbitrary value to pass to proc. */
void *clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
@@ -755,7 +748,7 @@ Tcl_DeleteExitHandler(
void
TclDeleteLateExitHandler(
Tcl_ExitProc *proc, /* Function that was previously registered. */
void *clientData) /* Arbitrary value to pass to proc. */
void *clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
@@ -798,7 +791,7 @@ TclDeleteLateExitHandler(
void
Tcl_CreateThreadExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
void *clientData) /* Arbitrary value to pass to proc. */
void *clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -831,7 +824,7 @@ Tcl_CreateThreadExitHandler(
void
Tcl_DeleteThreadExitHandler(
Tcl_ExitProc *proc, /* Function that was previously registered. */
void *clientData) /* Arbitrary value to pass to proc. */
void *clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1657,8 +1650,6 @@ Tcl_VwaitObjCmd(
vwaitItems[numItems].sourceObj = objv[i];
numItems++;
break;
default:
TCL_UNREACHABLE();
}
}
@@ -1734,7 +1725,7 @@ Tcl_VwaitObjCmd(
foundEvent = 1;
while (!timedOut && foundEvent &&
((!any && (done < numItems)) || (any && !done))) {
((!any && (done < numItems)) || (any && !done))) {
foundEvent = Tcl_DoOneEvent(mask);
if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
break;
@@ -1976,7 +1967,7 @@ Tcl_UpdateObjCmd(
flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
TCL_UNREACHABLE();
Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
}
} else {
Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
+1239 -1841
View File
File diff suppressed because it is too large Load Diff
+44 -38
View File
@@ -26,34 +26,6 @@ static int FileCopyRename(Tcl_Interp *interp,
static int FileForceOption(Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[], int *forcePtr);
/*
*---------------------------------------------------------------------------
*
* CheckFilenameEncodable
*
* This checks if a filename can be encoded on the target platform,
* disallowing things like naked surrogates, etc.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May update the interpreter result with an error message on failure.
*
*---------------------------------------------------------------------------
*/
static inline int
CheckFilenameEncodable(
Tcl_Interp *interp,
Tcl_Obj *fileName)
{
Tcl_DString ds;
int code = Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING,
TclGetString(fileName), TCL_INDEX_NONE, 0, &ds, NULL);
Tcl_DStringFree(&ds);
return code == TCL_OK ? TCL_OK : TCL_ERROR;
}
/*
*---------------------------------------------------------------------------
*
@@ -141,6 +113,7 @@ FileCopyRename(
int i, result, force;
Tcl_StatBuf statBuf;
Tcl_Obj *target;
Tcl_DString ds;
i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i < 0) {
@@ -162,9 +135,12 @@ FileCopyRename(
if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, target) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(target),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
result = TCL_OK;
@@ -256,6 +232,7 @@ TclFileMakeDirsCmd(
Tcl_Obj *split = NULL;
Tcl_Obj *target = NULL;
Tcl_StatBuf statBuf;
Tcl_DString ds;
result = TCL_OK;
for (i = 1; i < objc; i++) {
@@ -263,10 +240,13 @@ TclFileMakeDirsCmd(
result = TCL_ERROR;
break;
}
if (CheckFilenameEncodable(interp, objv[i]) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[i]),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
result = TCL_ERROR;
break;
}
Tcl_DStringFree(&ds);
split = Tcl_FSSplitPath(objv[i], &pobjc);
Tcl_IncrRefCount(split);
@@ -382,6 +362,7 @@ TclFileDeleteCmd(
int i, force, result;
Tcl_Obj *errfile;
Tcl_Obj *errorBuffer = NULL;
Tcl_DString ds;
i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i < 0) {
@@ -399,10 +380,13 @@ TclFileDeleteCmd(
result = TCL_ERROR;
goto done;
}
if (CheckFilenameEncodable(interp, objv[i]) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[i]),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
result = TCL_ERROR;
goto done;
}
Tcl_DStringFree(&ds);
/*
* Call lstat() to get info so can delete symbolic link itself.
@@ -522,19 +506,26 @@ CopyRenameOneFile(
Tcl_Obj *actualSource=NULL; /* If source is a link, then this is the real
* file/directory. */
Tcl_StatBuf sourceStatBuf, targetStatBuf;
Tcl_DString ds;
if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, source) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(source),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, target) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(target),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
errfile = NULL;
errorBuffer = NULL;
@@ -612,7 +603,7 @@ CopyRenameOneFile(
{
Tcl_Obj *perm;
Tcl_Size index;
int index;
TclNewLiteralStringObj(perm, "u+w");
Tcl_IncrRefCount(perm);
@@ -994,6 +985,7 @@ TclFileAttrsCmd(
Tcl_Obj *objStrings = NULL;
Tcl_Size numObjStrings = TCL_INDEX_NONE;
Tcl_Obj *filePtr;
Tcl_DString ds;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
@@ -1004,9 +996,12 @@ TclFileAttrsCmd(
if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, filePtr) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(filePtr),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
objc -= 2;
objv += 2;
@@ -1209,6 +1204,7 @@ TclFileLinkCmd(
{
Tcl_Obj *contents;
int index;
Tcl_DString ds;
if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
@@ -1251,9 +1247,12 @@ TclFileLinkCmd(
if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, objv[index]) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
/*
* Create link from source to target.
@@ -1311,9 +1310,12 @@ TclFileLinkCmd(
if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, objv[index]) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
/*
* Read link
@@ -1365,6 +1367,7 @@ TclFileReadLinkCmd(
Tcl_Obj *const objv[])
{
Tcl_Obj *contents;
Tcl_DString ds;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
@@ -1374,9 +1377,12 @@ TclFileReadLinkCmd(
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
return TCL_ERROR;
}
if (CheckFilenameEncodable(interp, objv[1]) != TCL_OK) {
if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[1]),
TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
contents = Tcl_FSLink(objv[1], NULL, 0);
-2
View File
@@ -1233,8 +1233,6 @@ Tcl_GlobObjCmd(
case GLOB_LAST: /* -- */
i++;
goto endOfForLoop;
default:
TCL_UNREACHABLE();
}
}
+51 -79
View File
@@ -13,12 +13,6 @@
#include "tclInt.h"
/*
* Prevent macros from clashing with function definitions.
*/
#undef Tcl_CreateHashEntry
/*
* When there are this many entries per bucket, on average, rebuild the hash
* table to make it larger.
@@ -55,13 +49,12 @@ static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr,
* Function prototypes for static functions in this file:
*/
static Tcl_HashEntry * BogusFind(Tcl_HashTable *tablePtr, const char *key);
static Tcl_HashEntry * BogusCreate(Tcl_HashTable *tablePtr, const char *key,
int *newPtr);
static Tcl_HashEntry * CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
int *newPtr);
#ifndef TCL_NO_DEPRECATED
static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
#endif
static void RebuildTable(Tcl_HashTable *tablePtr);
const Tcl_HashKeyType tclArrayHashKeyType = {
@@ -111,7 +104,8 @@ const Tcl_HashKeyType tclStringHashKeyType = {
void
Tcl_InitHashTable(
Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied
Tcl_HashTable *tablePtr,
/* Pointer to table record, which is supplied
* by the caller. */
int keyType) /* Type of keys to use in table:
* TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an
@@ -148,7 +142,8 @@ Tcl_InitHashTable(
void
Tcl_InitCustomHashTable(
Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied
Tcl_HashTable *tablePtr,
/* Pointer to table record, which is supplied
* by the caller. */
int keyType, /* Type of keys to use in table:
* TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
@@ -171,9 +166,7 @@ Tcl_InitCustomHashTable(
tablePtr->downShift = 28;
tablePtr->mask = 3;
tablePtr->keyType = keyType;
#ifndef TCL_NO_DEPRECATED
tablePtr->findProc = FindHashEntry;
#endif
tablePtr->createProc = CreateHashEntry;
if (typePtr == NULL) {
@@ -212,20 +205,18 @@ Tcl_InitCustomHashTable(
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static Tcl_HashEntry *
FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const char *key) /* Key to use to find matching entry. */
{
return tablePtr->createProc(tablePtr, key, TCL_HASH_FIND);
return CreateHashEntry(tablePtr, key, NULL);
}
#endif
/*
*----------------------------------------------------------------------
*
* Tcl_CreateHashEntry --
* CreateHashEntry --
*
* Given a hash table with string keys, and a string key, find the entry
* with a matching key. If there is no matching entry, then create a new
@@ -243,38 +234,6 @@ FindHashEntry(
*----------------------------------------------------------------------
*/
Tcl_HashEntry *
Tcl_CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const void *key, /* Key to use to find or create matching
* entry. */
int *newPtr) /* Store info here telling whether a new entry
* was created. */
{
Tcl_HashEntry *entry = (*((tablePtr)->createProc))(tablePtr, (const char *)key, newPtr);
if (!entry) {
Tcl_Panic("%s: Memory overflow", "Tcl_CreateHashEntry");
}
return entry;
}
Tcl_HashEntry *
Tcl_DbCreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const void *key, /* Key to use to find or create matching
* entry. */
int *newPtr, /* Store info here telling whether a new entry
* was created. */
const char *file,
int line)
{
Tcl_HashEntry *entry = (*((tablePtr)->createProc))(tablePtr, (const char *)key, newPtr);
if (!entry) {
Tcl_Panic("%s: Memory overflow in file %s:%d", "Tcl_CreateHashEntry", file, line);
}
return entry;
}
static Tcl_HashEntry *
CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -325,7 +284,7 @@ CreateHashEntry(
/* if keys pointers or values are equal */
if ((key == hPtr->key.oneWordValue)
|| compareKeysProc((void *) key, hPtr)) {
if (newPtr && (newPtr != TCL_HASH_FIND)) {
if (newPtr) {
*newPtr = 0;
}
return hPtr;
@@ -340,7 +299,7 @@ CreateHashEntry(
/* if needle pointer equals content pointer or values equal */
if ((key == hPtr->key.string)
|| compareKeysProc((void *) key, hPtr)) {
if (newPtr && (newPtr != TCL_HASH_FIND)) {
if (newPtr) {
*newPtr = 0;
}
return hPtr;
@@ -354,7 +313,7 @@ CreateHashEntry(
continue;
}
if (key == hPtr->key.oneWordValue) {
if (newPtr && (newPtr != TCL_HASH_FIND)) {
if (newPtr) {
*newPtr = 0;
}
return hPtr;
@@ -362,8 +321,7 @@ CreateHashEntry(
}
}
if (newPtr == TCL_HASH_FIND) {
/* This is the findProc functionality, so we are done. */
if (!newPtr) {
return NULL;
}
@@ -371,16 +329,11 @@ CreateHashEntry(
* Entry not found. Add a new one to the bucket.
*/
if (newPtr) {
*newPtr = 1;
}
*newPtr = 1;
if (typePtr->allocEntryProc) {
hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
} else {
hPtr = (Tcl_HashEntry *)Tcl_AttemptAlloc(sizeof(Tcl_HashEntry));
if (!hPtr) {
return NULL;
}
hPtr = (Tcl_HashEntry *)Tcl_Alloc(sizeof(Tcl_HashEntry));
hPtr->key.oneWordValue = (char *) key;
Tcl_SetHashValue(hPtr, NULL);
}
@@ -544,9 +497,7 @@ Tcl_DeleteHashTable(
* re-initialization.
*/
#ifndef TCL_NO_DEPRECATED
tablePtr->findProc = FindHashEntry;
#endif
tablePtr->findProc = BogusFind;
tablePtr->createProc = BogusCreate;
}
@@ -672,9 +623,9 @@ Tcl_HashStats(
} else {
overflow++;
}
tmp = (double)j;
tmp = j;
if (tablePtr->numEntries != 0) {
average += (tmp+1.0)*(tmp/(double)tablePtr->numEntries)/2.0;
average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
}
}
@@ -726,12 +677,10 @@ AllocArrayEntry(
if (size < sizeof(Tcl_HashEntry)) {
size = sizeof(Tcl_HashEntry);
}
hPtr = (Tcl_HashEntry *)Tcl_AttemptAlloc(size);
hPtr = (Tcl_HashEntry *)Tcl_Alloc(size);
if (hPtr) {
memcpy(hPtr->key.string, keyPtr, count);
Tcl_SetHashValue(hPtr, NULL);
}
memcpy(hPtr->key.string, keyPtr, count);
Tcl_SetHashValue(hPtr, NULL);
return hPtr;
}
@@ -826,12 +775,10 @@ AllocStringEntry(
if (size < sizeof(hPtr->key)) {
allocsize = sizeof(hPtr->key);
}
hPtr = (Tcl_HashEntry *)Tcl_AttemptAlloc(offsetof(Tcl_HashEntry, key) + allocsize);
if (hPtr) {
memset(hPtr, 0, offsetof(Tcl_HashEntry, key) + allocsize);
memcpy(hPtr->key.string, string, size);
Tcl_SetHashValue(hPtr, NULL);
}
hPtr = (Tcl_HashEntry *)Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize);
memset(hPtr, 0, offsetof(Tcl_HashEntry, key) + allocsize);
memcpy(hPtr->key.string, string, size);
Tcl_SetHashValue(hPtr, NULL);
return hPtr;
}
@@ -926,6 +873,32 @@ TclHashStringKey(
return result;
}
/*
*----------------------------------------------------------------------
*
* BogusFind --
*
* This function is invoked when Tcl_FindHashEntry is called on a
* table that has been deleted.
*
* Results:
* If Tcl_Panic returns (which it shouldn't) this function returns NULL.
*
* Side effects:
* Generates a panic.
*
*----------------------------------------------------------------------
*/
static Tcl_HashEntry *
BogusFind(
TCL_UNUSED(Tcl_HashTable *),
TCL_UNUSED(const char *))
{
Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
return NULL;
}
/*
*----------------------------------------------------------------------
*
@@ -947,10 +920,9 @@ static Tcl_HashEntry *
BogusCreate(
TCL_UNUSED(Tcl_HashTable *),
TCL_UNUSED(const char *),
int *isNew)
TCL_UNUSED(int *))
{
Tcl_Panic("called %s on deleted table",
(isNew != TCL_HASH_FIND)? "Tcl_CreateHashEntry" : "Tcl_FindHashEntry");
Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
return NULL;
}
+20 -32
View File
@@ -137,12 +137,6 @@ typedef struct {
static Tcl_ThreadDataKey dataKey;
/*
* Key for looking up the channel table (a Tcl_HashTable indexed by channel
* name) in the interpreter's associated data table.
*/
#define ASSOC_KEY "tclIO"
/*
* Structure to record a close callback. One such record exists for
* each close callback registered for a channel.
@@ -366,8 +360,8 @@ static const Tcl_ObjType chanObjType = {
} while (0)
#define BUSY_STATE(st, fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
@@ -744,10 +738,8 @@ Tcl_SetStdChannel(
tsdPtr->stderrInitialized = init;
tsdPtr->stderrChannel = channel;
if (channel) {
ENCODING_PROFILE_SET(((Channel *)channel)->state->inputEncodingFlags,
TCL_ENCODING_PROFILE_REPLACE);
ENCODING_PROFILE_SET(((Channel *)channel)->state->outputEncodingFlags,
TCL_ENCODING_PROFILE_REPLACE);
ENCODING_PROFILE_SET(((Channel *)channel)->state->inputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
ENCODING_PROFILE_SET(((Channel *)channel)->state->outputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
}
break;
}
@@ -819,10 +811,8 @@ Tcl_GetStdChannel(
tsdPtr->stderrInitialized = -1;
tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
if (tsdPtr->stderrChannel != NULL) {
ENCODING_PROFILE_SET(((Channel *)tsdPtr->stderrChannel)->state->inputEncodingFlags,
TCL_ENCODING_PROFILE_REPLACE);
ENCODING_PROFILE_SET(((Channel *)tsdPtr->stderrChannel)->state->outputEncodingFlags,
TCL_ENCODING_PROFILE_REPLACE);
ENCODING_PROFILE_SET(((Channel *)tsdPtr->stderrChannel)->state->inputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
ENCODING_PROFILE_SET(((Channel *)tsdPtr->stderrChannel)->state->outputEncodingFlags, TCL_ENCODING_PROFILE_REPLACE);
tsdPtr->stderrInitialized = 1;
Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
}
@@ -942,11 +932,11 @@ GetChannelTable(
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_Channel stdinChan, stdoutChan, stderrChan;
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, ASSOC_KEY,
Tcl_SetAssocData(interp, "tclIO",
(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
/*
@@ -1382,7 +1372,7 @@ DetachChannel(
statePtr = chanPtr->state;
if (interp != NULL) {
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return TCL_ERROR;
}
@@ -1627,12 +1617,10 @@ Tcl_CreateChannel(
Tcl_Panic("channel type %s must define close2Proc", typePtr->typeName);
}
if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
Tcl_Panic("channel type %s must define inputProc when used for reader channel",
typePtr->typeName);
Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
}
if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) {
Tcl_Panic("channel type %s must define outputProc when used for writer channel",
typePtr->typeName);
Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
}
if (NULL == typePtr->watchProc) {
Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
@@ -2450,9 +2438,9 @@ Tcl_GetChannelHandle(
int
Tcl_RemoveChannelMode(
Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */
Tcl_Channel chan, /* The channel which is modified. */
int mode) /* The access mode to drop from the channel */
Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */
Tcl_Channel chan, /* The channel which is modified. */
int mode) /* The access mode to drop from the channel */
{
const char* emsg;
ChannelState *statePtr = ((Channel *) chan)->state;
@@ -2470,7 +2458,7 @@ Tcl_RemoveChannelMode(
ResetFlag(statePtr, mode);
return TCL_OK;
error:
error:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Tcl_RemoveChannelMode error: %s. Channel: \"%s\"",
@@ -9435,8 +9423,7 @@ TclCopyChannel(
* completed.
*/
csPtr = (CopyState *)
Tcl_Alloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize);
csPtr = (CopyState *)Tcl_Alloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize);
csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
@@ -9815,7 +9802,7 @@ CopyData(
if (moveBytes) {
size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
@@ -10178,7 +10165,8 @@ DoRead(
}
if (!bufPtr) {
readErr:
readErr:
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return -1;
@@ -10714,7 +10702,7 @@ Tcl_IsChannelRegistered(
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return 0;
}
+6 -1
View File
@@ -95,7 +95,7 @@ typedef struct EventScriptRecord {
*/
typedef struct Channel {
struct ChannelState *state; /* Split out state information */
struct ChannelState *state; /* Split out state information */
void *instanceData; /* Instance-specific data provided by creator
* of channel. */
const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
@@ -158,6 +158,11 @@ typedef struct ChannelState {
* of line sequences in output? */
int inEofChar; /* If nonzero, use this as a signal of EOF on
* input. */
#if TCL_MAJOR_VERSION < 9
int outEofChar; /* If nonzero, append this to the channel when
* it is closed if it is open for writing.
* For Tcl 8.x only */
#endif
int unreportedError; /* Non-zero if an error report was deferred
* because it happened in the background. The
* value is the POSIX error code. */
+23 -67
View File
@@ -34,13 +34,6 @@ typedef struct {
static Tcl_ThreadDataKey dataKey;
/*
* Key for looking up the table of registered TCP accept callbacks, a hash
* table indexed by AcceptCallback references, used as a set (values are
* meaningless).
*/
#define ASSOC_KEY "tclTCPAcceptCallbacks"
/*
* Static functions for this file:
*/
@@ -142,7 +135,7 @@ Tcl_PutsObjCmd(
string = objv[3];
break;
}
TCL_FALLTHROUGH();
/* Fall through */
default: /* [puts] or
* [puts some bad number of arguments...] */
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channel? string");
@@ -376,8 +369,8 @@ Tcl_ReadObjCmd(
{
Tcl_Channel chan; /* The channel to read from. */
int newline, i; /* Discard newline at end? */
Tcl_WideInt toRead; /* How many bytes to read? */
Tcl_Size charactersRead; /* How many characters were read? */
Tcl_WideInt toRead; /* How many bytes to read? */
Tcl_Size charactersRead; /* How many characters were read? */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *resultPtr, *chanObjPtr;
@@ -917,12 +910,11 @@ Tcl_ExecObjCmd(
int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
Tcl_Size length;
static const char *const options[] = {
"-ignorestderr", "-keepnewline", "-encoding", "--", NULL
"-ignorestderr", "-keepnewline", "--", NULL
};
enum execOptionsEnum {
EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_ENCODING, EXEC_LAST
EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
};
Tcl_Obj *encodingObj = NULL;
/*
* Check for any leading option arguments.
@@ -939,32 +931,12 @@ Tcl_ExecObjCmd(
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == EXEC_LAST) {
skip++;
break;
}
switch (index) {
case EXEC_KEEPNEWLINE:
if (index == EXEC_KEEPNEWLINE) {
keepNewline = 1;
break;
case EXEC_IGNORESTDERR:
} else if (index == EXEC_IGNORESTDERR) {
ignoreStderr = 1;
break;
case EXEC_ENCODING:
if (++skip >= objc) {
Tcl_SetResult(interp, "No value given for option -encoding.",
TCL_STATIC);
return TCL_ERROR;
} else {
Tcl_Encoding encoding;
encodingObj = objv[skip];
/* Verify validity - bug [da5e1bc7bc] */
if (Tcl_GetEncodingFromObj(interp, encodingObj, &encoding)
!= TCL_OK) {
return TCL_ERROR;
}
Tcl_FreeEncoding(encoding);
}
} else {
skip++;
break;
}
}
@@ -1014,6 +986,11 @@ Tcl_ExecObjCmd(
return TCL_ERROR;
}
/* Bug [0f1ddc0df7] - encoding errors - use replace profile */
if (Tcl_SetChannelOption(NULL, chan, "-profile", "replace") != TCL_OK) {
return TCL_ERROR;
}
if (background) {
/*
* Store the list of PIDs from the pipeline in interp's result and
@@ -1027,18 +1004,6 @@ Tcl_ExecObjCmd(
return TCL_OK;
}
/* Bug [0f1ddc0df7] - encoding errors - use replace profile */
if (Tcl_SetChannelOption(interp, chan, "-profile", "replace") != TCL_OK) {
goto errorWithOpenChannel;
}
/* TIP 716 */
if (encodingObj &&
Tcl_SetChannelOption(interp, chan, "-encoding",
Tcl_GetString(encodingObj)) != TCL_OK) {
goto errorWithOpenChannel;
}
TclNewObj(resultPtr);
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
@@ -1055,7 +1020,7 @@ Tcl_ExecObjCmd(
Tcl_PosixError(interp)));
Tcl_DecrRefCount(resultPtr);
}
goto errorWithOpenChannel;
return TCL_ERROR;
}
}
@@ -1082,11 +1047,6 @@ Tcl_ExecObjCmd(
Tcl_SetObjResult(interp, resultPtr);
return result;
errorWithOpenChannel:
/* Interpreter should already contain error. Pass NULL to not overwrite */
(void)Tcl_CloseEx(NULL, chan, 0);
return TCL_ERROR;
}
/*
@@ -1176,7 +1136,7 @@ Tcl_OpenObjCmd(
if (objc == 4) {
const char *permString = TclGetString(objv[3]);
int code = TCL_ERROR;
Tcl_Size scanned = TclParseAllWhiteSpace(permString, -1);
int scanned = TclParseAllWhiteSpace(permString, -1);
/*
* Support legacy octal numbers.
@@ -1279,7 +1239,7 @@ Tcl_OpenObjCmd(
static void
TcpAcceptCallbacksDeleteProc(
void *clientData, /* Data which was passed when the assocdata
void *clientData, /* Data which was passed when the assocdata
* was registered. */
TCL_UNUSED(Tcl_Interp *))
{
@@ -1331,12 +1291,12 @@ RegisterTcpServerInterpCleanup(
Tcl_HashEntry *hPtr; /* Entry for this record. */
int isNew; /* Is the entry new? */
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
Tcl_SetAssocData(interp, ASSOC_KEY,
Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, hTblPtr);
}
@@ -1377,7 +1337,7 @@ UnregisterTcpServerInterpCleanupProc(
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
return;
}
@@ -1407,7 +1367,7 @@ UnregisterTcpServerInterpCleanupProc(
static void
AcceptCallbackProc(
void *callbackData, /* The data stored when the callback was
void *callbackData, /* The data stored when the callback was
* created in the call to
* Tcl_OpenTcpServer. */
Tcl_Channel chan, /* Channel for the newly accepted
@@ -1498,7 +1458,7 @@ AcceptCallbackProc(
static void
TcpServerCloseProc(
void *callbackData) /* The data passed in the call to
void *callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
@@ -1645,7 +1605,7 @@ Tcl_SocketObjCmd(
}
break;
default:
TCL_UNREACHABLE();
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
}
}
if (server) {
@@ -1850,8 +1810,6 @@ Tcl_FcopyObjCmd(
case FcopyCommand:
cmdPtr = objv[i+1];
break;
default:
TCL_UNREACHABLE();
}
}
@@ -1918,8 +1876,6 @@ ChanPendingObjCmd(
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_OutputBuffered(chan)));
}
break;
default:
TCL_UNREACHABLE();
}
return TCL_OK;
}
+11 -12
View File
@@ -56,7 +56,7 @@ typedef struct TransformChannelData TransformChannelData;
static int ExecuteCallback(TransformChannelData *ctrl,
Tcl_Interp *interp, unsigned char *op,
unsigned char *buf, Tcl_Size bufLen, int transmit,
unsigned char *buf, int bufLen, int transmit,
int preserve);
/*
@@ -267,8 +267,8 @@ TclChannelTransform(
}
if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"-command value is not a list", -1));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("-command value is not a list", -1));
return TCL_ERROR;
}
@@ -366,7 +366,7 @@ ExecuteCallback(
Tcl_Interp *interp, /* Current interpreter, possibly NULL. */
unsigned char *op, /* Operation invoking the callback. */
unsigned char *buf, /* Buffer to give to the script. */
Tcl_Size bufLen, /* And its length. */
int bufLen, /* And its length. */
int transmit, /* Flag, determines whether the result of the
* callback is sent to the underlying channel
* or not. */
@@ -515,7 +515,7 @@ ExecuteCallback(
static int
TransformBlockModeProc(
void *instanceData, /* State of transformation. */
void *instanceData, /* State of transformation. */
int mode) /* New blocking mode. */
{
TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
@@ -637,8 +637,7 @@ TransformInputProc(
int *errorCodePtr)
{
TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
int gotBytes, copied;
Tcl_Size read;
int gotBytes, read, copied;
Tcl_Channel downChan;
/*
@@ -1014,7 +1013,7 @@ TransformGetOptionProc(
static void
TransformWatchProc(
void *instanceData, /* Channel to watch. */
void *instanceData, /* Channel to watch. */
int mask) /* Events of interest. */
{
TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
@@ -1092,9 +1091,9 @@ TransformWatchProc(
static int
TransformGetFileHandleProc(
void *instanceData, /* Channel to query. */
void *instanceData, /* Channel to query. */
int direction, /* Direction of interest. */
void **handlePtr) /* Place to store the handle into. */
void **handlePtr) /* Place to store the handle into. */
{
TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
@@ -1126,7 +1125,7 @@ TransformGetFileHandleProc(
static int
TransformNotifyProc(
void *clientData, /* The state of the notified
void *clientData, /* The state of the notified
* transformation. */
int mask) /* The mask of occurring events. */
{
@@ -1171,7 +1170,7 @@ TransformNotifyProc(
static void
TransformChannelHandlerTimer(
void *clientData) /* Transformation to query. */
void *clientData) /* Transformation to query. */
{
TransformChannelData *dataPtr = (TransformChannelData *)clientData;
+24 -27
View File
@@ -162,7 +162,7 @@ typedef enum {
static const char *const methodNames[] = {
"blocking", /* OPT */
"cget", /* OPT \/ Together or none */
"cgetall", /* OPT /\ of these two. */
"cgetall", /* OPT /\ of these two */
"configure", /* OPT */
"finalize", /* */
"initialize", /* */
@@ -461,9 +461,8 @@ static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost = "{Owner lost}";
static const char *msg_dstlost =
"-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
static const char *msg_send_dstlost = "{Owner lost}";
static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
/*
* Main methods to plug into the 'chan' ensemble'. ==================
@@ -723,7 +722,7 @@ TclChanCreateObjCmd(
#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
NULL);
&isNew);
Tcl_SetHashValue(hPtr, chan);
#endif
@@ -914,8 +913,8 @@ TclChanPostEventObjCmd(
return TCL_ERROR;
}
if (events == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad event list: is empty", -1));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("bad event list: is empty", -1));
return TCL_ERROR;
}
@@ -1351,14 +1350,14 @@ ReflectInput(
memcpy(buf, bytev, bytec);
}
stop:
stop:
Tcl_DecrRefCount(toReadObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return bytec;
invalid:
invalid:
*errorCodePtr = EINVAL;
error:
error:
bytec = -1;
goto stop;
}
@@ -1479,15 +1478,15 @@ ReflectOutput(
}
*errorCodePtr = EOK;
stop:
stop:
Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr->interp);
Tcl_Release(rcPtr);
return written;
invalid:
invalid:
*errorCodePtr = EINVAL;
error:
error:
written = -1;
goto stop;
}
@@ -1572,13 +1571,13 @@ ReflectSeekWide(
}
*errorCodePtr = EOK;
stop:
stop:
Tcl_DecrRefCount(offObj);
Tcl_DecrRefCount(baseObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return newLoc;
invalid:
invalid:
*errorCodePtr = EINVAL;
newLoc = -1;
goto stop;
@@ -1779,7 +1778,7 @@ ReflectThread(
static int
ReflectSetOption(
void *clientData, /* Channel to query */
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
@@ -1851,7 +1850,7 @@ ReflectSetOption(
static int
ReflectGetOption(
void *clientData, /* Channel to query */
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
@@ -1972,16 +1971,16 @@ ReflectGetOption(
goto ok;
}
ok:
ok:
result = TCL_OK;
stop:
stop:
if (optionObj) {
Tcl_DecrRefCount(optionObj);
}
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return result;
error:
error:
result = TCL_ERROR;
goto stop;
}
@@ -2004,7 +2003,7 @@ ReflectGetOption(
static int
ReflectTruncate(
void *clientData, /* Channel to query */
void *clientData, /* Channel to query */
long long length) /* Length to truncate to. */
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -2087,7 +2086,7 @@ EncodeEventMask(
int *mask)
{
int events; /* Mask of events to post */
Tcl_Size listc; /* #elements in eventspec list */
Tcl_Size listc; /* #elements in eventspec list */
Tcl_Obj **listv; /* Elements of eventspec list */
int evIndex; /* Id of event for an element of the eventspec
* list. */
@@ -2109,8 +2108,6 @@ EncodeEventMask(
case EVENT_WRITE:
events |= TCL_WRITABLE;
break;
default:
TCL_UNREACHABLE();
}
listc --;
}
@@ -2566,13 +2563,13 @@ MarkDead(
static void
DeleteReflectedChannelMap(
void *clientData, /* The per-interpreter data structure. */
void *clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
/* The map */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedChannel *rcPtr;
Tcl_Channel chan;
#if TCL_THREADS
+7 -7
View File
@@ -695,7 +695,7 @@ TclChanPushObjCmd(
Tcl_SetHashValue(hPtr, rtPtr);
#if TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), NULL);
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */
@@ -1211,7 +1211,7 @@ ReflectInput(
Tcl_SetByteArrayLength(bufObj, 0);
} /* while toRead > 0 */
stop:
stop:
if (gotBytes == 0) {
rtPtr->eofPending = 0;
}
@@ -1219,7 +1219,7 @@ ReflectInput(
Tcl_Release(rtPtr);
return gotBytes;
error:
error:
gotBytes = -1;
goto stop;
}
@@ -2106,8 +2106,8 @@ DeleteReflectedTransformMap(
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedTransformMap *rtmPtr; /* The map */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedTransform *rtPtr;
#if TCL_THREADS
ForwardingResult *resultPtr;
@@ -2268,8 +2268,8 @@ static void
DeleteThreadReflectedTransformMap(
TCL_UNUSED(void *))
{
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Tcl_ThreadId self = Tcl_GetCurrentThread();
ReflectedTransformMap *rtmPtr; /* The map */
ForwardingResult *resultPtr;
-19
View File
@@ -336,25 +336,6 @@ Tcl_OpenTcpServer(
-1, acceptProc, callbackData);
}
#ifdef TCL_SOCK_PRINTF_DEBUGGING
/* printf debugging */
void
printaddrinfo(
struct addrinfo *addrlist,
char *prefix)
{
char host[NI_MAXHOST], port[NI_MAXSERV];
struct addrinfo *ai;
for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
getnameinfo(ai->ai_addr, ai->ai_addrlen,
host, sizeof(host), port, sizeof(port),
NI_NUMERICHOST|NI_NUMERICSERV);
fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
}
}
#endif
/*
* Local Variables:
* mode: c
+24 -24
View File
@@ -208,8 +208,8 @@ TCL_DECLARE_MUTEX(filesystemMutex)
* A files-system indepent sense of the current directory.
*/
static Tcl_Obj *cwdPathPtr = NULL; /* The pathname of the current directory */
static size_t cwdPathEpoch = 0;
static Tcl_Obj *cwdPathPtr = NULL;
static size_t cwdPathEpoch = 0; /* The pathname of the current directory */
static void *cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
@@ -255,7 +255,8 @@ Tcl_Stat(
Tcl_WideInt tmp1, tmp2, tmp3 = 0;
# define OUT_OF_RANGE(x) \
(((Tcl_WideInt)(x)) < LONG_MIN || ((Tcl_WideInt)(x)) > LONG_MAX)
(((Tcl_WideInt)(x)) < LONG_MIN || \
((Tcl_WideInt)(x)) > LONG_MAX)
# define OUT_OF_URANGE(x) \
(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
@@ -1322,8 +1323,8 @@ TclFSNormalizeToUniquePath(
int startAt) /* Offset the string of pathPtr to start at.
* Must either be 0 or offset of a directory
* separator at the end of a pathname part that
* is already normalized, i.e. not the index of
* the byte just after the separator. */
* is already normalized, I.e. not the index of
* the byte just after the separator. */
{
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
@@ -2446,7 +2447,7 @@ int
TclFSFileAttrIndex(
Tcl_Obj *pathPtr, /* Pathname of the file. */
const char *attributeName, /* The name of the attribute. */
Tcl_Size *indexPtr) /* A place to store the result. */
int *indexPtr) /* A place to store the result. */
{
Tcl_Obj *listObj = NULL;
const char *const *attrTable;
@@ -2782,7 +2783,7 @@ Tcl_FSGetCwd(
norm = TclFSNormalizeAbsolutePath(interp, retVal);
if (norm == NULL) {
/*
/*
* 'norm' shouldn't ever be NULL, but we are careful.
*/
@@ -2793,7 +2794,7 @@ Tcl_FSGetCwd(
} else if (norm == tsdPtr->cwdPathPtr) {
goto cdEqual;
} else {
/*
/*
* Determine whether the filesystem's answer is the same as the
* cached local value. Since both 'norm' and 'tsdPtr->cwdPathPtr'
* are normalized pathnames, do something more efficient than
@@ -2899,7 +2900,7 @@ Tcl_FSChdir(
retVal = 0;
} else {
/*
/*
* 'Tcl_SetErrno()' has already been called.
*/
}
@@ -2909,8 +2910,9 @@ Tcl_FSChdir(
}
if (retVal == 0) {
/* Assume that the cwd was actually changed to the normalized value
* just calculated, and cache that information. */
/* Assume that the cwd was actually changed to the normalized value
* just calculated, and cache that information. */
/*
* If the filesystem epoch changed recently, the normalized pathname or
@@ -2927,7 +2929,6 @@ Tcl_FSChdir(
Tcl_SetErrno(ENOENT);
return -1;
}
if (normDirName != pathPtr) { Tcl_IncrRefCount(normDirName); }
if (fsPtr == &tclNativeFilesystem) {
void *cd;
@@ -2979,7 +2980,6 @@ Tcl_FSChdir(
*/
Tcl_FSMountsChanged(NULL);
}
if (normDirName != pathPtr) { Tcl_DecrRefCount(normDirName); }
} else {
/*
* The current directory is now changed or an error occurred and an
@@ -3094,7 +3094,7 @@ Tcl_FSLoadFile(
#endif
static int
SkipUnlink(
skipUnlink(
Tcl_Obj *shlibFile)
{
/*
@@ -3284,9 +3284,9 @@ Tcl_LoadFile(
* load further.
*/
/*
* Try to delete the file we probably created and then exit.
*/
/*
* Try to delete the file we probably created and then exit.
*/
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
@@ -3307,14 +3307,14 @@ Tcl_LoadFile(
/*
* It might be necessary on some systems to set the appropriate permissions
* on the file. On Unix we could loop over the file attributes and set any
* that are called "-permissions" to 0o700, but just do it directly instead:
* that are called "-permissions" to 0700, but just do it directly instead:
*/
{
Tcl_Size index;
int index;
Tcl_Obj *perm;
TclNewLiteralStringObj(perm, "0o700");
TclNewLiteralStringObj(perm, "0700");
Tcl_IncrRefCount(perm);
if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
@@ -3345,7 +3345,7 @@ Tcl_LoadFile(
* and it avoids leaving the copy laying around after exit.
*/
if (!SkipUnlink(copyToPtr) &&
if (!skipUnlink(copyToPtr) &&
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
@@ -3377,7 +3377,7 @@ Tcl_LoadFile(
tvdlPtr->unloadProcPtr = newUnloadProcPtr;
if (copyFsPtr != &tclNativeFilesystem) {
/* refCount of copyToPtr is already incremented. */
/* refCount of copyToPtr is already incremented. */
tvdlPtr->divertedFile = copyToPtr;
/*
@@ -4341,7 +4341,7 @@ Tcl_FSRemoveDirectory(
Tcl_Obj *pathPtr, /* The pathname of the directory to be removed. */
int recursive, /* If zero, removes only an empty directory.
* Otherwise, removes the directory and all its
* contents. */
* contents. */
Tcl_Obj **errorPtr) /* If not NULL and an error occurs, stores a
* place to store a pointer to a new
* object having a refCount of 1 and containing
@@ -4460,7 +4460,7 @@ Tcl_FSGetFileSystemForPath(
/* This is the filesystem for pathPtr. Assume the type of pathPtr
* hasn't been changed by the above call to the
* pathInFilesystemProc, and cache this result in the internal
* representation of pathPtr. */
* representation of pathPtr. */
TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
Disclaim();
+116 -85
View File
@@ -45,9 +45,9 @@ typedef enum {
} UConverterCallbackReasonx;
typedef enum UNormalizationCheckResultx {
UNORM_NO,
UNORM_YES,
UNORM_MAYBE
UNORM_NO,
UNORM_YES,
UNORM_MAYBE
} UNormalizationCheckResultx;
typedef struct UEnumeration UEnumeration;
@@ -59,31 +59,50 @@ typedef struct UConverter UConverter;
typedef struct UConverterFromUnicodeArgs UConverterFromUnicodeArgs;
typedef struct UConverterToUnicodeArgs UConverterToUnicodeArgs;
typedef void (*UConverterFromUCallback)(const void *context,
UConverterFromUnicodeArgs *args, const UCharx *codeUnits,
int32_t length, UChar32x codePoint, UConverterCallbackReasonx reason,
UErrorCodex *pErrorCode);
UConverterFromUnicodeArgs *args,
const UCharx *codeUnits,
int32_t length, UChar32x codePoint,
UConverterCallbackReasonx reason,
UErrorCodex *pErrorCode);
typedef void (*UConverterToUCallback)(const void *context,
UConverterToUnicodeArgs *args, const char *codeUnits,
int32_t length, UConverterCallbackReasonx reason,
UErrorCodex *pErrorCode);
UConverterToUnicodeArgs *args,
const char *codeUnits,
int32_t length,
UConverterCallbackReasonx reason,
UErrorCodex *pErrorCode);
/*
* Prototypes for ICU functions sorted by category.
*/
typedef void (*fn_u_cleanup)(void);
typedef const char *(*fn_u_errorName)(UErrorCodex);
typedef UCharx *(*fn_u_strFromUTF32)(UCharx *dest, int32_t destCapacity,
int32_t *pDestLength, const UChar32x *src, int32_t srcLength,
UErrorCodex *pErrorCode);
typedef UCharx *(*fn_u_strFromUTF32WithSub)(UCharx *dest, int32_t destCapacity,
int32_t *pDestLength, const UChar32x *src, int32_t srcLength,
UChar32x subchar, int32_t *pNumSubstitutions, UErrorCodex *pErrorCode);
typedef UChar32x *(*fn_u_strToUTF32)(UChar32x *dest, int32_t destCapacity,
int32_t *pDestLength, const UCharx *src, int32_t srcLength,
UErrorCodex *pErrorCode);
typedef UCharx *(*fn_u_strFromUTF32)(UCharx *dest,
int32_t destCapacity,
int32_t *pDestLength,
const UChar32x *src,
int32_t srcLength,
UErrorCodex *pErrorCode);
typedef UCharx *(*fn_u_strFromUTF32WithSub)(UCharx *dest,
int32_t destCapacity,
int32_t *pDestLength,
const UChar32x *src,
int32_t srcLength,
UChar32x subchar,
int32_t *pNumSubstitutions,
UErrorCodex *pErrorCode);
typedef UChar32x *(*fn_u_strToUTF32)(UChar32x *dest,
int32_t destCapacity,
int32_t *pDestLength,
const UCharx *src,
int32_t srcLength,
UErrorCodex *pErrorCode);
typedef UChar32x *(*fn_u_strToUTF32WithSub)(UChar32x *dest,
int32_t destCapacity, int32_t *pDestLength, const UCharx *src,
int32_t srcLength, UChar32x subchar, int32_t *pNumSubstitutions,
UErrorCodex *pErrorCode);
int32_t destCapacity,
int32_t *pDestLength,
const UCharx *src,
int32_t srcLength,
UChar32x subchar,
int32_t *pNumSubstitutions,
UErrorCodex *pErrorCode);
typedef void (*fn_ucnv_close)(UConverter *);
typedef uint16_t (*fn_ucnv_countAliases)(const char *, UErrorCodex *);
@@ -94,15 +113,19 @@ typedef const char *(*fn_ucnv_getAlias)(const char *, uint16_t, UErrorCodex *);
typedef const char *(*fn_ucnv_getAvailableName)(int32_t);
typedef UConverter *(*fn_ucnv_open)(const char *converterName, UErrorCodex *);
typedef void (*fn_ucnv_setFromUCallBack)(UConverter *,
UConverterFromUCallback newAction, const void *newContext,
UConverterFromUCallback *oldAction, const void **oldContext,
UErrorCodex *err);
UConverterFromUCallback newAction,
const void *newContext,
UConverterFromUCallback *oldAction,
const void **oldContext,
UErrorCodex *err);
typedef void (*fn_ucnv_setToUCallBack)(UConverter *,
UConverterToUCallback newAction, const void *newContext,
UConverterToUCallback *oldAction, const void **oldContext,
UErrorCodex *err);
UConverterToUCallback newAction,
const void *newContext,
UConverterToUCallback *oldAction,
const void **oldContext,
UErrorCodex *err);
typedef int32_t (*fn_ucnv_toUChars)(UConverter *, UCharx *dest,
int32_t destCapacity, const char *src, int32_t srcLen, UErrorCodex *);
int32_t destCapacity, const char *src, int32_t srcLen, UErrorCodex *);
typedef UConverterFromUCallback fn_UCNV_FROM_U_CALLBACK_STOP;
typedef UConverterToUCallback fn_UCNV_TO_U_CALLBACK_STOP;
@@ -138,8 +161,12 @@ typedef UNormalizer2 *(*fn_unorm2_getNFCInstance)(UErrorCodex *);
typedef UNormalizer2 *(*fn_unorm2_getNFDInstance)(UErrorCodex *);
typedef UNormalizer2 *(*fn_unorm2_getNFKCInstance)(UErrorCodex *);
typedef UNormalizer2 *(*fn_unorm2_getNFKDInstance)(UErrorCodex *);
typedef int32_t (*fn_unorm2_normalize)(const UNormalizer2 *, const UCharx *,
int32_t, UCharx *, int32_t, UErrorCodex *);
typedef int32_t (*fn_unorm2_normalize)(const UNormalizer2 *,
const UCharx *,
int32_t,
UCharx *,
int32_t,
UErrorCodex *);
#define FIELD(name) fn_ ## name _ ## name
@@ -327,8 +354,8 @@ DetectEncoding(
return TCL_ERROR;
}
if (len > INT_MAX) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Max length supported by ICU exceeded.", TCL_INDEX_NONE));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Max length supported by ICU exceeded.", TCL_INDEX_NONE));
return TCL_ERROR;
}
UErrorCodex status = U_ZERO_ERRORZ;
@@ -472,9 +499,14 @@ IcuObjToUCharDString(
char *s;
Tcl_Size len;
s = Tcl_GetStringFromObj(objPtr, &len);
result = Tcl_UtfToExternalDStringEx(interp, encoding, s, len,
strict ? TCL_ENCODING_PROFILE_STRICT : TCL_ENCODING_PROFILE_REPLACE,
dsPtr, NULL);
result = Tcl_UtfToExternalDStringEx(interp,
encoding,
s,
len,
strict ? TCL_ENCODING_PROFILE_STRICT
: TCL_ENCODING_PROFILE_REPLACE,
dsPtr,
NULL);
if (result != TCL_OK) {
Tcl_DStringFree(dsPtr); /* Must be done on error */
/* TCL_CONVER_* errors -> TCL_ERROR */
@@ -522,9 +554,14 @@ IcuObjFromUCharDString(
Tcl_Size len = Tcl_DStringLength(dsPtr);
Tcl_DString dsOut;
int result;
result = Tcl_ExternalToUtfDStringEx(interp, encoding, s, len,
strict ? TCL_ENCODING_PROFILE_STRICT : TCL_ENCODING_PROFILE_REPLACE,
&dsOut, NULL);
result = Tcl_ExternalToUtfDStringEx(interp,
encoding,
s,
len,
strict ? TCL_ENCODING_PROFILE_STRICT
: TCL_ENCODING_PROFILE_REPLACE,
&dsOut,
NULL);
if (result == TCL_OK) {
objPtr = Tcl_DStringToObj(&dsOut); /* Clears dsPtr! */
@@ -739,8 +776,8 @@ IcuConverttoDString(
Tcl_Size utf16len = Tcl_DStringLength(dsInPtr) / sizeof(UCharx);
Tcl_Size dstLen, dstCapacity;
if (utf16len > INT_MAX) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Max length supported by ICU exceeded.", TCL_INDEX_NONE));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Max length supported by ICU exceeded.", TCL_INDEX_NONE));
return TCL_ERROR;
}
@@ -748,7 +785,7 @@ IcuConverttoDString(
Tcl_DStringInit(dsOutPtr);
Tcl_DStringSetLength(dsOutPtr, dstCapacity);
dstLen = ucnv_fromUChars(ucnvPtr, Tcl_DStringValue(dsOutPtr), (int)dstCapacity,
utf16, (int)utf16len, &status);
utf16, (int)utf16len, &status);
if (U_FAILURE(status)) {
switch (status) {
case U_STRING_NOT_TERMINATED_WARNING:
@@ -757,11 +794,11 @@ IcuConverttoDString(
Tcl_DStringSetLength(dsOutPtr, (int)dstLen);
status = U_ZERO_ERRORZ; /* Reset before call */
dstLen = ucnv_fromUChars(ucnvPtr, Tcl_DStringValue(dsOutPtr), (int)dstLen,
utf16, (int)utf16len, &status);
utf16, (int)utf16len, &status);
if (U_SUCCESS(status)) {
break;
}
TCL_FALLTHROUGH();
/* FALLTHRU */
default:
Tcl_DStringFree(dsOutPtr);
ucnv_close(ucnvPtr);
@@ -803,8 +840,8 @@ IcuBytesToUCharDString(
}
if (nbytes > INT_MAX) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Max length supported by ICU exceeded.", TCL_INDEX_NONE));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Max length supported by ICU exceeded.", TCL_INDEX_NONE));
return TCL_ERROR;
}
@@ -827,7 +864,7 @@ IcuBytesToUCharDString(
Tcl_DStringInit(dsOutPtr);
Tcl_DStringSetLength(dsOutPtr, dstCapacity);
dstLen = ucnv_toUChars(ucnvPtr, (UCharx *)Tcl_DStringValue(dsOutPtr), dstCapacity,
(const char *)bytes, (int)nbytes, &status);
(const char *)bytes, (int)nbytes, &status);
if (U_FAILURE(status)) {
switch (status) {
case U_STRING_NOT_TERMINATED_WARNING:
@@ -837,11 +874,11 @@ IcuBytesToUCharDString(
Tcl_DStringSetLength(dsOutPtr, dstCapacity);
status = U_ZERO_ERRORZ; /* Reset before call */
dstLen = ucnv_toUChars(ucnvPtr, (UCharx *)Tcl_DStringValue(dsOutPtr), dstCapacity,
(const char *)bytes, (int)nbytes, &status);
(const char *)bytes, (int)nbytes, &status);
if (U_SUCCESS(status)) {
break;
}
TCL_FALLTHROUGH();
/* FALLTHRU */
default:
Tcl_DStringFree(dsOutPtr);
ucnv_close(ucnvPtr);
@@ -912,8 +949,8 @@ IcuNormalizeUCharDString(
utf16 = (UCharx *) Tcl_DStringValue(dsInPtr);
utf16len = Tcl_DStringLength(dsInPtr) / sizeof(UCharx);
if (utf16len > INT_MAX) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Max length supported by ICU exceeded.", TCL_INDEX_NONE));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Max length supported by ICU exceeded.", TCL_INDEX_NONE));
return TCL_ERROR;
}
Tcl_DStringInit(dsOutPtr);
@@ -937,7 +974,7 @@ IcuNormalizeUCharDString(
if (U_SUCCESS(status)) {
break;
}
TCL_FALLTHROUGH();
/* FALLTHRU */
default:
Tcl_DStringFree(dsOutPtr);
return IcuError(interp, "String normalization failed", status);
@@ -977,9 +1014,9 @@ static int IcuParseConvertOptions(
}
++i;
if (i == objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Missing value for option %s.",
Tcl_GetString(objv[i - 1])));
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Missing value for option %s.",
Tcl_GetString(objv[i - 1])));
return TCL_ERROR;
}
const char *s = Tcl_GetString(objv[i]);
@@ -988,20 +1025,18 @@ static int IcuParseConvertOptions(
if (!strcmp(s, "replace")) {
strict = 0;
} else if (strcmp(s, "strict")) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Invalid value \"%s\" supplied for option"
" \"-profile\". Must be \"strict\" or \"replace\".",
s));
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Invalid value \"%s\" supplied for option"
" \"-profile\". Must be \"strict\" or \"replace\".",
s));
return TCL_ERROR;
}
break;
case OPT_FAILINDEX:
/* TBD */
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Option -failindex not implemented.", TCL_INDEX_NONE));
Tcl_SetObjResult(interp,
Tcl_NewStringObj("Option -failindex not implemented.", TCL_INDEX_NONE));
return TCL_ERROR;
default:
TCL_UNREACHABLE();
}
}
*strictPtr = strict;
@@ -1147,9 +1182,9 @@ IcuNormalizeObjCmd(
}
++i;
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Missing value for option %s.",
Tcl_GetString(objv[i - 1])));
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Missing value for option %s.",
Tcl_GetString(objv[i - 1])));
return TCL_ERROR;
}
const char *s = Tcl_GetString(objv[i]);
@@ -1158,21 +1193,18 @@ IcuNormalizeObjCmd(
if (!strcmp(s, "replace")) {
strict = 0;
} else if (strcmp(s, "strict")) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Invalid value \"%s\" supplied for option \"-profile\". "
"Must be \"strict\" or \"replace\".",
s));
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Invalid value \"%s\" supplied for option \"-profile\". Must be "
"\"strict\" or \"replace\".",
s));
return TCL_ERROR;
}
break;
case OPT_MODE:
if (Tcl_GetIndexFromObj(interp, objv[i], normalizationForms,
"normalization mode", 0, &mode) != TCL_OK) {
if (Tcl_GetIndexFromObj(interp, objv[i], normalizationForms, "normalization mode", 0, &mode) != TCL_OK) {
return TCL_ERROR;
}
break;
default:
TCL_UNREACHABLE();
}
}
@@ -1327,8 +1359,7 @@ TclIcuInit(
/* Going back down to ICU version 60 */
while ((icu_fns.libs[0] == NULL) && (icuversion[1] >= '6')) {
if (--icuversion[2] < '0') {
icuversion[1]--;
icuversion[2] = '9';
icuversion[1]--; icuversion[2] = '9';
}
#if defined(__CYGWIN__)
i = 2;
@@ -1407,10 +1438,10 @@ TclIcuInit(
/* Symbol may have version (Linux), or not (Windows, FreeBSD) */
#define ICUUC_SYM(name) \
do { \
icu_fns._##name = (fn_##name) \
IcuFindSymbol(icu_fns.libs[0], #name, icuversion); \
#define ICUUC_SYM(name) \
do { \
icu_fns._##name = \
(fn_##name)IcuFindSymbol(icu_fns.libs[0], #name, icuversion); \
} while (0)
if (icu_fns.libs[0] != NULL) {
@@ -1454,10 +1485,10 @@ TclIcuInit(
#undef ICUUC_SYM
}
#define ICUIN_SYM(name) \
do { \
icu_fns._##name = (fn_##name) \
IcuFindSymbol(icu_fns.libs[1], #name, icuversion); \
#define ICUIN_SYM(name) \
do { \
icu_fns._##name = \
(fn_##name)IcuFindSymbol(icu_fns.libs[1], #name, icuversion); \
} while (0)
if (icu_fns.libs[1] != NULL) {
@@ -1483,9 +1514,9 @@ TclIcuInit(
/* Ref count number of commands */
icu_fns.nopen += 3;
Tcl_CreateObjCommand(interp, "::tcl::unsupported::icu::convertto",
IcuConverttoObjCmd, 0, TclIcuCleanup);
IcuConverttoObjCmd, 0, TclIcuCleanup);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::icu::convertfrom",
IcuConvertfromObjCmd, 0, TclIcuCleanup);
IcuConvertfromObjCmd, 0, TclIcuCleanup);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::icu::detect",
IcuDetectObjCmd, 0, TclIcuCleanup);
}
+16 -20
View File
@@ -55,7 +55,7 @@ const Tcl_ObjType tclIndexType = {
typedef struct {
void *tablePtr; /* Pointer to the table of strings */
Tcl_Size offset; /* Offset between table entries */
Tcl_Size offset; /* Offset between table entries */
Tcl_Size index; /* Selected index into table. */
} IndexRep;
@@ -68,9 +68,7 @@ typedef struct {
#define NEXT_ENTRY(table, offset) \
(&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
(((indexRep)->index != TCL_INDEX_NONE) ? \
STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : \
"")
(((indexRep)->index != TCL_INDEX_NONE) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "")
/*
*----------------------------------------------------------------------
@@ -305,20 +303,20 @@ Tcl_GetIndexFromObjStruct(
flags &= (30-(int)(sizeof(int)<<1));
if (flags) {
if (flags == sizeof(uint16_t)<<1) {
*(uint16_t *)indexPtr = (uint16_t)index;
*(uint16_t *)indexPtr = index;
return TCL_OK;
} else if (flags == (int)(sizeof(uint8_t)<<1)) {
*(uint8_t *)indexPtr = (uint8_t)index;
*(uint8_t *)indexPtr = index;
return TCL_OK;
} else if (flags == (int)(sizeof(int64_t)<<1)) {
*(int64_t *)indexPtr = index;
return TCL_OK;
} else if (flags == (int)(sizeof(int32_t)<<1)) {
*(int32_t *)indexPtr = (int32_t)index;
*(int32_t *)indexPtr = index;
return TCL_OK;
}
}
*(int *)indexPtr = (int)index;
*(int *)indexPtr = index;
}
return TCL_OK;
@@ -365,8 +363,7 @@ Tcl_GetIndexFromObjStruct(
}
/* #define again, needed below */
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), \
(msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
/*
*----------------------------------------------------------------------
@@ -389,8 +386,7 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
IndexRep *indexRep = (IndexRep *)
TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1;
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1;
const char *indexStr = EXPAND_OF(indexRep);
size_t len = strlen(indexStr);
@@ -811,7 +807,7 @@ PrefixLongestObjCmd(
void
Tcl_WrongNumArgs(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments to print from objv. */
Tcl_Size objc, /* Number of arguments to print from objv. */
Tcl_Obj *const objv[], /* Initial argument objects, which should be
* included in the error message. */
const char *message) /* Error message to print after the leading
@@ -1014,13 +1010,13 @@ Tcl_ParseArgsObjv(
/* Descriptor that matches current argument */
Tcl_Obj *curArg; /* Current argument */
const char *str = NULL;
char c; /* Second character of current arg (used for
char c; /* Second character of current arg (used for
* quick check for matching; use 2nd char.
* because first char. will almost always be
* '-'). */
Tcl_Size srcIndex; /* Location from which to read next argument
Tcl_Size srcIndex; /* Location from which to read next argument
* from objv. */
Tcl_Size dstIndex; /* Used to keep track of current arguments
Tcl_Size dstIndex; /* Used to keep track of current arguments
* being processed, primarily for error
* reporting. */
Tcl_Size objc; /* # arguments in objv still to process. */
@@ -1112,7 +1108,7 @@ Tcl_ParseArgsObjv(
infoPtr = matchPtr;
switch (infoPtr->type) {
case TCL_ARGV_CONSTANT:
*((int *)infoPtr->dstPtr) = (int)PTR2INT(infoPtr->srcPtr);
*((int *) infoPtr->dstPtr) = PTR2INT(infoPtr->srcPtr);
break;
case TCL_ARGV_INT:
if (objc == 0) {
@@ -1144,7 +1140,7 @@ Tcl_ParseArgsObjv(
*/
if (infoPtr->dstPtr != NULL) {
*((int *)infoPtr->dstPtr) = (int)dstIndex;
*((int *) infoPtr->dstPtr) = dstIndex;
}
goto argsDone;
case TCL_ARGV_FLOAT:
@@ -1152,7 +1148,7 @@ Tcl_ParseArgsObjv(
goto missingArg;
}
if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
(double *)infoPtr->dstPtr) == TCL_ERROR) {
(double *) infoPtr->dstPtr) == TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected floating-point argument for \"%s\" but got \"%s\"",
infoPtr->keyStr, TclGetString(objv[srcIndex])));
@@ -1273,7 +1269,7 @@ PrintUsage(
* descriptions. */
{
const Tcl_ArgvInfo *infoPtr;
Tcl_Size width, numSpaces;
int width, numSpaces;
#define NUM_SPACES 20
static const char spaces[] = " ";
Tcl_Obj *msg;
+14 -9
View File
@@ -158,12 +158,17 @@ declare 61 {
declare 62 {
int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
# Removed in 9.0:
#declare 63 {
# int TclObjInterpProc(void *clientData, Tcl_Interp *interp,
# Tcl_Size objc, Tcl_Obj *const objv[])
#}
declare 64 {
int TclObjInvoke(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[],
int flags)
}
declare 69 {
void *TclpAlloc(size_t size)
void *TclpAlloc(TCL_HASH_TYPE size)
}
declare 74 {
void TclpFree(void *ptr)
@@ -179,7 +184,7 @@ declare 76 {
# void TclpGetTime(Tcl_Time *time)
#}
declare 81 {
void *TclpRealloc(void *ptr, size_t size)
void *TclpRealloc(void *ptr, TCL_HASH_TYPE size)
}
# Removed in 9.0:
#declare 88 {
@@ -460,7 +465,7 @@ declare 214 {
void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
void *TclStackAlloc(Tcl_Interp *interp, size_t numBytes)
void *TclStackAlloc(Tcl_Interp *interp, TCL_HASH_TYPE numBytes)
}
declare 216 {
void TclStackFree(Tcl_Interp *interp, void *freePtr)
@@ -555,7 +560,7 @@ declare 239 {
}
declare 240 {
int TclNRRunCallbacks(Tcl_Interp *interp, int result,
struct NRE_callback *rootPtr)
struct NRE_callback *rootPtr)
}
declare 241 {
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
@@ -563,7 +568,7 @@ declare 241 {
}
declare 242 {
int TclNREvalObjv(Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[], int flags, Command *cmdPtr)
Tcl_Obj *const objv[], int flags, Command *cmdPtr)
}
# Tcl_Obj leak detection support.
@@ -593,7 +598,7 @@ declare 248 {
declare 249 {
char *TclDoubleDigits(double dv, int ndigits, int flags,
int *decpt, int *signum, char **endPtr)
int *decpt, int *signum, char **endPtr)
}
# TIP #285: Script cancellation support.
declare 250 {
@@ -635,9 +640,6 @@ declare 257 {
void TclStaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
declare 258 {
int TclMSB(unsigned long long n)
}
declare 261 {
void TclUnusedStubEntry(void)
@@ -681,6 +683,9 @@ declare 8 {
declare 9 {
TclFile TclpCreateTempFile(const char *contents)
}
declare 10 {
Tcl_Encoding TclWinGetUserEncoding(Tcl_Interp *interp)
}
declare 11 {
void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
+124 -171
View File
@@ -141,32 +141,6 @@
# define Tcl_ConditionFinalize(condPtr)
#endif
// A way to mark a code path as unreachable.
#ifndef TCL_UNREACHABLE
#if defined(__STDC__) && __STDC__ >= 202311L
#include <stddef.h>
#define TCL_UNREACHABLE() unreachable()
#elif defined(__GNUC__)
#define TCL_UNREACHABLE() __builtin_unreachable()
#elif defined(_MSC_VER)
#include <stdbool.h>
#define TCL_UNREACHABLE() __assume(false)
#else
#define TCL_UNREACHABLE() ((void) 0)
#endif
#endif // TCL_UNREACHABLE
#ifndef TCL_FALLTHROUGH
#if defined(__STDC__) && __STDC__ >= 202311L
#define TCL_FALLTHROUGH() [[fallthrough]]
#elif defined(__GNUC__)
#define TCL_FALLTHROUGH() __attribute__((fallthrough))
#else
// Nothing documented as an alternative to the standard [[fallthrough]].
#define TCL_FALLTHROUGH() ((void) 0)
#endif
#endif // TCL_FALLTHROUGH
/*
* The following procedures allow namespaces to be customized to support
* special name resolution rules for commands/variables.
@@ -244,8 +218,10 @@ typedef struct NamespacePathEntry NamespacePathEntry;
typedef struct TclVarHashTable {
Tcl_HashTable table; /* "Inherit" from Tcl_HashTable. */
struct Namespace *nsPtr; /* The namespace containing the variables. */
#if TCL_MAJOR_VERSION > 8
struct Var *arrayPtr; /* The array containing the variables, if they
* are variables in an array at all. */
#endif /* TCL_MAJOR_VERSION > 8 */
} TclVarHashTable;
/*
@@ -288,7 +264,11 @@ typedef struct Namespace {
* strings; values have type (Namespace *). If
* NULL, there are no children. */
#endif
#if TCL_MAJOR_VERSION > 8
size_t nsId; /* Unique id for the namespace. */
#else
unsigned long nsId;
#endif
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
int flags; /* OR-ed combination of the namespace status
@@ -744,8 +724,6 @@ typedef struct VarInHash {
#define VAR_ARRAY 0x1
#define VAR_LINK 0x2
#define VAR_CONSTANT 0x10000
#define VAR_TYPE \
(VAR_ARRAY | VAR_LINK | VAR_CONSTANT)
/* Type of storage (0 is compiled local) */
#define VAR_IN_HASHTABLE 0x4
@@ -773,8 +751,6 @@ typedef struct VarInHash {
#define VAR_IS_ARGS 0x400
#define VAR_RESOLVED 0x8000
#define TCL_HASH_FIND ((int *)-1)
/*
* Macros to ensure that various flag bits are set properly for variables.
* The ANSI C "prototypes" for these macros are:
@@ -917,7 +893,7 @@ typedef struct VarInHash {
#define TclIsVarTricky(varPtr,trickyFlags) \
( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \
|| (TclIsVarInHash(varPtr) \
|| (TclIsVarInHash(varPtr) \
&& (TclVarParentArray(varPtr) != NULL) \
&& (TclVarParentArray(varPtr)->flags & (trickyFlags))))
@@ -991,6 +967,9 @@ typedef struct CompiledLocal {
* Among others used to speed up var lookups. */
Tcl_Size frameIndex; /* Index in the array of compiler-assigned
* variables in the procedure call frame. */
#if TCL_MAJOR_VERSION < 9
int flags;
#endif
Tcl_Obj *defValuePtr; /* Pointer to the default value of an
* argument, if any. NULL if not an argument
* or, if an argument, no default value. */
@@ -1001,10 +980,12 @@ typedef struct CompiledLocal {
* is marked by a unique tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
#if TCL_MAJOR_VERSION > 8
int flags; /* Flag bits for the local variable. Same as
* the flags for the Var structure above,
* although only VAR_ARGUMENT, VAR_TEMPORARY,
* and VAR_RESOLVED make sense. */
#endif
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
* the name is NULL, this will just be '\0'.
* The actual size of this field will be large
@@ -1062,7 +1043,11 @@ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
typedef struct Trace {
Tcl_Size level; /* Only trace commands at nesting level less
* than or equal to this. */
#if TCL_MAJOR_VERSION > 8
Tcl_CmdObjTraceProc2 *proc; /* Procedure to call to trace command. */
#else
Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
#endif
void *clientData; /* Arbitrary value to pass to proc. */
struct Trace *nextPtr; /* Next in list of traces for this interp. */
int flags; /* Flags governing the trace - see
@@ -1106,6 +1091,7 @@ typedef struct ActiveInterpTrace {
#define TCL_TRACE_ENTER_EXEC 1
#define TCL_TRACE_LEAVE_EXEC 2
#if TCL_MAJOR_VERSION > 8
#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \
&& ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \
|| (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \
@@ -1207,6 +1193,7 @@ TclObjTypeInOperator(
Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
return proc(interp, valueObj, listObj, boolResult);
}
#endif /* TCL_MAJOR_VERSION > 8 */
/*
* The structure below defines an entry in the assocData hash table which is
@@ -1350,7 +1337,7 @@ typedef struct CmdFrame {
int type; /* Values see below. */
int level; /* Number of frames in stack, prevent O(n)
* scan of list. */
int *line; /* Lines the words of the command start on. */
Tcl_Size *line; /* Lines the words of the command start on. */
Tcl_Size nline; /* Number of lines in CmdFrame.line. */
CallFrame *framePtr; /* Procedure activation record, may be
* NULL. */
@@ -1445,7 +1432,7 @@ typedef struct CFWordBC {
typedef struct ContLineLoc {
Tcl_Size num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
Tcl_Size loc[TCLFLEXARRAY]; /* Table of locations, as character offsets.
Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
* The table is allocated as part of the
* structure, extending behind the nominal end
* of the structure. An entry containing the
@@ -1661,10 +1648,6 @@ typedef struct ExecEnv {
#define COR_IS_SUSPENDED(corPtr) \
((corPtr)->stackLevel == NULL)
// The different types of yielded coroutine we have.
#define CORO_ACTIVATE_YIELD NULL // 0 or 1 argument expected
#define CORO_ACTIVATE_YIELDM INT2PTR(1) // Arbitrary arguments expected
/*
* The definitions for the LiteralTable and LiteralEntry structures. Each
* interpreter contains a LiteralTable. It is used to reduce the storage
@@ -1705,13 +1688,13 @@ typedef struct LiteralTable {
LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
/* Bucket array used for small tables to avoid
* mallocs and frees. */
size_t numBuckets; /* Total number of buckets allocated at
TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at
* **buckets. */
size_t numEntries; /* Total number of entries present in
TCL_HASH_TYPE numEntries; /* Total number of entries present in
* table. */
size_t rebuildSize; /* Enlarge table when numEntries gets to be
TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
size_t mask; /* Mask value used in hashing function. */
TCL_HASH_TYPE mask; /* Mask value used in hashing function. */
} LiteralTable;
/*
@@ -1864,39 +1847,35 @@ typedef struct Command {
/*
* Flag bits for commands.
*
* CMD_DYING - If 1 the command is in the process of
* being deleted (its deleteProc is currently
* executing). Other attempts to delete the
* command should be ignored.
* CMD_TRACE_ACTIVE - If 1 the trace processing is currently
* underway for a rename/delete change. See the
* two flags below for which is currently being
* processed.
* CMD_HAS_EXEC_TRACES - If 1 means that this command has at least one
* execution trace (as opposed to simple
* delete/rename traces) in its tracePtr list.
* CMD_COMPILES_EXPANDED - If 1 this command has a compiler that
* can handle expansion (provided it is not the
* first word).
* TCL_TRACE_RENAME - A rename trace is in progress. Further
* recursive renames will not be traced.
* TCL_TRACE_DELETE - A delete trace is in progress. Further
* recursive deletes will not be traced.
* (these last two flags are defined in tcl.h)
*/
enum CommandFlags {
CMD_DYING = 0x01, /* The command is in the process of being
* deleted (its deleteProc is currently
* executing). Other attempts to delete the
* command should be ignored.*/
CMD_TRACE_ACTIVE = 0x02, /* The trace processing is currently underway
* for a rename/delete change. See the flags
* CMD_TRACE_RENAMING, CMD_TRACE_DELETING for
* which is currently being processed. */
CMD_HAS_EXEC_TRACES = 0x04, /* This command has at least one execution
* trace (as opposed to simple delete/rename
* traces) in its tracePtr list. */
CMD_COMPILES_EXPANDED = 0x08,
/* This command has a compiler that can handle
* expansion (provided it is not the first
* word). */
CMD_REDEF_IN_PROGRESS = 0x10,
/* Command is currently being redefined. It
* should not be deleted, though its ClientData
* may be purged. */
CMD_VIA_RESOLVER = 0x20, /* Command was located by resolver. Its literal
* should be marked unshared by the compiler. */
CMD_DEAD = 0x40, /* Command is at an advanced stage of being
* deleted, and is no longer in any hash tables
* but stale references may exist elsewhere. */
CMD_TRACE_RENAMING = TCL_TRACE_RENAME,
/* A rename trace is in progress. Further
* recursive renames will not be traced. */
CMD_TRACE_DELETING = TCL_TRACE_DELETE
/* A delete trace is in progress. Further
* recursive deletes will not be traced. */
};
#define CMD_DYING 0x01
#define CMD_TRACE_ACTIVE 0x02
#define CMD_HAS_EXEC_TRACES 0x04
#define CMD_COMPILES_EXPANDED 0x08
#define CMD_REDEF_IN_PROGRESS 0x10
#define CMD_VIA_RESOLVER 0x20
#define CMD_DEAD 0x40
/*
*----------------------------------------------------------------
@@ -2009,9 +1988,20 @@ typedef struct Interp {
void *interpInfo; /* Information used by tclInterp.c to keep
* track of parent/child interps on a
* per-interp basis. */
#if TCL_MAJOR_VERSION > 8
void (*optimizer)(void *envPtr);
/* Reference to the bytecode optimizer, if one
* is set. */
#else
union {
void (*optimizer)(void *envPtr);
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
* unused space in interp was repurposed for
* pluggable bytecode optimizers. The core
* contains one optimizer, which can be
* selectively overridden by extensions. */
} extra;
#endif
/*
* Information related to procedures and variables. See tclProc.c and
* tclVar.c for usage.
@@ -2040,6 +2030,11 @@ typedef struct Interp {
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
#if TCL_MAJOR_VERSION < 9
char *appendResultDontUse;
int appendAvlDontUse;
int appendUsedDontUse;
#endif
/*
* Information about packages. Used only in tclPkg.c.
@@ -2063,6 +2058,9 @@ typedef struct Interp {
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
#if TCL_MAJOR_VERSION < 9
int unused1; /* No longer used (was termOffset) */
#endif
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
* objects holding literals of scripts
* compiled by the interpreter. Indexed by the
@@ -2099,6 +2097,9 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
#if TCL_MAJOR_VERSION < 9
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
@@ -2206,7 +2207,7 @@ typedef struct Interp {
* invoking context of the bytecode compiler.
* NULL when the byte code compiler is not
* active. */
Tcl_Size invokeWord; /* Index of the word in the command which
int invokeWord; /* Index of the word in the command which
* is getting compiled. */
Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
* defined procedure the location information
@@ -2466,7 +2467,7 @@ typedef struct Interp {
#if defined(__APPLE__)
#define TCL_ALLOCALIGN 16
#else
#define TCL_ALLOCALIGN (2*(int)sizeof(void *))
#define TCL_ALLOCALIGN (2*sizeof(void *))
#endif
/*
@@ -2583,11 +2584,10 @@ typedef struct ListStore {
Tcl_Obj *slots[TCLFLEXARRAY];
/* Variable size array. Grown as needed */
} ListStore;
enum ListStoreFlags {
LISTSTORE_CANONICAL = 1 /* All Tcl_Obj's referencing this
#define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this
* store have their string representation
* derived from the list representation */
};
/* Max number of elements that can be contained in a list */
#define LIST_MAX \
@@ -2763,11 +2763,20 @@ typedef struct ListRep {
* WARNING: these macros eval their args more than once.
*/
#if TCL_MAJOR_VERSION > 8
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
((TclHasInternalRep((objPtr), &tclIntType) \
|| TclHasInternalRep((objPtr), &tclBooleanType)) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#else
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
((TclHasInternalRep((objPtr), &tclIntType)) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: (TclHasInternalRep((objPtr), &tclBooleanType)) \
? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#endif
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
@@ -2905,7 +2914,7 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
*/
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr,
size_t *lengthPtr,
TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr);
#ifdef _WIN32
@@ -2927,7 +2936,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr,
typedef struct ProcessGlobalValue {
Tcl_Size epoch; /* Epoch counter to detect changes in the
* global value. */
size_t numBytes; /* Length of the global string. */
TCL_HASH_TYPE numBytes; /* Length of the global string. */
char *value; /* The global string value. */
Tcl_Encoding encoding; /* system encoding when global string was
* initialized. */
@@ -3191,7 +3200,6 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclUplevelCallback;
MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback;
@@ -3203,7 +3211,6 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE Tcl_NRPostProc TclNRPostInvoke;
MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp,
@@ -3263,31 +3270,17 @@ struct Tcl_LoadHandle_ {
#define TCL_DD_CONVERSION_TYPE_MASK 0x3
/* Mask to isolate the conversion type */
/*
* Clock operations, communicated from command definitions to the bytecode
* compiler.
*/
enum ClockOps {
CLOCK_READ_CLICKS = 0, /* Read the click counter. */
CLOCK_READ_MICROS = 1, /* Time in microseconds. */
CLOCK_READ_MILLIS = 2, /* Time in milliseconds. */
CLOCK_READ_SECS = 3 /* Time in seconds. */
};
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside world:
*----------------------------------------------------------------
*/
MODULE_SCOPE void TclAdvanceContinuations(int *line, Tcl_Size **next,
Tcl_Size loc);
MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, Tcl_Size **next,
int loc);
MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start,
const char *end);
MODULE_SCOPE int TclAliasCreate(Tcl_Interp *interp,
Tcl_Interp *childInterp, Tcl_Interp *parentInterp,
Tcl_Obj *namePtr, Tcl_Obj *targetPtr, Tcl_Size objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
const unsigned char *bytes, Tcl_Size len);
MODULE_SCOPE void TclAppendUtfToUtf(Tcl_Obj *objPtr,
@@ -3316,7 +3309,7 @@ MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int TclChannelGetBlockingMode(Tcl_Channel chan);
MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *name, Tcl_Size index);
Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -3334,13 +3327,6 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
MODULE_SCOPE Tcl_Size TclConvertElement(const char *src, Tcl_Size length,
char *dst, int flags);
MODULE_SCOPE int TclCopyNamespaceProcedures(Tcl_Interp *interp,
Namespace *srcNsPtr, Namespace *tgtNsPtr);
MODULE_SCOPE int TclCopyNamespaceVariables(Tcl_Interp *interp,
Namespace *originNs, Namespace *targetNs);
MODULE_SCOPE int TclCreateConstantInNS(Tcl_Interp *interp,
Namespace *nsPtr, Tcl_Obj *nameObj,
Tcl_Obj *valueObj);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
const char *cmdName, Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc, void *clientData,
@@ -3366,7 +3352,7 @@ MODULE_SCOPE int TclDictRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
const char *key);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
Tcl_Size numBytes, int flags, int line,
Tcl_Size numBytes, int flags, Tcl_Size line,
Tcl_Size *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
@@ -3418,7 +3404,7 @@ MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(const void *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
const char *attributeName, Tcl_Size *indexPtr);
const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
const char *cmdName, Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
@@ -3486,8 +3472,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
MODULE_SCOPE Tcl_Obj * TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
/* TIP #280 */
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, Tcl_Size n,
int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n,
Tcl_Size *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp,
Tcl_Obj *toObj, Tcl_Size elemCount,
@@ -3503,7 +3489,7 @@ MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
const EnsembleImplMap map[]);
MODULE_SCOPE Tcl_Size TclMaxListLength(const char *bytes, Tcl_Size numBytes,
const char **endPtr);
MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, Tcl_Size objc,
MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
@@ -3512,13 +3498,13 @@ 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, Tcl_Size index);
const char *reason, int index);
MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp,
Tcl_Size objc, Tcl_Obj *const objv[],
Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE Tcl_Size TclParseBackslash(const char *src,
MODULE_SCOPE int TclParseBackslash(const char *src,
Tcl_Size numBytes, Tcl_Size *readPtr, char *dst);
MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
const char *expected, const char *bytes,
@@ -3565,10 +3551,10 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp,
const char **errorMsgPtr);
MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
Tcl_ThreadCreateProc *proc, void *clientData,
size_t stackSize, int flags);
TCL_HASH_TYPE stackSize, int flags);
MODULE_SCOPE Tcl_Size TclpFindVariable(const char *name, Tcl_Size *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
size_t *lengthPtr, Tcl_Encoding *encodingPtr);
TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void * TclpInitNotifier(void);
MODULE_SCOPE void TclpInitPlatform(void);
@@ -3632,7 +3618,7 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
size_t numBytes);
TCL_HASH_TYPE numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
int checkEq, int nocase, Tcl_Size reqlength);
@@ -3641,7 +3627,7 @@ MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen,
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes,
Tcl_Size numBytes, int flags, int line,
Tcl_Size numBytes, int flags, Tcl_Size line,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, Tcl_Size numOpts,
Tcl_Obj *const opts[], int *flagPtr);
@@ -3649,7 +3635,7 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
Tcl_Size numBytes, int flags, Tcl_Parse *parsePtr,
Tcl_InterpState *statePtr);
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
Tcl_Size count, Tcl_Size *tokensLeftPtr, int line,
Tcl_Size count, int *tokensLeftPtr, Tcl_Size line,
Tcl_Size *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes,
const char *trim, Tcl_Size numTrim,
@@ -3710,8 +3696,6 @@ MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp);
MODULE_SCOPE int TclIsZipfsPath(const char *path);
MODULE_SCOPE void TclZipfsFinalize(void);
MODULE_SCOPE Tcl_Obj * TclGetObjNameOfShlib(void);
MODULE_SCOPE void TclSetObjNameOfShlib(Tcl_Obj *namePtr, Tcl_Encoding);
/*
* Many parsing tasks need a common definition of whitespace.
@@ -3721,7 +3705,7 @@ MODULE_SCOPE void TclSetObjNameOfShlib(Tcl_Obj *namePtr, Tcl_Encoding);
MODULE_SCOPE int TclIsSpaceProc(int byte);
#define TclIsSpaceProcM(byte) \
(((unsigned)(byte) > 0x20) ? 0 : TclIsSpaceProc(byte))
(((byte) > 0x20) ? 0 : TclIsSpaceProc(byte))
/*
*----------------------------------------------------------------
@@ -3755,7 +3739,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Size index, Tcl_Size pathc,
Tcl_Obj *part2Ptr, int index, int pathc,
Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
Tcl_Size pathc, Tcl_Obj *const pathv[]);
@@ -3829,7 +3813,6 @@ MODULE_SCOPE Tcl_ObjCmdProc Tcl_SplitObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SocketObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SourceObjCmd;
MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitUnicodeCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TellObjCmd;
@@ -3874,8 +3857,6 @@ MODULE_SCOPE CompileProc TclCompileDictIncrCmd;
MODULE_SCOPE CompileProc TclCompileDictLappendCmd;
MODULE_SCOPE CompileProc TclCompileDictMapCmd;
MODULE_SCOPE CompileProc TclCompileDictMergeCmd;
MODULE_SCOPE CompileProc TclCompileDictRemoveCmd;
MODULE_SCOPE CompileProc TclCompileDictReplaceCmd;
MODULE_SCOPE CompileProc TclCompileDictSetCmd;
MODULE_SCOPE CompileProc TclCompileDictUnsetCmd;
MODULE_SCOPE CompileProc TclCompileDictUpdateCmd;
@@ -3893,22 +3874,18 @@ MODULE_SCOPE CompileProc TclCompileInfoCoroutineCmd;
MODULE_SCOPE CompileProc TclCompileInfoExistsCmd;
MODULE_SCOPE CompileProc TclCompileInfoLevelCmd;
MODULE_SCOPE CompileProc TclCompileInfoObjectClassCmd;
MODULE_SCOPE CompileProc TclCompileInfoObjectCreationIdCmd;
MODULE_SCOPE CompileProc TclCompileInfoObjectIsACmd;
MODULE_SCOPE CompileProc TclCompileInfoObjectNamespaceCmd;
MODULE_SCOPE CompileProc TclCompileIncrCmd;
MODULE_SCOPE CompileProc TclCompileLappendCmd;
MODULE_SCOPE CompileProc TclCompileLassignCmd;
MODULE_SCOPE CompileProc TclCompileLeditCmd;
MODULE_SCOPE CompileProc TclCompileLindexCmd;
MODULE_SCOPE CompileProc TclCompileLinsertCmd;
MODULE_SCOPE CompileProc TclCompileListCmd;
MODULE_SCOPE CompileProc TclCompileLlengthCmd;
MODULE_SCOPE CompileProc TclCompileLmapCmd;
MODULE_SCOPE CompileProc TclCompileLpopCmd;
MODULE_SCOPE CompileProc TclCompileLrangeCmd;
MODULE_SCOPE CompileProc TclCompileLreplaceCmd;
MODULE_SCOPE CompileProc TclCompileLseqCmd;
MODULE_SCOPE CompileProc TclCompileLsetCmd;
MODULE_SCOPE CompileProc TclCompileNamespaceCodeCmd;
MODULE_SCOPE CompileProc TclCompileNamespaceCurrentCmd;
@@ -3950,7 +3927,6 @@ MODULE_SCOPE CompileProc TclCompileTailcallCmd;
MODULE_SCOPE CompileProc TclCompileThrowCmd;
MODULE_SCOPE CompileProc TclCompileTryCmd;
MODULE_SCOPE CompileProc TclCompileUnsetCmd;
MODULE_SCOPE CompileProc TclCompileUplevelCmd;
MODULE_SCOPE CompileProc TclCompileUpvarCmd;
MODULE_SCOPE CompileProc TclCompileVariableCmd;
MODULE_SCOPE CompileProc TclCompileWhileCmd;
@@ -4036,10 +4012,9 @@ MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags);
/* Flag values for the [string] ensemble functions. */
enum StringOpFlags {
TCL_STRING_MATCH_NOCASE = TCL_MATCH_NOCASE, /* (1<<0) in tcl.h */
TCL_STRING_IN_PLACE = (1<<1) /* Do in-place surgery on Tcl_Obj */
};
#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)
/*
* Functions defined in generic/tclVar.c and currently exported only for use
@@ -4055,25 +4030,25 @@ MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp,
Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
int flags, const char *msg,
int createPart1, int createPart2,
Var *arrayPtr, Tcl_Size index);
Var *arrayPtr, int index);
MODULE_SCOPE Tcl_Obj * TclPtrGetVarIdx(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags, Tcl_Size index);
Tcl_Obj *part2Ptr, int flags, int index);
MODULE_SCOPE Tcl_Obj * TclPtrSetVarIdx(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
int flags, Tcl_Size index);
int flags, int index);
MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVarIdx(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
int flags, Tcl_Size index);
int flags, int index);
MODULE_SCOPE int TclPtrObjMakeUpvarIdx(Tcl_Interp *interp,
Var *otherPtr, Tcl_Obj *myNamePtr, int myFlags,
Tcl_Size index);
int index);
MODULE_SCOPE int TclPtrUnsetVarIdx(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags,
Tcl_Size index);
int index);
MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr,
Tcl_HashTable *tablePtr);
@@ -4084,7 +4059,7 @@ MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr,
MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
int flags, int leaveErrMsg, Tcl_Size index);
int flags, int leaveErrMsg, int index);
/*
* So tclObj.c and tclDictObj.c can share these implementations.
@@ -4092,7 +4067,7 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE size_t TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE int TclFullFinalizationRequested(void);
@@ -4167,8 +4142,8 @@ MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue);
*/
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp,
Tcl_Size count);
MODULE_SCOPE int TclListLimitExceededError(Tcl_Interp *interp);
MODULE_SCOPE int TclCannotAllocateError(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif /* TCL_MAJOR_VERSION > 8 */
/* Constants used in index value encoding routines. */
#define TCL_INDEX_END ((Tcl_Size)-2)
@@ -4443,7 +4418,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*
* MODULE_SCOPE void TclInitEmptyStringRep(Tcl_Obj *objPtr);
* MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
* MODULE_SCOPE const char *TclAttemptInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
* MODULE_SCOPE void TclAttemptInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
*
*----------------------------------------------------------------
*/
@@ -4468,7 +4443,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \
(objPtr)->length = ((objPtr)->bytes) ? \
(memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \
(objPtr)->bytes[len] = '\0', (Tcl_Size)(len)) : (-1) \
(objPtr)->bytes[len] = '\0', (len)) : (-1) \
)), (objPtr)->bytes)
/*
@@ -4491,14 +4466,6 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \
: (Tcl_GetStringFromObj)((objPtr), (lenPtr)))
#define TclAttemptGetString(objPtr) \
((objPtr)->bytes? (objPtr)->bytes : Tcl_AttemptGetString(objPtr))
#define TclAttemptGetStringFromObj(objPtr, lenPtr) \
((objPtr)->bytes \
? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \
: (Tcl_AttemptGetStringFromObj)((objPtr), (lenPtr)))
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to clean out an object's internal
@@ -4579,7 +4546,7 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
do { \
Tcl_Obj *bignumObj = (objPtr); \
int bignumPayload = \
(int)PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \
PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \
if (bignumPayload == -1) { \
(bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
} else { \
@@ -4870,16 +4837,6 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#define TclAttemptNewStringObj(objPtr, s, len) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
TclAttemptInitStringRep((objPtr), (s), (len)); \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
@@ -4907,10 +4864,6 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
#define TclNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_NewStringObj((s), (len))
#define TclAttemptNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_AttemptNewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
/*
+21 -11
View File
@@ -171,7 +171,7 @@ EXTERN int TclObjInvoke(Tcl_Interp *interp, Tcl_Size objc,
/* Slot 67 is reserved */
/* Slot 68 is reserved */
/* 69 */
EXTERN void * TclpAlloc(size_t size);
EXTERN void * TclpAlloc(TCL_HASH_TYPE size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
@@ -187,7 +187,7 @@ EXTERN unsigned long long TclpGetSeconds(void);
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN void * TclpRealloc(void *ptr, size_t size);
EXTERN void * TclpRealloc(void *ptr, TCL_HASH_TYPE size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
@@ -440,7 +440,8 @@ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void);
EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name,
Tcl_Encoding encoding);
/* 215 */
EXTERN void * TclStackAlloc(Tcl_Interp *interp, size_t numBytes);
EXTERN void * TclStackAlloc(Tcl_Interp *interp,
TCL_HASH_TYPE numBytes);
/* 216 */
EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
@@ -569,8 +570,7 @@ EXTERN void TclStaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN int TclMSB(unsigned long long n);
/* Slot 258 is reserved */
/* Slot 259 is reserved */
/* Slot 260 is reserved */
/* 261 */
@@ -649,7 +649,7 @@ typedef struct TclIntStubs {
void (*reserved66)(void);
void (*reserved67)(void);
void (*reserved68)(void);
void * (*tclpAlloc) (size_t size); /* 69 */
void * (*tclpAlloc) (TCL_HASH_TYPE size); /* 69 */
void (*reserved70)(void);
void (*reserved71)(void);
void (*reserved72)(void);
@@ -661,7 +661,7 @@ typedef struct TclIntStubs {
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */
void * (*tclpRealloc) (void *ptr, TCL_HASH_TYPE size); /* 81 */
void (*reserved82)(void);
void (*reserved83)(void);
void (*reserved84)(void);
@@ -795,7 +795,7 @@ typedef struct TclIntStubs {
void (*tclpFindExecutable) (const char *argv0); /* 212 */
Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
void * (*tclStackAlloc) (Tcl_Interp *interp, size_t numBytes); /* 215 */
void * (*tclStackAlloc) (Tcl_Interp *interp, TCL_HASH_TYPE numBytes); /* 215 */
void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
@@ -838,7 +838,7 @@ typedef struct TclIntStubs {
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
int (*tclMSB) (unsigned long long n); /* 258 */
void (*reserved258)(void);
void (*reserved259)(void);
void (*reserved260)(void);
void (*tclUnusedStubEntry) (void); /* 261 */
@@ -1253,8 +1253,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticLibrary \
(tclIntStubsPtr->tclStaticLibrary) /* 257 */
#define TclMSB \
(tclIntStubsPtr->tclMSB) /* 258 */
/* Slot 258 is reserved */
/* Slot 259 is reserved */
/* Slot 260 is reserved */
#define TclUnusedStubEntry \
@@ -1270,6 +1269,17 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclStaticLibrary)
#endif /* defined(USE_TCL_STUBS) */
#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS)
#undef TclpGetClicks
#define TclpGetClicks() \
((unsigned long)tclIntStubsPtr->tclpGetClicks())
#undef TclpGetSeconds
#define TclpGetSeconds() \
((unsigned long)tclIntStubsPtr->tclpGetSeconds())
#undef TclGetObjInterpProc2
#define TclGetObjInterpProc2 TclGetObjInterpProc
#endif
#undef TclUnusedStubEntry
#define TclObjInterpProc TclGetObjInterpProc()
#define TclObjInterpProc2 TclGetObjInterpProc2()
+501 -4
View File
@@ -30,6 +30,492 @@
* in the generic/tclInt.decls script.
*/
#if TCL_MAJOR_VERSION < 9
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 1 */
EXTERN int TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 15 */
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr);
/* 17 */
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
const char *dst,
const Tcl_StatBuf *statBufPtr);
/* 18 */
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
const char *pathName, const char *fileName,
Tcl_StatBuf *statBufPtr,
Tcl_GlobTypeData *types);
/* 19 */
EXTERN void TclMacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
/* 4 */
EXTERN void * TclWinGetTclInstance(void);
/* 5 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
EXTERN Tcl_Size TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 12 */
EXTERN int TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 15 */
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* 16 */
EXTERN int TclpIsAtty(int fd);
/* 17 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 18 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void TclWinAddProcess(void *hProcess, Tcl_Size id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* 27 */
EXTERN void TclWinFlushDirtyChannels(void);
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 1 */
EXTERN int TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* Slot 13 is reserved */
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 15 */
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr);
/* 17 */
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
const char *dst,
const Tcl_StatBuf *statBufPtr);
/* 18 */
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
const char *pathName, const char *fileName,
Tcl_StatBuf *statBufPtr,
Tcl_GlobTypeData *types);
/* 19 */
EXTERN void TclMacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* MACOSX */
typedef struct TclIntPlatStubs {
int magic;
void *hooks;
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
void (*reserved20)(void);
void (*reserved21)(void);
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
void (*reserved23)(void);
void (*reserved24)(void);
void (*reserved25)(void);
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*reserved0)(void);
void (*reserved1)(void);
void (*reserved2)(void);
void (*reserved3)(void);
void * (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
void (*reserved6)(void);
void (*reserved7)(void);
Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */
void (*reserved9)(void);
void *(*tclpReaddir) (void *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
int (*tclpIsAtty) (int fd); /* 16 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */
void (*reserved21)(void);
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
void (*reserved23)(void);
char * (*tclWinNoBackslash) (char *path); /* 24 */
void (*reserved25)(void);
void (*reserved26)(void);
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
void (*reserved20)(void);
void (*reserved21)(void);
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
void (*reserved23)(void);
void (*reserved24)(void);
void (*reserved25)(void);
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#ifdef __cplusplus
}
#endif
#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
/* Slot 5 is reserved */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */
#define TclpGetPid \
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
/* Slot 9 is reserved */
/* Slot 10 is reserved */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
#define TclWinFlushDirtyChannels \
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
/* Slot 5 is reserved */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */
#endif /* defined(USE_TCL_STUBS) */
#else /* TCL_MAJOR_VERSION > 8 */
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
@@ -61,7 +547,8 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
EXTERN Tcl_Size TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* 10 */
EXTERN Tcl_Encoding TclWinGetUserEncoding(Tcl_Interp *interp);
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -114,7 +601,7 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
void (*reserved10)(void);
Tcl_Encoding (*tclWinGetUserEncoding) (Tcl_Interp *interp); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
void (*reserved12)(void);
void (*reserved13)(void);
@@ -168,7 +655,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
#define TclWinGetUserEncoding \
(tclIntPlatStubsPtr->tclWinGetUserEncoding) /* 10 */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
/* Slot 12 is reserved */
@@ -202,6 +690,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
#endif /* TCL_MAJOR_VERSION */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
@@ -232,7 +721,7 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
#endif
#if defined(_WIN32)
# ifndef TCL_NO_DEPRECATED
# if !defined(TCL_NO_DEPRECATED)
# define TclWinConvertError Tcl_WinConvertError
# define TclWinConvertWSAError Tcl_WinConvertError
# define TclWinNToHS ntohs
@@ -249,4 +738,12 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
# define TclpGetPid(pid) ((Tcl_Size)(pid))
#endif
#ifdef USE_TCL_STUBS
/* Protect TclWinGetUserEncoding() for environments it doen't exist, e.g. Tcl 9.0.0/9.0.1 */
#undef TclWinGetUserEncoding
#define TclWinGetUserEncoding(interp) \
(tclIntPlatStubsPtr->tclWinGetUserEncoding ? tclIntPlatStubsPtr->tclWinGetUserEncoding(interp) : NULL)
#endif
#endif /* _TCLINTPLATDECLS */
+23 -31
View File
@@ -221,6 +221,10 @@ enum LimitHandlerFlags {
* Prototypes for local static functions:
*/
static int AliasCreate(Tcl_Interp *interp,
Tcl_Interp *childInterp, Tcl_Interp *parentInterp,
Tcl_Obj *namePtr, Tcl_Obj *targetPtr, Tcl_Size objc,
Tcl_Obj *const objv[]);
static int AliasDelete(Tcl_Interp *interp,
Tcl_Interp *childInterp, Tcl_Obj *namePtr);
static int AliasDescribe(Tcl_Interp *interp,
@@ -336,8 +340,8 @@ Tcl_Init(
* pre-init and init scripts are running. The real version of this struct
* is in tclPkg.c.
*/
typedef struct PkgNameStruct {
struct PkgNameStruct *nextPtr;/* Next in list of package names being
typedef struct PkgName {
struct PkgName *nextPtr;/* Next in list of package names being
* initialized. */
char name[4]; /* Enough space for "tcl". The *real* version
* of this structure uses a flex array. */
@@ -697,7 +701,7 @@ NRInterpCmd(
return TCL_ERROR;
}
return TclAliasCreate(interp, childInterp, parentInterp, objv[3],
return AliasCreate(interp, childInterp, parentInterp, objv[3],
objv[5], objc - 6, objv + 6);
}
@@ -752,8 +756,6 @@ NRInterpCmd(
case OPT_LAST:
i++;
goto endOfForLoop;
default:
TCL_UNREACHABLE();
}
}
@@ -1020,7 +1022,8 @@ NRInterpCmd(
case LIMIT_TYPE_TIME:
return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv);
default:
TCL_UNREACHABLE();
Tcl_Panic("unreachable");
return TCL_ERROR;
}
}
case OPT_MARKTRUSTED:
@@ -1144,7 +1147,8 @@ NRInterpCmd(
return TCL_OK;
}
default:
TCL_UNREACHABLE();
Tcl_Panic("unreachable");
return TCL_ERROR;
}
}
@@ -1228,7 +1232,7 @@ Tcl_CreateAlias(
targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
Tcl_IncrRefCount(targetObjPtr);
result = TclAliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
targetObjPtr, argc, objv);
for (i = 0; i < argc; i++) {
@@ -1275,7 +1279,7 @@ Tcl_CreateAliasObj(
targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
Tcl_IncrRefCount(targetObjPtr);
result = TclAliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
targetObjPtr, objc, objv);
Tcl_DecrRefCount(childObjPtr);
@@ -1448,7 +1452,7 @@ TclPreventAliasLoop(
/*
*----------------------------------------------------------------------
*
* TclAliasCreate --
* AliasCreate --
*
* Helper function to do the work to actually create an alias.
*
@@ -1462,8 +1466,8 @@ TclPreventAliasLoop(
*----------------------------------------------------------------------
*/
int
TclAliasCreate(
static int
AliasCreate(
Tcl_Interp *interp, /* Interp for error reporting. */
Tcl_Interp *childInterp, /* Interp where alias cmd will live or from
* which alias will be deleted. */
@@ -2464,7 +2468,7 @@ ChildCreate(
TclNewLiteralStringObj(clockObj, "clock");
Tcl_IncrRefCount(clockObj);
status = TclAliasCreate(interp, childInterp, parentInterp, clockObj,
status = AliasCreate(interp, childInterp, parentInterp, clockObj,
clockObj, 0, NULL);
Tcl_DecrRefCount(clockObj);
if (status != TCL_OK) {
@@ -2554,7 +2558,7 @@ NRChildCmd(
return AliasDelete(interp, childInterp, objv[2]);
}
} else {
return TclAliasCreate(interp, childInterp, interp, objv[2],
return AliasCreate(interp, childInterp, interp, objv[2],
objv[3], objc - 4, objv + 4);
}
}
@@ -2673,10 +2677,9 @@ NRChildCmd(
return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv);
case LIMIT_TYPE_TIME:
return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv);
default:
TCL_UNREACHABLE();
}
}
break;
case OPT_MARKTRUSTED:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -2689,8 +2692,6 @@ NRChildCmd(
return TCL_ERROR;
}
return ChildRecursionLimit(interp, childInterp, objc - 2, objv + 2);
default:
TCL_UNREACHABLE();
}
return TCL_ERROR;
@@ -3961,7 +3962,7 @@ Tcl_LimitSetCommands(
*----------------------------------------------------------------------
*/
Tcl_Size
int
Tcl_LimitGetCommands(
Tcl_Interp *interp)
{
@@ -4328,7 +4329,7 @@ TclRemoveScriptLimitCallbacks(
while (hashPtr != NULL) {
keyPtr = (ScriptLimitCallbackKey *)
Tcl_GetHashKey(&iPtr->limit.callbacks, hashPtr);
Tcl_LimitRemoveHandler(keyPtr->interp, (int)keyPtr->type,
Tcl_LimitRemoveHandler(keyPtr->interp, keyPtr->type,
CallScriptLimitCallback, Tcl_GetHashValue(hashPtr));
hashPtr = Tcl_NextHashEntry(&search);
}
@@ -4528,8 +4529,6 @@ ChildCommandLimitCmd(
Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp)));
}
break;
default:
TCL_UNREACHABLE();
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
@@ -4538,8 +4537,7 @@ ChildCommandLimitCmd(
} else {
Tcl_Size i, scriptLen = 0, limitLen = 0;
Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
int gran = 0;
Tcl_Size limit = 0;
int gran = 0, limit = 0;
for (i=consumedObjc ; i<objc ; i+=2) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
@@ -4570,7 +4568,7 @@ ChildCommandLimitCmd(
if (limitLen == 0) {
break;
}
if (Tcl_GetSizeIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
return TCL_ERROR;
}
if (limit < 0) {
@@ -4581,8 +4579,6 @@ ChildCommandLimitCmd(
return TCL_ERROR;
}
break;
default:
TCL_UNREACHABLE();
}
}
if (scriptObj != NULL) {
@@ -4733,8 +4729,6 @@ ChildTimeLimitCmd(
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limitMoment.sec));
}
break;
default:
TCL_UNREACHABLE();
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
@@ -4808,8 +4802,6 @@ ChildTimeLimitCmd(
}
limitMoment.sec = (long long) tmp;
break;
default:
TCL_UNREACHABLE();
}
}
if (milliObj != NULL || secObj != NULL) {
+3 -3
View File
@@ -36,7 +36,7 @@ typedef struct {
Tcl_Size bytes; /* Size of C variable array. This is 0 when
* single variables, and >0 used for array
* variables. */
Tcl_Size numElems; /* Number of elements in C variable array.
Tcl_Size numElems; /* Number of elements in C variable array.
* Zero for single variables. */
int type; /* Type of link (TCL_LINK_INT, etc.). */
union {
@@ -680,7 +680,7 @@ GetInvalidDoubleFromObj(
static char *
LinkTraceProc(
void *clientData, /* Contains information about the link. */
void *clientData, /* Contains information about the link. */
Tcl_Interp *interp, /* Interpreter containing Tcl variable. */
TCL_UNUSED(const char *) /*name1*/,
TCL_UNUSED(const char *) /*name2*/,
@@ -1316,7 +1316,7 @@ ObjValue(
Tcl_Obj *uwObj;
TclNewUIntObj(uwObj, linkPtr->lastValue.uw);
return uwObj;
}
}
case TCL_LINK_STRING:
p = LinkedVar(char *);
+94 -120
View File
@@ -39,31 +39,32 @@
#ifdef ENABLE_LIST_ASSERTS
#define LIST_ASSERT(cond_) \
assert(cond_)
#define LIST_ASSERT(cond_) assert(cond_)
/*
* LIST_INDEX_ASSERT is to catch errors with negative indices and counts
* being passed AFTER validation. On Tcl9 length types are unsigned hence
* the checks against LIST_MAX. On Tcl8 length types are signed hence the
* also checks against 0.
*/
#define LIST_INDEX_ASSERT(idxarg_) \
do { \
Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \
LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \
#define LIST_INDEX_ASSERT(idxarg_) \
do { \
Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \
LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \
} while (0)
/* Ditto for counts except upper limit is different */
#define LIST_COUNT_ASSERT(countarg_) \
do { \
Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \
LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \
#define LIST_COUNT_ASSERT(countarg_) \
do { \
Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \
LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \
} while (0)
#else // !ENABLE_LIST_ASSERTS
#define LIST_ASSERT(cond_) ((void) 0)
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)
#endif // ENABLE_LIST_ASSERTS
#else
#define LIST_ASSERT(cond_) ((void) 0)
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)
#endif
/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
@@ -104,15 +105,13 @@
* - Finally if LISTREP_SPACE_ONLY_BACK is present, ALL extra space is at
* the back.
*/
enum ListRepresentationFlags {
LISTREP_PANIC_ON_FAIL = 1,
LISTREP_SPACE_FAVOR_FRONT = 2,
LISTREP_SPACE_FAVOR_BACK = 4,
LISTREP_SPACE_ONLY_BACK = 8
};
#define LISTREP_PANIC_ON_FAIL 0x00000001
#define LISTREP_SPACE_FAVOR_FRONT 0x00000002
#define LISTREP_SPACE_FAVOR_BACK 0x00000004
#define LISTREP_SPACE_ONLY_BACK 0x00000008
#define LISTREP_SPACE_FAVOR_NONE \
(LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK)
#define LISTREP_SPACE_FLAGS \
#define LISTREP_SPACE_FLAGS \
(LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK \
| LISTREP_SPACE_ONLY_BACK)
@@ -120,6 +119,7 @@ enum ListRepresentationFlags {
* Prototypes for non-inline static functions defined later in this file:
*/
static int MemoryAllocationError(Tcl_Interp *, size_t size);
static int ListLimitExceededError(Tcl_Interp *);
static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags);
static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *);
static int ListRepInitAttempt(Tcl_Interp *,
@@ -199,26 +199,26 @@ const Tcl_ObjType tclListType = {
* passed ListRep) and frees it first. Additionally invalidates the string
* representation. Generally used when modifying a Tcl_Obj value.
*/
#define ListObjStompRep(objPtr_, repPtr_) \
do { \
(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \
(objPtr_)->typePtr = &tclListType; \
#define ListObjStompRep(objPtr_, repPtr_) \
do { \
(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \
(objPtr_)->typePtr = &tclListType; \
} while (0)
#define ListObjOverwriteRep(objPtr_, repPtr_) \
do { \
ListRepIncrRefs(repPtr_); \
ListObjStompRep(objPtr_, repPtr_); \
do { \
ListRepIncrRefs(repPtr_); \
ListObjStompRep(objPtr_, repPtr_); \
} while (0)
#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_) \
do { \
/* Note order important, don't use ListObjOverwriteRep! */ \
ListRepIncrRefs(repPtr_); \
TclFreeInternalRep(objPtr_); \
TclInvalidateStringRep(objPtr_); \
ListObjStompRep(objPtr_, repPtr_); \
#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_) \
do { \
/* Note order important, don't use ListObjOverwriteRep! */ \
ListRepIncrRefs(repPtr_); \
TclFreeInternalRep(objPtr_); \
TclInvalidateStringRep(objPtr_); \
ListObjStompRep(objPtr_, repPtr_); \
} while (0)
/*
@@ -239,8 +239,8 @@ const Tcl_ObjType tclListType = {
*/
static inline ListSpan *
ListSpanNew(
Tcl_Size firstSlot, /* Starting slot index of the span */
Tcl_Size numSlots) /* Number of slots covered by the span */
Tcl_Size firstSlot, /* Starting slot index of the span */
Tcl_Size numSlots) /* Number of slots covered by the span */
{
ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr));
spanPtr->refCount = 0;
@@ -298,8 +298,8 @@ ListSpanDecrRefs(
*/
static inline int
ListSpanMerited(
Tcl_Size length, /* Length of the proposed span */
Tcl_Size usedStorageLength, /* Number of slots currently in used */
Tcl_Size length, /* Length of the proposed span */
Tcl_Size usedStorageLength, /* Number of slots currently in used */
Tcl_Size allocatedStorageLength) /* Length of the currently allocation */
{
/*
@@ -370,9 +370,9 @@ ListRepFreeUnreferenced(
*/
static inline void
ObjArrayIncrRefs(
Tcl_Obj * const *objv, /* Pointer to the array */
Tcl_Size startIdx, /* Starting index of subarray within objv */
Tcl_Size count) /* Number of elements in the subarray */
Tcl_Obj * const *objv, /* Pointer to the array */
Tcl_Size startIdx, /* Starting index of subarray within objv */
Tcl_Size count) /* Number of elements in the subarray */
{
Tcl_Obj *const *end;
LIST_INDEX_ASSERT(startIdx);
@@ -402,9 +402,9 @@ ObjArrayIncrRefs(
*/
static inline void
ObjArrayDecrRefs(
Tcl_Obj * const *objv, /* Pointer to the array */
Tcl_Size startIdx, /* Starting index of subarray within objv */
Tcl_Size count) /* Number of elements in the subarray */
Tcl_Obj * const *objv, /* Pointer to the array */
Tcl_Size startIdx, /* Starting index of subarray within objv */
Tcl_Size count) /* Number of elements in the subarray */
{
Tcl_Obj * const *end;
LIST_INDEX_ASSERT(startIdx);
@@ -434,9 +434,9 @@ ObjArrayDecrRefs(
*/
static inline void
ObjArrayCopy(
Tcl_Obj **to, /* Destination */
Tcl_Size count, /* Number of pointers to copy */
Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */
Tcl_Obj **to, /* Destination */
Tcl_Size count, /* Number of pointers to copy */
Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */
{
Tcl_Obj **end;
LIST_COUNT_ASSERT(count);
@@ -465,8 +465,8 @@ ObjArrayCopy(
*/
static int
MemoryAllocationError(
Tcl_Interp *interp, /* Interpreter for error message. May be NULL */
size_t size) /* Size of attempted allocation that failed */
Tcl_Interp *interp, /* Interpreter for error message. May be NULL */
size_t size) /* Size of attempted allocation that failed */
{
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -481,7 +481,7 @@ MemoryAllocationError(
/*
*------------------------------------------------------------------------
*
* TclListLimitExceededError --
* ListLimitExceeded --
*
* Generates an error for exceeding maximum list size.
*
@@ -493,19 +493,13 @@ MemoryAllocationError(
*
*------------------------------------------------------------------------
*/
int
TclListLimitExceededError(
static int
ListLimitExceededError(
Tcl_Interp *interp)
{
/*
* As an aside, note there is no parameter passed for the bad length
* because the cverflow is computationally detected and does not fit
* in Tcl_Size.
*/
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("max length (%" TCL_SIZE_MODIFIER
"d) of a Tcl list exceeded", (Tcl_Size)LIST_MAX));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"max length of a Tcl list exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
}
return TCL_ERROR;
@@ -646,12 +640,12 @@ ListRepValidate(
(void)storePtr; /* To stop gcc from whining about unused vars */
#define INVARIANT(cond_) \
do { \
if (!(cond_)) { \
condition = #cond_; \
goto failure; \
} \
#define INVARIANT(cond_) \
do { \
if (!(cond_)) { \
condition = #cond_; \
goto failure; \
} \
} while (0)
/* Separate each condition so line number gives exact reason for failure */
@@ -677,11 +671,14 @@ ListRepValidate(
INVARIANT(ListRepStart(repPtr) <= (storePtr->firstUsed + storePtr->numUsed - ListRepLength(repPtr)));
#undef INVARIANT
return;
failure:
failure:
Tcl_Panic("List internal failure in %s line %d. Condition: %s",
file, lineNum, condition);
file,
lineNum,
condition);
}
/*
@@ -708,7 +705,7 @@ TclListObjValidate(
ListRep listRep;
if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
Tcl_Panic("Object passed to TclListObjValidate cannot be converted to "
"a list object.");
"a list object.");
}
ListRepValidate(&listRep, __FILE__, __LINE__);
}
@@ -945,7 +942,7 @@ ListRepInitAttempt(
if (result != TCL_OK && interp != NULL) {
if (objc > LIST_MAX) {
TclListLimitExceededError(interp);
ListLimitExceededError(interp);
} else {
MemoryAllocationError(interp, LIST_SIZE(objc));
}
@@ -1200,7 +1197,6 @@ Tcl_DbNewListObj(
*
*------------------------------------------------------------------------
*/
#if 0
Tcl_Obj *
TclNewListObj2(
Tcl_Size objc1, /* Count of objects referenced by objv1. */
@@ -1234,7 +1230,6 @@ TclNewListObj2(
storePtr->numUsed = objc;
return listObj;
}
#endif
/*
*----------------------------------------------------------------------
@@ -1263,10 +1258,10 @@ TclNewListObj2(
static int
TclListObjGetRep(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object for which an element array is
* to be returned. */
ListRep *repPtr) /* Location to store descriptor */
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object for which an element array is
* to be returned. */
ListRep *repPtr) /* Location to store descriptor */
{
if (!TclHasInternalRep(listObj, &tclListType)) {
int result;
@@ -1462,10 +1457,10 @@ ListRepRange(
if (rangeStart == 0 && rangeEnd == (numSrcElems-1)) {
/* Option 0 - entire list. This may be used to canonicalize */
/* T:listrep-1.10.1,2.8.1 */
*rangeRepPtr = *srcRepPtr; /* Note ref counts not incremented */
*rangeRepPtr = *srcRepPtr; /* Not ref counts not incremented */
} else if (rangeStart == 0 && (!preserveSrcRep)
&& (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) {
/* Option 1 - Special case unshared, exclude end elements, no span */
/* Option 1 - Special case unshared, exclude end elements, no span */
LIST_ASSERT(srcRepPtr->storePtr->firstUsed == 0); /* If no span */
ListRepElements(srcRepPtr, numSrcElems, srcElems);
numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
@@ -1759,8 +1754,8 @@ Tcl_ListObjAppendList(
*
*------------------------------------------------------------------------
*/
int
TclListObjAppendElements(
int
TclListObjAppendElements (
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *toObj, /* List object to append */
Tcl_Size elemCount, /* Number of elements in elemObjs[] */
@@ -1797,7 +1792,7 @@ TclListObjAppendElements(
ListRepElements(&listRep, toLen, toObjv);
if (elemCount > LIST_MAX || toLen > (LIST_MAX - elemCount)) {
return TclListLimitExceededError(interp);
return ListLimitExceededError(interp);
}
finalLen = toLen + elemCount;
@@ -2022,9 +2017,9 @@ Tcl_ListObjIndex(
#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object whose #elements to return. */
Tcl_Size *lenPtr) /* The resulting length is stored here. */
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object whose #elements to return. */
Tcl_Size *lenPtr) /* The resulting length is stored here. */
{
ListRep listRep;
@@ -2138,12 +2133,12 @@ Tcl_ListObjReplace(
if (numToDelete < 0) {
numToDelete = 0;
} else if (first > LIST_MAX - numToDelete /* Handle integer overflow */
|| origListLen < first + numToDelete) {
|| origListLen < first + numToDelete) {
numToDelete = origListLen - first;
}
if (numToInsert > LIST_MAX - (origListLen - numToDelete)) {
return TclListLimitExceededError(interp);
return ListLimitExceededError(interp);
}
if ((first+numToDelete) >= origListLen) {
@@ -2740,7 +2735,7 @@ TclLindexFlat(
if (!TclHasInternalRep(listObj, &tclListType)) {
status = SetListFromAny(interp, listObj);
if (status != TCL_OK) {
/* The list is not a list at all => error. */
/* The list is not a list at all => error. */
Tcl_DecrRefCount(listObj);
return NULL;
}
@@ -2797,10 +2792,10 @@ TclLsetList(
Tcl_Obj *indexArgObj, /* Index or index-list arg to 'lset'. */
Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */
{
Tcl_Size indexCount = 0; /* Number of indices in the index list. */
Tcl_Size indexCount = 0; /* Number of indices in the index list. */
Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */
Tcl_Obj *retValueObj; /* Pointer to the list to be returned. */
Tcl_Size index; /* Current index in the list - discarded. */
Tcl_Size index; /* Current index in the list - discarded. */
Tcl_Obj *indexListCopy;
/*
@@ -3170,7 +3165,7 @@ TclListObjSetElement(
* element. */
{
ListRep listRep;
Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */
Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */
Tcl_Size elemCount; /* Number of elements in the list. */
/* Ensure that the listObj parameter designates an unshared list. */
@@ -3544,29 +3539,14 @@ UpdateStringOfList(
flagPtr = localFlags;
} else {
/* We know numElems <= LIST_MAX, so this is safe. */
flagPtr = (char *)Tcl_AttemptAlloc(numElems);
if (!flagPtr) {
listObj->length = numElems - 1;
allocError:
/* Allocation error. Just give up. */
if (listObj->bytes) {
Tcl_Free(listObj->bytes);
listObj->bytes = NULL;
}
return;
}
flagPtr = (char *)Tcl_Alloc(numElems);
}
for (i = 0; i < numElems; i++) {
flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclAttemptGetStringFromObj(elemPtrs[i], &length);
if (!elem) {
listObj->length = elemPtrs[i]->length;
goto allocError;
}
elem = TclGetStringFromObj(elemPtrs[i], &length);
bytesNeeded += TclScanElement(elem, length, flagPtr+i);
if (bytesNeeded > SIZE_MAX - numElems) {
listObj->length = bytesNeeded;
goto allocError;
Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", SIZE_MAX);
}
}
bytesNeeded += numElems - 1;
@@ -3578,14 +3558,8 @@ UpdateStringOfList(
start = dst = Tcl_InitStringRep(listObj, NULL, bytesNeeded);
TclOOM(dst, bytesNeeded);
for (i = 0; i < numElems; i++) {
if (i) {
flagPtr[i] |= TCL_DONT_QUOTE_HASH;
}
elem = TclAttemptGetStringFromObj(elemPtrs[i], &length);
if (!elem) {
listObj->length = elemPtrs[i]->length;
goto allocError;
}
flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclGetStringFromObj(elemPtrs[i], &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
*dst++ = ' ';
}
@@ -3651,7 +3625,7 @@ TclListTestObj(
ListObjReplaceRepAndInvalidate(listObj, &listRep);
return listObj;
}
/*
* Local Variables:
* mode: c
File diff suppressed because it is too large Load Diff
+27 -68
View File
@@ -29,9 +29,9 @@
*/
static size_t AddLocalLiteralEntry(CompileEnv *envPtr,
Tcl_Obj *objPtr, size_t localHash);
Tcl_Obj *objPtr, int localHash);
static void ExpandLocalLiteralArray(CompileEnv *envPtr);
static size_t HashString(const char *string, Tcl_Size length);
static size_t HashString(const char *string, size_t length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp,
Tcl_Obj *objPtr);
@@ -58,7 +58,8 @@ static void RebuildLiteralTable(LiteralTable *tablePtr);
void
TclInitLiteralTable(
LiteralTable *tablePtr) /* Pointer to table structure, which is
LiteralTable *tablePtr)
/* Pointer to table structure, which is
* supplied by the caller. */
{
#if (TCL_SMALL_HASH_TABLE != 4)
@@ -175,11 +176,11 @@ TclDeleteLiteralTable(
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
const char *bytes, /* The start of the string. Note that this is
const char *bytes, /* The start of the string. Note that this is
* not a NUL-terminated string. */
Tcl_Size length, /* Number of bytes in the string. */
size_t hash, /* The string's hash. If the value is
* TCL_INDEX_NONE, it will be computed here. */
Tcl_Size length, /* Number of bytes in the string. */
size_t hash, /* The string's hash. If the value is
* TCL_INDEX_NONE, it will be computed here. */
int *newPtr,
Namespace *nsPtr,
int flags,
@@ -250,9 +251,8 @@ TclCreateLiteral(
if ((flags & LITERAL_ON_HEAP)) {
objPtr->bytes = (char *) bytes;
objPtr->length = length;
} else if (!TclAttemptInitStringRep(objPtr, bytes, length)) {
Tcl_DecrRefCount(objPtr);
return NULL;
} else {
TclInitStringRep(objPtr, bytes, length);
}
/* Should the new literal be shared globally? */
@@ -389,12 +389,12 @@ TclFetchLiteral(
int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/
TclRegisterLiteral(
void *ePtr, /* Points to the CompileEnv in whose object
void *ePtr, /* Points to the CompileEnv in whose object
* array an object is found or created. */
const char *bytes, /* Points to string for which to find or
const char *bytes, /* Points to string for which to find or
* create an object in CompileEnv's object
* array. */
Tcl_Size length, /* Number of bytes in the string. If -1, the
Tcl_Size length, /* Number of bytes in the string. If -1, the
* string consists of all bytes up to the
* first null character. */
int flags) /* If LITERAL_ON_HEAP then the caller already
@@ -440,7 +440,7 @@ TclRegisterLiteral(
if (objIndex > INT_MAX) {
Tcl_Panic("Literal table index too large. Cannot be handled by TclEmitPush");
}
return (int)objIndex;
return objIndex;
}
}
@@ -482,7 +482,7 @@ TclRegisterLiteral(
Tcl_Panic(
"Literal table index too large. Cannot be handled by TclEmitPush");
}
return (int)objIndex;
return objIndex;
}
#ifdef TCL_COMPILE_DEBUG
@@ -507,7 +507,7 @@ static LiteralEntry *
LookupLiteralEntry(
Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
* that was previously created by a call to
* TclRegisterLiteral. */
{
@@ -553,7 +553,7 @@ void
TclHideLiteral(
Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
CompileEnv *envPtr, /* Points to CompileEnv whose literal array
CompileEnv *envPtr,/* Points to CompileEnv whose literal array
* contains the entry being hidden. */
int index) /* The index of the entry in the literal
* array. */
@@ -617,7 +617,7 @@ TclHideLiteral(
int
TclAddLiteralObj(
CompileEnv *envPtr, /* Points to CompileEnv in whose literal array
CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
Tcl_Obj *objPtr, /* The object to insert into the array. */
LiteralEntry **litPtrPtr) /* The location where the pointer to the new
@@ -647,49 +647,7 @@ TclAddLiteralObj(
*litPtrPtr = lPtr;
}
return (int)objIndex;
}
/*
*----------------------------------------------------------------------
*
* TclRegisterLiteralObj --
*
* Find, or if necessary create, an object in a CompileEnv literal array
* that has a string representation matching the argument object.
*
* Results:
* The index in the CompileEnv's literal array that references a shared
* literal matching the string. The object is created if necessary.
*
* Side effects:
* To maximize sharing, we look up the string in the interpreter's global
* literal table. If not found, we create a new shared literal in the
* global table. We then add a reference to the shared literal in the
* CompileEnv's literal array.
*
* The reference count of the argument object is bounced, so that the
* normal case where the object is zero ref count (as it is really acting
* as a local worker buffer) doesn't need explicit refcount handling by
* the caller.
*
*----------------------------------------------------------------------
*/
int
TclRegisterLiteralObj(
CompileEnv *envPtr, /* Points to CompileEnv in whose literal array
* the object is to be inserted. */
Tcl_Obj *objPtr, /* The object to insert into the array. */
int flags) /* If LITERAL_CMD_NAME then the literal should
* not be shared across namespaces.
* LITERAL_ON_HEAP is unsupported/ignored. */
{
Tcl_Size length;
const char *bytes = Tcl_GetStringFromObj(objPtr, &length);
int num = TclRegisterLiteral(envPtr, bytes, length,
flags & ~LITERAL_ON_HEAP);
Tcl_BounceRefCount(objPtr);
return num;
return objIndex;
}
/*
@@ -712,10 +670,10 @@ TclRegisterLiteralObj(
static size_t
AddLocalLiteralEntry(
CompileEnv *envPtr, /* Points to CompileEnv in whose literal array
CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */
size_t localHash) /* Hash value for the literal's string. */
int localHash) /* Hash value for the literal's string. */
{
LiteralTable *localTablePtr = &envPtr->localLitTable;
LiteralEntry *localPtr;
@@ -791,7 +749,7 @@ AddLocalLiteralEntry(
static void
ExpandLocalLiteralArray(
CompileEnv *envPtr) /* Points to the CompileEnv whose object array
CompileEnv *envPtr)/* Points to the CompileEnv whose object array
* must be enlarged. */
{
/*
@@ -873,7 +831,7 @@ void
TclReleaseLiteral(
Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
Tcl_Obj *objPtr) /* Points to a literal object that was
Tcl_Obj *objPtr) /* Points to a literal object that was
* previously created by a call to
* TclRegisterLiteral. */
{
@@ -953,8 +911,8 @@ TclReleaseLiteral(
static size_t
HashString(
const char *string, /* String for which to compute hash value. */
Tcl_Size length) /* Number of bytes in the string. */
const char *string, /* String for which to compute hash value. */
size_t length) /* Number of bytes in the string. */
{
size_t result = 0;
@@ -1017,7 +975,8 @@ HashString(
static void
RebuildLiteralTable(
LiteralTable *tablePtr) /* Local or global table to enlarge. */
LiteralTable *tablePtr)
/* Local or global table to enlarge. */
{
LiteralEntry **oldBuckets;
LiteralEntry **oldChainPtr, **newChainPtr;
+12 -22
View File
@@ -85,12 +85,6 @@ typedef struct InterpLibrary {
* for end of list. */
} InterpLibrary;
/*
* Associated data key used to look up the linked list of libraries registered
* in the interpreter.
*/
#define ASSOC_KEY "tclLoad"
/*
* Prototypes for functions that are private to this file:
*/
@@ -138,8 +132,7 @@ Tcl_LoadObjCmd(
Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpLibrary *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch;
Tcl_Size offset;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_LibraryInitProc *initProc;
const char *p, *fullFileName, *prefix;
@@ -163,14 +156,13 @@ Tcl_LoadObjCmd(
&index) != TCL_OK) {
return TCL_ERROR;
}
++objv;
--objc;
++objv; --objc;
if (LOAD_GLOBAL == index) {
flags |= TCL_LOAD_GLOBAL;
} else if (LOAD_LAZY == index) {
flags |= TCL_LOAD_LAZY;
} else {
break;
break;
}
}
if ((objc < 2) || (objc > 4)) {
@@ -285,7 +277,7 @@ Tcl_LoadObjCmd(
*/
if (libraryPtr != NULL) {
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, ASSOC_KEY, NULL);
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
if (ipPtr->libraryPtr == libraryPtr) {
code = TCL_OK;
@@ -521,11 +513,11 @@ Tcl_LoadObjCmd(
* static libraries at the head of the linked list!
*/
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, ASSOC_KEY, NULL);
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
ipPtr->libraryPtr = libraryPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, ASSOC_KEY, LoadCleanupProc, ipPtr);
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
Tcl_DStringFree(&pfx);
@@ -606,8 +598,6 @@ Tcl_UnloadObjCmd(
case UNLOAD_LAST: /* -- */
i++;
goto endOfForLoop;
default:
TCL_UNREACHABLE();
}
}
endOfForLoop:
@@ -728,7 +718,7 @@ Tcl_UnloadObjCmd(
code = TCL_ERROR;
if (libraryPtr != NULL) {
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, ASSOC_KEY, NULL);
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
if (ipPtr->libraryPtr == libraryPtr) {
code = TCL_OK;
@@ -870,7 +860,7 @@ UnloadLibrary(
*/
if (!interpExiting) {
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, ASSOC_KEY, NULL);
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
if (ipFirstPtr) {
ipPtr = ipFirstPtr;
if (ipPtr->libraryPtr == libraryPtr) {
@@ -887,7 +877,7 @@ UnloadLibrary(
}
}
Tcl_Free(ipPtr);
Tcl_SetAssocData(target, ASSOC_KEY, LoadCleanupProc, ipFirstPtr);
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr);
}
}
@@ -1064,7 +1054,7 @@ Tcl_StaticLibrary(
* it's already loaded.
*/
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
if (ipPtr->libraryPtr == libraryPtr) {
return;
@@ -1079,7 +1069,7 @@ Tcl_StaticLibrary(
ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary));
ipPtr->libraryPtr = libraryPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(interp, ASSOC_KEY, LoadCleanupProc, ipPtr);
Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
}
}
@@ -1139,7 +1129,7 @@ TclGetLoadedLibraries(
if (target == NULL) {
return TCL_ERROR;
}
ipPtr = (InterpLibrary *)Tcl_GetAssocData(target, ASSOC_KEY, NULL);
ipPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
/*
* Return information about all of the available libraries.
+13 -39
View File
@@ -276,7 +276,7 @@ Tcl_SourceRCFile(
TCL_NORETURN void
Tcl_MainEx(
Tcl_Size argc, /* Number of arguments. */
Tcl_Size argc, /* Number of arguments. */
TCHAR **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
@@ -533,26 +533,13 @@ Tcl_MainEx(
} else if (is.tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
(void)Tcl_AttemptGetStringFromObj(resultPtr, &length);
if (!resultPtr->bytes) {
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
char buf[24];
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", resultPtr->length + 1);
Tcl_WriteChars(chan, "cannot allocate ", -1);
Tcl_WriteChars(chan, buf, -1);
Tcl_WriteChars(chan, " bytes for type \'", -1);
Tcl_WriteChars(chan, resultPtr->typePtr->name , -1);
Tcl_WriteChars(chan, "\'\n", -1);
}
} else {
chan = Tcl_GetStdChannel(TCL_STDOUT);
if ((length > 0) && chan) {
if (Tcl_WriteObj(chan, resultPtr) < 0) {
Tcl_WriteChars(chan, ENCODING_ERROR, -1);
}
Tcl_WriteChars(chan, "\n", 1);
(void)Tcl_GetStringFromObj(resultPtr, &length);
chan = Tcl_GetStdChannel(TCL_STDOUT);
if ((length > 0) && chan) {
if (Tcl_WriteObj(chan, resultPtr) < 0) {
Tcl_WriteChars(chan, ENCODING_ERROR, -1);
}
Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
@@ -748,7 +735,7 @@ TclFullFinalizationRequested(void)
static void
StdinProc(
void *clientData, /* The state of interactive cmd line */
void *clientData, /* The state of interactive cmd line */
TCL_UNUSED(int) /*mask*/)
{
int code;
@@ -826,25 +813,12 @@ StdinProc(
chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
(void)Tcl_AttemptGetStringFromObj(resultPtr, &length);
if (!resultPtr->bytes) {
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
char buf[24];
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", resultPtr->length + 1);
Tcl_WriteChars(chan, "cannot allocate ", -1);
Tcl_WriteChars(chan, buf, -1);
Tcl_WriteChars(chan, " bytes for type \'", -1);
Tcl_WriteChars(chan, resultPtr->typePtr->name , -1);
Tcl_WriteChars(chan, "\'\n", -1);
}
} else {
if ((length > 0) && (chan != NULL)) {
if (Tcl_WriteObj(chan, resultPtr) < 0) {
Tcl_WriteChars(chan, ENCODING_ERROR, -1);
}
Tcl_WriteChars(chan, "\n", 1);
(void)Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && (chan != NULL)) {
if (Tcl_WriteObj(chan, resultPtr) < 0) {
Tcl_WriteChars(chan, ENCODING_ERROR, -1);
}
Tcl_WriteChars(chan, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
+15 -14
View File
@@ -201,15 +201,16 @@ CreateChildEntry(
Namespace *nsPtr, /* Parent namespace. */
const char *name) /* Simple name to look for. */
{
int newEntry;
#ifndef BREAK_NAMESPACE_COMPAT
return Tcl_CreateHashEntry(&nsPtr->childTable, name, NULL);
return Tcl_CreateHashEntry(&nsPtr->childTable, name, &newEntry);
#else
if (nsPtr->childTablePtr == NULL) {
nsPtr->childTablePtr = (Tcl_HashTable *)
Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(nsPtr->childTablePtr, TCL_STRING_KEYS);
}
return Tcl_CreateHashEntry(nsPtr->childTablePtr, name, NULL);
return Tcl_CreateHashEntry(nsPtr->childTablePtr, name, &newEntry);
#endif
}
@@ -2027,7 +2028,8 @@ Tcl_ForgetImport(
*/
Command *cmdPtr = (Command *) token;
ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData;
ImportedCmdData *dataPtr = (ImportedCmdData *)
cmdPtr->objClientData;
Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;
if (firstToken == origin) {
@@ -2300,7 +2302,7 @@ TclGetNamespaceForQualName(
* namespace if TCL_GLOBAL_ONLY was specified,
* or the current namespace if cxtNsPtr was
* NULL. */
const char **simpleNamePtr) /* Address where function stores the simple
const char **simpleNamePtr) /* Address where function stores the simple
* name at end of the qualName, or NULL if
* qualName is "::" or the flag
* TCL_FIND_ONLY_NS was specified. */
@@ -3264,7 +3266,7 @@ NamespaceCodeCmd(
* Take care to only check for scoping in precisely the style that
* [::namespace code] generates it. Anything more forgiving can have
* the effect of failing in namespaces that contain their own custom
* "namespace" command. [Bug 3202171].
" "namespace" command. [Bug 3202171].
*/
arg = TclGetStringFromObj(objv[1], &length);
@@ -3742,8 +3744,7 @@ NamespaceForgetCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *pattern;
int i;
int result;
int i, result;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
@@ -3809,8 +3810,8 @@ NamespaceImportCmd(
{
int allowOverwrite = 0;
const char *string, *pattern;
int i, firstArg;
int result;
int i, result;
int firstArg;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
@@ -4744,7 +4745,7 @@ NamespaceWhichCmd(
static const char *const opts[] = {
"-command", "-variable", NULL
};
enum { OPT_COMMAND, OPT_VARIABLE } lookupType = OPT_COMMAND;
int lookupType = 0;
Tcl_Obj *resultPtr;
if (objc < 2 || objc > 3) {
@@ -4769,7 +4770,7 @@ NamespaceWhichCmd(
TclNewObj(resultPtr);
switch (lookupType) {
case OPT_COMMAND: {
case 0: { /* -command */
Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
if (cmd != NULL) {
@@ -4777,7 +4778,7 @@ NamespaceWhichCmd(
}
break;
}
case OPT_VARIABLE: {
case 1: { /* -variable */
Tcl_Var var = Tcl_FindNamespaceVar(interp,
TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
@@ -4908,7 +4909,7 @@ SetNsNameFromAny(
name = TclGetString(objPtr);
TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
&nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
&nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
return TCL_ERROR;
@@ -5019,7 +5020,7 @@ TclLogCommandInfo(
* the error. */
Tcl_Size length, /* Number of bytes in command (< 0 means use
* all bytes up to first null byte). */
const unsigned char *pc, /* Current pc of bytecode execution context */
const unsigned char *pc, /* Current pc of bytecode execution context */
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
{
+12 -12
View File
@@ -74,7 +74,7 @@ typedef struct ThreadSpecificData {
/* Pointer to first event source in list of
* event sources for this thread. */
Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */
void *clientData; /* Opaque handle for platform specific
void *clientData; /* Opaque handle for platform specific
* notifier. */
struct ThreadSpecificData *nextPtr;
/* Next notifier in global list of notifiers.
@@ -308,7 +308,7 @@ Tcl_CreateEventSource(
Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
void *clientData) /* One-word argument to pass to setupProc and
void *clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -347,7 +347,7 @@ Tcl_DeleteEventSource(
Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
void *clientData) /* One-word argument to pass to setupProc and
void *clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -390,11 +390,11 @@ Tcl_DeleteEventSource(
void
Tcl_QueueEvent(
Tcl_Event *evPtr, /* Event to add to queue. The storage space
* must have been allocated by the caller with
* must have been allocated the caller with
* malloc (Tcl_Alloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
* possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -426,7 +426,7 @@ Tcl_ThreadQueueEvent(
* malloc (Tcl_Alloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
* possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */
{
ThreadSpecificData *tsdPtr;
@@ -486,7 +486,7 @@ QueueEvent(
* malloc (Tcl_Alloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
* possibly combined with TCL_QUEUE_ALERT_IF_EMPTY */
{
int wasEmpty = 0;
@@ -562,7 +562,7 @@ QueueEvent(
void
Tcl_DeleteEvents(
Tcl_EventDeleteProc *proc, /* The function to call. */
void *clientData) /* The type-specific data. */
void *clientData) /* The type-specific data. */
{
Tcl_Event *evPtr; /* Pointer to the event being examined */
Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if
@@ -1270,7 +1270,7 @@ Tcl_FinalizeNotifier(
void
Tcl_AlertNotifier(
void *clientData) /* Pointer to thread data. */
void *clientData) /* Pointer to thread data. */
{
if (tclNotifierHooks.alertNotifierProc) {
tclNotifierHooks.alertNotifierProc(clientData);
@@ -1327,7 +1327,7 @@ Tcl_ServiceModeHook(
void
Tcl_SetTimer(
const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
if (tclNotifierHooks.setTimerProc) {
tclNotifierHooks.setTimerProc(timePtr);
@@ -1358,7 +1358,7 @@ Tcl_SetTimer(
int
Tcl_WaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
if (tclNotifierHooks.waitForEventProc) {
return tclNotifierHooks.waitForEventProc(timePtr);
@@ -1397,7 +1397,7 @@ Tcl_CreateFileHandler(
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
void *clientData) /* Arbitrary data to pass to proc. */
void *clientData) /* Arbitrary data to pass to proc. */
{
if (tclNotifierHooks.createFileHandlerProc) {
tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
+115 -350
View File
@@ -16,67 +16,37 @@
#include "tclInt.h"
#include "tclOOInt.h"
/*
* Commands in oo and oo::Helpers.
*/
static const struct StdCommands {
const char *name;
Tcl_ObjCmdProc *objProc;
Tcl_ObjCmdProc *nreProc;
CompileProc *compileProc;
int flags;
} ooCmds[] = {
{"define", TclOODefineObjCmd, NULL, NULL, 0},
{"objdefine", TclOOObjDefObjCmd, NULL, NULL, 0},
{"copy", TclOOCopyObjectCmd, NULL, NULL, 0},
{"DelegateName", TclOODelegateNameObjCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, 0}
}, helpCmds[] = {
{"callback", TclOOCallbackObjCmd, NULL, NULL, 0},
{"mymethod", TclOOCallbackObjCmd, NULL, NULL, 0},
{"classvariable", TclOOClassVariableObjCmd, NULL, NULL, 0},
{"link", TclOOLinkObjCmd, NULL, NULL, 0},
{"next", NULL, TclOONextObjCmd, TclCompileObjectNextCmd, CMD_COMPILES_EXPANDED},
{"nextto", NULL, TclOONextToObjCmd, TclCompileObjectNextToCmd, CMD_COMPILES_EXPANDED},
{"self", TclOOSelfObjCmd, NULL, TclCompileObjectSelfCmd, 0},
{NULL, NULL, NULL, NULL, 0}
};
/*
* Commands in oo::define and oo::objdefine.
*/
static const struct DefineCommands {
static const struct {
const char *name;
Tcl_ObjCmdProc *objProc;
int flag;
} defineCmds[] = {
{"classmethod", TclOODefineClassMethodObjCmd, 0},
{"constructor", TclOODefineConstructorObjCmd, 0},
{"constructor", TclOODefineConstructorObjCmd, 0},
{"definitionnamespace", TclOODefineDefnNsObjCmd, 0},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
{"destructor", TclOODefineDestructorObjCmd, 0},
{"export", TclOODefineExportObjCmd, 0},
{"forward", TclOODefineForwardObjCmd, 0},
{"initialise", TclOODefineInitialiseObjCmd, 0},
{"initialize", TclOODefineInitialiseObjCmd, 0},
{"method", TclOODefineMethodObjCmd, 0},
{"private", TclOODefinePrivateObjCmd, 0},
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
{"self", TclOODefineSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 0},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
{"destructor", TclOODefineDestructorObjCmd, 0},
{"export", TclOODefineExportObjCmd, 0},
{"forward", TclOODefineForwardObjCmd, 0},
{"method", TclOODefineMethodObjCmd, 0},
{"private", TclOODefinePrivateObjCmd, 0},
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
{"self", TclOODefineSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 0},
{NULL, NULL, 0}
}, objdefCmds[] = {
{"class", TclOODefineClassObjCmd, 1},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
{"export", TclOODefineExportObjCmd, 1},
{"forward", TclOODefineForwardObjCmd, 1},
{"method", TclOODefineMethodObjCmd, 1},
{"private", TclOODefinePrivateObjCmd, 1},
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
{"self", TclOODefineObjSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 1},
{"class", TclOODefineClassObjCmd, 1},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
{"export", TclOODefineExportObjCmd, 1},
{"forward", TclOODefineForwardObjCmd, 1},
{"method", TclOODefineMethodObjCmd, 1},
{"private", TclOODefinePrivateObjCmd, 1},
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
{"self", TclOODefineObjSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 1},
{NULL, NULL, 0}
};
@@ -97,7 +67,7 @@ static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
Method **newMPtrPtr);
static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
Method *mPtr, Tcl_Obj *namePtr);
static Tcl_NamespaceDeleteProc DeletedHelpersNamespace;
static void DeletedHelpersNamespace(void *clientData);
static Tcl_NRPostProc FinalizeAlloc;
static Tcl_NRPostProc FinalizeNext;
static Tcl_NRPostProc FinalizeObjectCall;
@@ -106,20 +76,23 @@ static void InitClassSystemRoots(Tcl_Interp *interp,
Foundation *fPtr);
static int InitFoundation(Tcl_Interp *interp);
static Tcl_InterpDeleteProc KillFoundation;
static void MakeAdditionalClasses(Foundation *fPtr,
Tcl_Namespace *defineNs,
Tcl_Namespace *objDefineNs);
static Tcl_CmdDeleteProc MyDeleted;
static Tcl_NamespaceDeleteProc ObjectNamespaceDeleted;
static void MyDeleted(void *clientData);
static void ObjectNamespaceDeleted(void *clientData);
static Tcl_CommandTraceProc ObjectRenamedTrace;
static inline void RemoveClass(Class **list, size_t num, size_t idx);
static inline void RemoveObject(Object **list, size_t num, size_t idx);
static inline void SquelchCachedName(Object *oPtr);
static Tcl_ObjCmdProc PublicNRObjectCmd;
static Tcl_ObjCmdProc PrivateNRObjectCmd;
static Tcl_ObjCmdProc MyClassNRObjCmd;
static Tcl_CmdDeleteProc MyClassDeleted;
static int PublicNRObjectCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
static int PrivateNRObjectCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
static int MyClassNRObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
static void MyClassDeleted(void *clientData);
/*
* Methods in the oo::object and oo::class classes. First, we define a helper
@@ -134,7 +107,6 @@ static Tcl_CmdDeleteProc MyClassDeleted;
{TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}}
static const DeclaredClassMethod objMethods[] = {
DCM("<cloned>", 0, TclOO_Object_Cloned),
DCM("destroy", 1, TclOO_Object_Destroy),
DCM("eval", 0, TclOO_Object_Eval),
DCM("unknown", 0, TclOO_Object_Unknown),
@@ -142,7 +114,6 @@ static const DeclaredClassMethod objMethods[] = {
DCM("varname", 0, TclOO_Object_VarName),
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
}, clsMethods[] = {
DCM("<cloned>", 0, TclOO_Class_Cloned),
DCM("create", 1, TclOO_Class_Create),
DCM("new", 1, TclOO_Class_New),
DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
@@ -150,13 +121,6 @@ static const DeclaredClassMethod objMethods[] = {
}, cfgMethods[] = {
DCM("configure", 1, TclOO_Configurable_Configure),
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
}, singletonMethods[] = {
DCM("new", 1, TclOO_Singleton_New),
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
}, singletonInstanceMethods[] = {
DCM("<cloned>", 0, TclOO_SingletonInstance_Cloned),
DCM("destroy", 1, TclOO_SingletonInstance_Destroy),
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
};
/*
@@ -170,25 +134,25 @@ static const Tcl_MethodType classConstructor = {
};
/*
* And the oo::configurable constructor...
*/
static const Tcl_MethodType configurableConstructor = {
TCL_OO_METHOD_VERSION_CURRENT,
"oo::configurable constructor",
TclOO_Configurable_Constructor, NULL, NULL
};
/*
* The scripted part of TclOO: (legacy) package registration. There's no C API
* at all for doing this, not even internally to Tcl.
* Scripted parts of TclOO. First, the main script (cannot be outside this
* file).
*/
static const char initScript[] =
#ifndef TCL_NO_DEPRECATED
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
#endif
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};";
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */
/*
* The scripted part of the definitions of TclOO.
*/
#include "tclOOScript.h"
/*
* The actual definition of the variable holding the TclOO stub table.
@@ -217,7 +181,6 @@ MODULE_SCOPE const TclOOStubs tclOOStubs;
#define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS)
#define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
/* Wrapper for removing an item from a "flexible" item list. */
#define RemoveItem(type, lst, i) \
do { \
Remove ## type ((lst).list, (lst).num, i); \
@@ -341,8 +304,7 @@ CreateCmdInNS(
const char *name,
Tcl_ObjCmdProc *cmdProc,
Tcl_ObjCmdProc *nreProc,
CompileProc *compileProc,
int flags)
CompileProc *compileProc)
{
Command *cmdPtr;
@@ -353,33 +315,6 @@ CreateCmdInNS(
namespacePtr, cmdProc, NULL, NULL);
cmdPtr->nreProc = nreProc;
cmdPtr->compileProc = compileProc;
cmdPtr->flags |= flags;
}
/*
* ----------------------------------------------------------------------
*
* CreateConstantInNSStr --
*
* Wrapper around TclCreateConstantInNS to make using it with string
* constants easier.
*
* ----------------------------------------------------------------------
*/
static inline void
CreateConstantInNSStr(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr,// The namespace to contain the constant.
const char *nameStr, // The unqualified name of the constant.
const char *valueStr) // The value to put in the constant.
{
Tcl_Obj *nameObj = Tcl_NewStringObj(nameStr, TCL_AUTO_LENGTH);
Tcl_IncrRefCount(nameObj);
Tcl_Obj *valueObj = Tcl_NewStringObj(valueStr, TCL_AUTO_LENGTH);
Tcl_IncrRefCount(valueObj);
TclCreateConstantInNS(interp, (Namespace *) namespacePtr, nameObj, valueObj);
Tcl_DecrRefCount(nameObj);
Tcl_DecrRefCount(valueObj);
}
/*
@@ -431,20 +366,14 @@ InitFoundation(
TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
TclNewLiteralStringObj(fPtr->myName, "my");
TclNewLiteralStringObj(fPtr->slotGetName, "Get");
TclNewLiteralStringObj(fPtr->slotSetName, "Set");
TclNewLiteralStringObj(fPtr->slotResolveName, "Resolve");
TclNewLiteralStringObj(fPtr->slotDefOpName, "--default-operation");
TclNewLiteralStringObj(fPtr->mcdName, "::oo::MixinClassDelegates");
Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
Tcl_IncrRefCount(fPtr->constructorName);
Tcl_IncrRefCount(fPtr->destructorName);
Tcl_IncrRefCount(fPtr->clonedName);
Tcl_IncrRefCount(fPtr->defineName);
Tcl_IncrRefCount(fPtr->myName);
Tcl_IncrRefCount(fPtr->slotGetName);
Tcl_IncrRefCount(fPtr->slotSetName);
Tcl_IncrRefCount(fPtr->slotResolveName);
Tcl_IncrRefCount(fPtr->slotDefOpName);
Tcl_IncrRefCount(fPtr->mcdName);
TclCreateObjCommandInNs(interp, "UnknownDefinition", fPtr->ooNs,
TclOOUnknownDefinition, NULL, NULL);
@@ -489,7 +418,7 @@ InitFoundation(
TclNewLiteralStringObj(namePtr, "new");
TclNewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
namePtr /*keeps ref*/, 0 /*private*/, NULL, NULL);
namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
Tcl_BounceRefCount(namePtr);
fPtr->classCls->constructorPtr = (Method *) TclNewMethod(
(Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
@@ -499,16 +428,16 @@ InitFoundation(
* ensemble.
*/
for (i = 0 ; helpCmds[i].name ; i++) {
CreateCmdInNS(interp, fPtr->helpersNs, helpCmds[i].name,
helpCmds[i].objProc, helpCmds[i].nreProc,
helpCmds[i].compileProc, helpCmds[i].flags);
}
for (i = 0 ; ooCmds[i].name ; i++) {
CreateCmdInNS(interp, fPtr->ooNs, ooCmds[i].name,
ooCmds[i].objProc, ooCmds[i].nreProc,
ooCmds[i].compileProc, ooCmds[i].flags);
}
CreateCmdInNS(interp, fPtr->helpersNs, "next",
NULL, TclOONextObjCmd, TclCompileObjectNextCmd);
CreateCmdInNS(interp, fPtr->helpersNs, "nextto",
NULL, TclOONextToObjCmd, TclCompileObjectNextToCmd);
CreateCmdInNS(interp, fPtr->helpersNs, "self",
TclOOSelfObjCmd, NULL, TclCompileObjectSelfCmd);
CreateCmdInNS(interp, fPtr->ooNs, "define", TclOODefineObjCmd, NULL, NULL);
CreateCmdInNS(interp, fPtr->ooNs, "objdefine", TclOOObjDefObjCmd, NULL, NULL);
CreateCmdInNS(interp, fPtr->ooNs, "copy", TclOOCopyObjectCmd, NULL, NULL);
TclOOInitInfo(interp);
@@ -520,13 +449,33 @@ InitFoundation(
return TCL_ERROR;
}
MakeAdditionalClasses(fPtr, define, objdef);
/*
* Make the configurable class and install its standard defined method.
*/
CreateConstantInNSStr(interp, fPtr->ooNs, "version", TCLOO_VERSION);
CreateConstantInNSStr(interp, fPtr->ooNs, "patchlevel", TCLOO_PATCHLEVEL);
return TCL_OK;
Tcl_Object cfgCls = Tcl_NewObjectInstance(interp,
(Tcl_Class) fPtr->classCls, "::oo::configuresupport::configurable",
NULL, TCL_INDEX_NONE, NULL, 0);
TclOODefineBasicMethods(((Object *) cfgCls)->classPtr, cfgMethods);
/*
* Don't have handles to these namespaces, so use Tcl_CreateObjCommand.
*/
Tcl_CreateObjCommand(interp,
"::oo::configuresupport::configurableobject::property",
TclOODefinePropertyCmd, (void *) 1, NULL);
Tcl_CreateObjCommand(interp,
"::oo::configuresupport::configurableclass::property",
TclOODefinePropertyCmd, (void *) 0, NULL);
/*
* Evaluate the remaining definitions, which are a compiled-in Tcl script.
*/
return Tcl_EvalEx(interp, tclOOSetupScript, TCL_INDEX_NONE, 0);
}
/*
* ----------------------------------------------------------------------
*
@@ -618,154 +567,6 @@ InitClassSystemRoots(
*/
}
/*
* ----------------------------------------------------------------------
*
* MarkAsMetaclass --
*
* Make a simple class into a metaclass by making it into a subclass of
* oo::class. Assumes that the previous class it had can be ignored.
*
* ----------------------------------------------------------------------
*/
static inline void
MarkAsMetaclass(
Foundation *fPtr,
Class *classPtr)
{
Class **supers = (Class **) Tcl_Alloc(sizeof(Class *));
supers[0] = fPtr->classCls;
AddRef(supers[0]->thisPtr);
TclOOSetSuperclasses(classPtr, 1, supers);
}
/*
* ----------------------------------------------------------------------
*
* MakeAdditionalClasses --
*
* Make the extra classes in TclOO that aren't core to how it functions.
*
* ----------------------------------------------------------------------
*/
static void
MakeAdditionalClasses(
Foundation *fPtr,
Tcl_Namespace *defineNs,
Tcl_Namespace *objDefineNs)
{
Tcl_Interp *interp = fPtr->interp;
/*
* Make the singleton class, the SingletonInstance class, and install their
* standard defined methods.
*/
// A metaclass that is used to make classes that only permit one instance
// of them to exist. See singleton(n).
Object *singletonObj = (Object *) Tcl_NewObjectInstance(interp,
(Tcl_Class) fPtr->classCls, "::oo::singleton",
NULL, TCL_INDEX_NONE, NULL, 0);
Class *singletonCls = singletonObj->classPtr;
TclOODefineBasicMethods(singletonCls, singletonMethods);
// Set the superclass to oo::class
MarkAsMetaclass(fPtr, singletonCls);
// Unexport methods
TclOOUnexportMethods(singletonCls, "create", "createWithNamespace", NULL);
// A mixin used to make an object so it won't be destroyed or cloned (or
// at least not easily).
Object *singletonInst = (Object *) Tcl_NewObjectInstance(interp,
(Tcl_Class) fPtr->classCls, "::oo::SingletonInstance",
NULL, TCL_INDEX_NONE, NULL, 0);
TclOODefineBasicMethods(singletonInst->classPtr, singletonInstanceMethods);
/*
* Make the abstract class.
*/
// A metaclass that is used to make classes that can't be directly
// instantiated. See abstract(n).
Object *abstractCls = (Object *) Tcl_NewObjectInstance(interp,
(Tcl_Class) fPtr->classCls, "::oo::abstract",
NULL, TCL_INDEX_NONE, NULL, 0);
// Set the superclass to oo::class
MarkAsMetaclass(fPtr, abstractCls->classPtr);
// Unexport methods
TclOOUnexportMethods(abstractCls->classPtr,
"create", "createWithNamespace", "new", NULL);
/*
* Make the configurable class and install its standard defined method.
*/
// The class that contains the implementation of the actual
// 'configure' method (mixed into actually configurable classes).
// The 'configure' method is in tclOOBasic.c.
Object *cfgSupObj = (Object *) Tcl_NewObjectInstance(interp,
(Tcl_Class) fPtr->classCls, "::oo::configuresupport::configurable",
NULL, TCL_INDEX_NONE, NULL, 0);
Class *cfgSupCls = cfgSupObj->classPtr;
TclOODefineBasicMethods(cfgSupCls, cfgMethods);
// Namespaces used as implementation vectors for oo::define and
// oo::objdefine when the class/instance is configurable.
// Note that these also contain commands implemented in C,
// especially the [property] definition command.
Tcl_Namespace *cfgObjNs = Tcl_CreateNamespace(interp,
"::oo::configuresupport::configurableobject", NULL, NULL);
TclCreateObjCommandInNs(interp, "property", cfgObjNs,
TclOODefinePropertyCmd, INT2PTR(1) /*useInstance*/, NULL);
TclCreateObjCommandInNs(interp, "properties", cfgObjNs,
TclOODefinePropertyCmd, INT2PTR(1) /*useInstance*/, NULL);
Tcl_Export(interp, cfgObjNs, "property", /*reset*/1);
TclSetNsPath((Namespace *) cfgObjNs, 1, &objDefineNs);
Tcl_Namespace *cfgClsNs = Tcl_CreateNamespace(interp,
"::oo::configuresupport::configurableclass", NULL, NULL);
TclCreateObjCommandInNs(interp, "property", cfgClsNs,
TclOODefinePropertyCmd, INT2PTR(0) /*useInstance*/, NULL);
TclCreateObjCommandInNs(interp, "properties", cfgClsNs,
TclOODefinePropertyCmd, INT2PTR(0) /*useInstance*/, NULL);
Tcl_Export(interp, cfgClsNs, "property", /*reset*/1);
TclSetNsPath((Namespace *) cfgClsNs, 1, &defineNs);
// A metaclass that is used to make classes that can be configured in
// their creation phase (and later too). All the metaclass itself does is
// arrange for the class created to have a 'configure' method and for
// oo::define and oo::objdefine (on the class and its instances) to have
// a property definition for setting things up for 'configure'.
Object *configurableObj = (Object *) Tcl_NewObjectInstance(interp,
(Tcl_Class) fPtr->classCls, "::oo::configurable",
NULL, TCL_INDEX_NONE, NULL, 0);
Class *configurableCls = configurableObj->classPtr;
MarkAsMetaclass(fPtr, configurableCls);
Tcl_ClassSetConstructor(interp, (Tcl_Class) configurableCls, TclNewMethod(
(Tcl_Class) configurableCls, NULL, 0, &configurableConstructor, NULL));
Tcl_Obj *nsName = Tcl_NewStringObj("::oo::configuresupport::configurableclass",
TCL_AUTO_LENGTH);
Tcl_IncrRefCount(nsName);
if (cfgSupCls->clsDefinitionNs != NULL) {
Tcl_DecrRefCount(cfgSupCls->clsDefinitionNs);
}
cfgSupCls->clsDefinitionNs = nsName;
Tcl_IncrRefCount(nsName);
if (configurableCls->clsDefinitionNs != NULL) {
Tcl_DecrRefCount(configurableCls->clsDefinitionNs);
}
configurableCls->clsDefinitionNs = nsName;
nsName = Tcl_NewStringObj("::oo::configuresupport::configurableobject",
TCL_AUTO_LENGTH);
Tcl_IncrRefCount(nsName);
if (cfgSupCls->objDefinitionNs != NULL) {
Tcl_DecrRefCount(cfgSupCls->objDefinitionNs);
}
cfgSupCls->objDefinitionNs = nsName;
}
/*
* ----------------------------------------------------------------------
*
@@ -811,10 +612,7 @@ KillFoundation(
TclDecrRefCount(fPtr->clonedName);
TclDecrRefCount(fPtr->defineName);
TclDecrRefCount(fPtr->myName);
TclDecrRefCount(fPtr->slotGetName);
TclDecrRefCount(fPtr->slotSetName);
TclDecrRefCount(fPtr->slotResolveName);
TclDecrRefCount(fPtr->slotDefOpName);
TclDecrRefCount(fPtr->mcdName);
TclOODecrRefCount(fPtr->objectCls->thisPtr);
TclOODecrRefCount(fPtr->classCls->thisPtr);
@@ -998,7 +796,6 @@ AllocObject(
oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
MyClassDeleted);
oPtr->linkedCmdsList = NULL;
return oPtr;
}
@@ -1043,17 +840,6 @@ MyDeleted(
{
Object *oPtr = (Object *) clientData;
if (oPtr->linkedCmdsList) {
Tcl_Size linkc, i;
Tcl_Obj **linkv;
TclListObjGetElements(NULL, oPtr->linkedCmdsList, &linkc, &linkv);
for (i=0 ; i<linkc ; i++) {
Tcl_Obj *link = linkv[i];
(void) Tcl_DeleteCommand(oPtr->fPtr->interp, TclGetString(link));
}
Tcl_DecrRefCount(oPtr->linkedCmdsList);
oPtr->linkedCmdsList = NULL;
}
oPtr->myCommand = NULL;
}
@@ -1454,7 +1240,7 @@ ObjectNamespaceDeleted(
* freed memory.
*/
if (((Command *) oPtr->command)->flags & CMD_DYING) {
if (((Command *) oPtr->command)->flags && CMD_DYING) {
/*
* Something has already started the command deletion process. We can
* go ahead and clean up the namespace,
@@ -1601,6 +1387,7 @@ TclOODecrRefCount(
Object *oPtr)
{
if (oPtr->refCount-- <= 1) {
if (oPtr->classPtr != NULL) {
Tcl_Free(oPtr->classPtr);
}
@@ -2078,16 +1865,6 @@ TclNRNewObjectInstance(
return TclOOInvokeContext(contextPtr, interp, objc, objv);
}
/*
* ----------------------------------------------------------------------
*
* TclNewObjectInstanceCommon --
*
* Common code for handling object allocation. Does the basic object
* structure and class structure allocation.
*
* ----------------------------------------------------------------------
*/
Object *
TclNewObjectInstanceCommon(
Tcl_Interp *interp,
@@ -2153,17 +1930,6 @@ TclNewObjectInstanceCommon(
return oPtr;
}
/*
* ----------------------------------------------------------------------
*
* FinalizeAlloc --
*
* Final stage of NR-aware object allocation, running after the
* constructor has been called to decide whether the construction
* succeeded or failed.
*
* ----------------------------------------------------------------------
*/
static int
FinalizeAlloc(
void *data[],
@@ -3119,6 +2885,7 @@ Tcl_ObjectContextInvokeNext(
CallContext *contextPtr = (CallContext *) context;
size_t savedIndex = contextPtr->index;
size_t savedSkip = contextPtr->skip;
int result;
if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
/*
@@ -3128,11 +2895,22 @@ Tcl_ObjectContextInvokeNext(
* unexpectedly.
*/
const char *methodType;
if (Tcl_InterpDeleted(interp)) {
return TCL_OK;
}
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
methodType = "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
methodType = "destructor";
} else {
methodType = "method";
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", TclOOContextTypeName(contextPtr)));
"no next %s implementation", methodType));
OO_ERROR(interp, NOTHING_NEXT);
return TCL_ERROR;
}
@@ -3154,8 +2932,8 @@ Tcl_ObjectContextInvokeNext(
* Invoke the (advanced) method call context in the caller context.
*/
int result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
objc, objv);
result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc,
objv);
/*
* Restore the call chain context index as we've finished the inner invoke
@@ -3186,11 +2964,22 @@ TclNRObjectContextInvokeNext(
* unexpectedly.
*/
const char *methodType;
if (Tcl_InterpDeleted(interp)) {
return TCL_OK;
}
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
methodType = "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
methodType = "destructor";
} else {
methodType = "method";
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", TclOOContextTypeName(contextPtr)));
"no next %s implementation", methodType));
OO_ERROR(interp, NOTHING_NEXT);
return TCL_ERROR;
}
@@ -3352,30 +3141,6 @@ Tcl_GetObjectName(
return TclOOObjectName(interp, (Object *) object);
}
/*
* ----------------------------------------------------------------------
*
* TclOOObjectMyName --
*
* Utility function that returns the name of the object's [my], or NULL
* if it has been deleted (or otherwise doesn't exist).
*
* ----------------------------------------------------------------------
*/
Tcl_Obj *
TclOOObjectMyName(
Tcl_Interp *interp,
Object *oPtr)
{
if (!oPtr->myCommand) {
return NULL;
}
Tcl_Obj *namePtr;
TclNewObj(namePtr);
Tcl_GetCommandFullName(interp, oPtr->myCommand, namePtr);
return namePtr;
}
/*
* ----------------------------------------------------------------------
*
+9 -2
View File
@@ -20,13 +20,12 @@
*
* tests/oo.test
* tests/ooNext2.test
* tests/ooUtil.test
* unix/tclooConfig.sh
* win/tclooConfig.sh
*/
#define TCLOO_VERSION "1.3"
#define TCLOO_PATCHLEVEL TCLOO_VERSION ".1"
#define TCLOO_PATCHLEVEL TCLOO_VERSION ".0"
#include "tcl.h"
@@ -63,8 +62,12 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
#if TCL_MAJOR_VERSION > 8
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv);
#else
#define Tcl_MethodCallProc2 Tcl_MethodCallProc
#endif
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
void **newClientData);
@@ -95,6 +98,7 @@ typedef struct Tcl_MethodType {
* be copied directly. */
} Tcl_MethodType;
#if TCL_MAJOR_VERSION > 8
typedef struct Tcl_MethodType2 {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_2 in
@@ -111,6 +115,9 @@ typedef struct Tcl_MethodType2 {
* data, or NULL if the type-specific data can
* be copied directly. */
} Tcl_MethodType2;
#else
#define Tcl_MethodType2 Tcl_MethodType
#endif
/*
* The correct value for the version field of the Tcl_MethodType structure.
+68 -700
View File
@@ -19,12 +19,10 @@
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static Tcl_NRPostProc AfterNRDestructor;
static Tcl_NRPostProc PostClassConstructor;
static Tcl_NRPostProc DecrRefsPostClassConstructor;
static Tcl_NRPostProc FinalizeConstruction;
static Tcl_NRPostProc FinalizeEval;
static Tcl_NRPostProc NextRestoreFrame;
static Tcl_NRPostProc MarkAsSingleton;
static Tcl_NRPostProc UpdateClassDelegatesAfterClone;
/*
* ----------------------------------------------------------------------
@@ -67,119 +65,6 @@ FinalizeConstruction(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* MixinClassDelegates --
*
* Internal utility for setting up the class delegate.
* Runs after the class has called [oo::define] on its argument.
*
* ----------------------------------------------------------------------
*/
// Look up the delegate for a class.
static inline Class *
GetClassDelegate(
Tcl_Interp *interp,
Class *clsPtr)
{
Tcl_Obj *delegateName = Tcl_ObjPrintf("%s:: oo ::delegate",
clsPtr->thisPtr->namespacePtr->fullName);
Class *delegatePtr = TclOOGetClassFromObj(interp, delegateName);
Tcl_DecrRefCount(delegateName);
return delegatePtr;
}
/*
* Patches in the appropriate class delegates' superclasses.
* Sonewhat messy because the list of superclasses isn't modified frequently.
*/
static inline void
SetDelegateSuperclasses(
Tcl_Interp *interp,
Class *clsPtr,
Class *delegatePtr)
{
// Build new list of superclasses
int i, j = delegatePtr->superclasses.num, k;
Class *superPtr, **supers = (Class **) Tcl_Alloc(sizeof(Class *) *
(delegatePtr->superclasses.num + clsPtr->superclasses.num));
if (delegatePtr->superclasses.num) {
memcpy(supers, delegatePtr->superclasses.list,
sizeof(Class *) * delegatePtr->superclasses.num);
}
FOREACH(superPtr, clsPtr->superclasses) {
Class *superDelegatePtr = GetClassDelegate(interp, superPtr);
if (!superDelegatePtr) {
continue;
}
for (k=0 ; k<=j ; k++) {
if (k == j) {
supers[j++] = superDelegatePtr;
TclOOAddToSubclasses(delegatePtr, superDelegatePtr);
AddRef(superDelegatePtr->thisPtr);
break;
} else if (supers[k] == superDelegatePtr) {
break;
}
}
}
// Install new list of superclasses;
if (delegatePtr->superclasses.num) {
Tcl_Free(delegatePtr->superclasses.list);
}
delegatePtr->superclasses.list = supers;
delegatePtr->superclasses.num = j;
// Definitely don't need to bump any epoch here
}
/*
* Mixes the delegate into its controlling class.
*/
static inline void
InstallDelegateAsMixin(
Tcl_Interp *interp,
Class *clsPtr,
Class *delegatePtr)
{
if (clsPtr->thisPtr->mixins.num == 0) {
TclOOObjectSetMixins(clsPtr->thisPtr, 1, &delegatePtr);
return;
}
Class **mixins = (Class **) TclStackAlloc(interp,
sizeof(Class *) * (clsPtr->thisPtr->mixins.num + 1));
for (int i = 0; i < clsPtr->thisPtr->mixins.num; i++) {
mixins[i] = clsPtr->thisPtr->mixins.list[i];
if (mixins[i] == delegatePtr) {
TclStackFree(interp, (void *) mixins);
return;
}
}
mixins[clsPtr->thisPtr->mixins.num] = delegatePtr;
TclOOObjectSetMixins(clsPtr->thisPtr, clsPtr->thisPtr->mixins.num + 1, mixins);
TclStackFree(interp, mixins);
}
// Patches in the appropriate class delegates.
static void
MixinClassDelegates(
Tcl_Interp *interp,
Object *oPtr,
Tcl_Obj *delegateName)
{
Class *clsPtr = oPtr->classPtr;
if (clsPtr) {
Class *delegatePtr = TclOOGetClassFromObj(interp, delegateName);
if (delegatePtr) {
SetDelegateSuperclasses(interp, clsPtr, delegatePtr);
InstallDelegateAsMixin(interp, clsPtr, delegatePtr);
}
}
}
/*
* ----------------------------------------------------------------------
*
@@ -199,6 +84,7 @@ TclOO_Class_Constructor(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Obj **invoke, *nameObj;
size_t skip = Tcl_ObjectContextSkippedArgs(context);
if ((size_t) objc > skip + 1) {
@@ -215,28 +101,25 @@ TclOO_Class_Constructor(
* argument to [oo::define]. [Bug 680503]
*/
Tcl_Obj *delegateName = Tcl_ObjPrintf("%s:: oo ::delegate",
nameObj = Tcl_ObjPrintf("%s:: oo ::delegate",
oPtr->namespacePtr->fullName);
Tcl_IncrRefCount(delegateName);
Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
TclGetString(delegateName), NULL, TCL_INDEX_NONE, NULL, 0);
TclGetString(nameObj), NULL, TCL_INDEX_NONE, NULL, 0);
Tcl_BounceRefCount(nameObj);
/*
* If there's nothing else to do, we're done.
*/
if ((size_t) objc == skip) {
Tcl_InterpState saved = Tcl_SaveInterpState(interp, TCL_OK);
MixinClassDelegates(interp, oPtr, delegateName);
Tcl_DecrRefCount(delegateName);
return Tcl_RestoreInterpState(interp, saved);
return TCL_OK;
}
/*
* Delegate to [oo::define] to do the work.
*/
Tcl_Obj **invoke = (Tcl_Obj **) TclStackAlloc(interp, 3 * sizeof(Tcl_Obj *));
invoke = (Tcl_Obj **) TclStackAlloc(interp, 3 * sizeof(Tcl_Obj *));
invoke[0] = oPtr->fPtr->defineName;
invoke[1] = TclOOObjectName(interp, oPtr);
invoke[2] = objv[objc - 1];
@@ -249,8 +132,8 @@ TclOO_Class_Constructor(
Tcl_IncrRefCount(invoke[0]);
Tcl_IncrRefCount(invoke[1]);
Tcl_IncrRefCount(invoke[2]);
TclNRAddCallback(interp, PostClassConstructor,
invoke, oPtr, delegateName, NULL);
TclNRAddCallback(interp, DecrRefsPostClassConstructor,
invoke, oPtr, NULL, NULL);
/*
* Tricky point: do not want the extra reported level in the Tcl stack
@@ -260,28 +143,33 @@ TclOO_Class_Constructor(
return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}
/*
* Called *after* [oo::define] inside the constructor of a class.
* Cleans up some temporary storage and sets up the delegate.
*/
static int
PostClassConstructor(
DecrRefsPostClassConstructor(
void *data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj **invoke = (Tcl_Obj **) data[0];
Object *oPtr = (Object *) data[1];
Tcl_Obj *delegateName = (Tcl_Obj *) data[2];
Tcl_InterpState saved;
int code;
TclDecrRefCount(invoke[0]);
TclDecrRefCount(invoke[1]);
TclDecrRefCount(invoke[2]);
invoke[0] = oPtr->fPtr->mcdName;
invoke[1] = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(invoke[0]);
Tcl_IncrRefCount(invoke[1]);
saved = Tcl_SaveInterpState(interp, result);
code = Tcl_EvalObjv(interp, 2, invoke, 0);
TclDecrRefCount(invoke[0]);
TclDecrRefCount(invoke[1]);
TclStackFree(interp, invoke);
Tcl_InterpState saved = Tcl_SaveInterpState(interp, result);
MixinClassDelegates(interp, oPtr, delegateName);
Tcl_DecrRefCount(delegateName);
if (code != TCL_OK) {
Tcl_DiscardInterpState(saved);
return code;
}
return Tcl_RestoreInterpState(interp, saved);
}
@@ -467,176 +355,6 @@ TclOO_Class_New(
AddConstructionFinalizer(interp));
}
/*
* ----------------------------------------------------------------------
*
* TclOO_Class_Cloned --
*
* Handler for cloning classes, which fixes up the delegates. This allows
* the clone's class methods to evolve independently of the origin's
* class methods; this is how TclOO works by default.
*
* ----------------------------------------------------------------------
*/
int
TclOO_Class_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Object targetObject = Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip >= objc) {
Tcl_WrongNumArgs(interp, skip, objv, "originObject");
return TCL_ERROR;
}
Tcl_Object originObject = Tcl_GetObjectFromObj(interp, objv[skip]);
if (!originObject) {
return TCL_ERROR;
}
// Add references so things won't vanish until after
// UpdateClassDelegatesAfterClone is finished with them.
AddRef((Object *) originObject);
AddRef((Object *) targetObject);
TclNRAddCallback(interp, UpdateClassDelegatesAfterClone,
originObject, targetObject, NULL, NULL);
return TclNRObjectContextInvokeNext(interp, context, objc, objv, skip);
}
// Rebuilds the class inheritance delegation class.
static int
UpdateClassDelegatesAfterClone(
void *data[],
Tcl_Interp *interp,
int result)
{
Object *originPtr = (Object *) data[0];
Object *targetPtr = (Object *) data[1];
if (result == TCL_OK && originPtr->classPtr && targetPtr->classPtr) {
// Get the originating delegate to be cloned.
Tcl_Obj *originName = Tcl_ObjPrintf("%s:: oo ::delegate",
originPtr->namespacePtr->fullName);
Object *originDelegate = (Object *) Tcl_GetObjectFromObj(interp,
originName);
Tcl_BounceRefCount(originName);
// Delegates never have their own delegates, so silently make sure we
// don't try to make a clone of them.
if (!(originDelegate && originDelegate->classPtr)) {
goto noOriginDelegate;
}
// Create the cloned target delegate.
Tcl_Obj *targetName = Tcl_ObjPrintf("%s:: oo ::delegate",
targetPtr->namespacePtr->fullName);
Object *targetDelegate = (Object *) Tcl_CopyObjectInstance(interp,
(Tcl_Object) originDelegate, Tcl_GetString(targetName), NULL);
Tcl_BounceRefCount(targetName);
if (targetDelegate == NULL) {
result = TCL_ERROR;
goto noOriginDelegate;
}
// Point the cloned target class at the cloned target delegate.
// This is like TclOOObjectSetMixins() but more efficient in this
// case as there's definitely no relevant call chains to invalidate
// and we're doing a one-for-one replacement.
Tcl_Size i;
Class *mixin;
FOREACH(mixin, targetPtr->mixins) {
if (mixin == originDelegate->classPtr) {
TclOORemoveFromInstances(targetPtr, originDelegate->classPtr);
TclOODecrRefCount(originDelegate);
targetPtr->mixins.list[i] = targetDelegate->classPtr;
TclOOAddToInstances(targetPtr, targetDelegate->classPtr);
AddRef(targetDelegate);
break;
}
}
}
noOriginDelegate:
TclOODecrRefCount(originPtr);
TclOODecrRefCount(targetPtr);
return result;
};
/*
* ----------------------------------------------------------------------
*
* TclOO_Configurable_Constructor --
*
* Implementation for oo::configurable constructor.
*
* ----------------------------------------------------------------------
*/
int
TclOO_Configurable_Constructor(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
int objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (objc != skip && objc != skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "?definitionScript?");
return TCL_ERROR;
}
Tcl_Obj *cfgSupportName = Tcl_NewStringObj(
"::oo::configuresupport::configurable", TCL_AUTO_LENGTH);
Class *mixin = TclOOGetClassFromObj(interp, cfgSupportName);
Tcl_BounceRefCount(cfgSupportName);
if (!mixin) {
return TCL_ERROR;
}
TclOOClassSetMixins(interp, oPtr->classPtr, 1, &mixin);
return TclNRObjectContextInvokeNext(interp, context, objc, objv, skip);
}
/*
* ----------------------------------------------------------------------
*
* TclOO_Object_Cloned --
*
* Handler for cloning objects that clones basic bits (only!) of the
* object's namespace. Non-procedures, traces, sub-namespaces, etc. need
* more complex (and class-specific) handling.
*
* ----------------------------------------------------------------------
*/
int
TclOO_Object_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, // Interpreter for error reporting.
Tcl_ObjectContext context, // The object/call context.
int objc, // Number of arguments.
Tcl_Obj *const *objv) // The actual arguments.
{
int skip = Tcl_ObjectContextSkippedArgs(context);
if (objc != skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "originObject");
return TCL_ERROR;
}
Object *targetObject = (Object *) Tcl_ObjectContextObject(context);
Object *originObject = (Object *) Tcl_GetObjectFromObj(interp, objv[skip]);
if (!originObject) {
return TCL_ERROR;
}
Namespace *originNs = (Namespace *) originObject->namespacePtr;
Namespace *targetNs = (Namespace *) targetObject->namespacePtr;
if (TclCopyNamespaceProcedures(interp, originNs, targetNs) != TCL_OK) {
return TCL_ERROR;
}
return TclCopyNamespaceVariables(interp, originNs, targetNs);
}
/*
* ----------------------------------------------------------------------
*
@@ -683,9 +401,6 @@ TclOO_Object_Destroy(
return TCL_OK;
}
/* Post-NRE-callback for TclOO_Object_Destroy. Deletes the object command if
* it's still there, which triggers destruction of the namespace and attached
* structures. */
static int
AfterNRDestructor(
void *data[],
@@ -773,7 +488,6 @@ TclOO_Object_Eval(
return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
}
/* Post-NRE-callback for TclOO_Object_Eval. Cleans up. */
static int
FinalizeEval(
void *data[],
@@ -1187,98 +901,6 @@ TclOO_Object_VarName(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOOLinkObjCmd --
*
* Implementation of the [link] command, that makes a command that
* invokes a method on the current object. The name of the command and
* the name of the method match by default. Note that this command is
* only ever to be used inside the body of a procedure-like method,
* and is typically intended for constructors.
*
* ----------------------------------------------------------------------
*/
int
TclOOLinkObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
// Set up common bits.
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}
CallContext *context = (CallContext *) framePtr->clientData;
Object *oPtr = context->oPtr;
if (!oPtr->myCommand) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot link to non-existent callback handle"));
OO_ERROR(interp, MY_GONE);
return TCL_ERROR;
}
Tcl_Obj *myCmd = Tcl_NewObj();
Tcl_GetCommandFullName(interp, oPtr->myCommand, myCmd);
if (!oPtr->linkedCmdsList) {
oPtr->linkedCmdsList = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(oPtr->linkedCmdsList);
}
// For each argument
for (int i=1; i<objc; i++) {
Tcl_Size linkc;
Tcl_Obj **linkv, *src, *dst;
// Parse as list of (one or) two items: source and destination names
if (TclListObjGetElements(interp, objv[i], &linkc, &linkv) != TCL_OK) {
Tcl_BounceRefCount(myCmd);
return TCL_ERROR;
}
switch (linkc) {
case 1:
// Degenerate case
src = dst = linkv[0];
break;
case 2:
src = linkv[0];
dst = linkv[1];
break;
default:
Tcl_BounceRefCount(myCmd);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad link description; must only have one or two elements"));
OO_ERROR(interp, CMDLINK_FORMAT);
return TCL_ERROR;
}
// Qualify the source if necessary
const char *srcStr = TclGetString(src);
if (srcStr[0] != ':' || srcStr[1] != ':') {
src = Tcl_ObjPrintf("%s::%s",
context->oPtr->namespacePtr->fullName, srcStr);
}
// Make the alias command
if (TclAliasCreate(interp, interp, interp, src, myCmd, 1, &dst) != TCL_OK) {
Tcl_BounceRefCount(myCmd);
Tcl_BounceRefCount(src);
return TCL_ERROR;
}
// Remember the alias for cleanup if necessary
Tcl_ListObjAppendElement(NULL, oPtr->linkedCmdsList, src);
}
Tcl_BounceRefCount(myCmd);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
@@ -1336,6 +958,11 @@ TclOONextToObjCmd(
{
Interp *iPtr = (Interp *) interp;
CallFrame *framePtr = iPtr->varFramePtr;
Class *classPtr;
CallContext *contextPtr;
Tcl_Size i;
Tcl_Object object;
const char *methodType;
/*
* Start with sanity checks on the calling context to make sure that we
@@ -1350,7 +977,7 @@ TclOONextToObjCmd(
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}
CallContext *contextPtr = (CallContext *) framePtr->clientData;
contextPtr = (CallContext *) framePtr->clientData;
/*
* Sanity check the arguments; we need the first one to refer to a class.
@@ -1360,8 +987,15 @@ TclOONextToObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?");
return TCL_ERROR;
}
Class *classPtr = TclOOGetClassFromObj(interp, objv[1]);
object = Tcl_GetObjectFromObj(interp, objv[1]);
if (object == NULL) {
return TCL_ERROR;
}
classPtr = ((Object *) object)->classPtr;
if (classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[1])));
OO_ERROR(interp, CLASS_REQUIRED);
return TCL_ERROR;
}
@@ -1371,7 +1005,6 @@ TclOONextToObjCmd(
* allow jumping backwards!
*/
Tcl_Size i;
for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
MInvoke *miPtr = &contextPtr->callPtr->chain[i];
@@ -1395,7 +1028,14 @@ TclOONextToObjCmd(
* is on the chain but unreachable, or not on the chain at all.
*/
const char *methodType = TclOOContextTypeName(contextPtr);
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
methodType = "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
methodType = "destructor";
} else {
methodType = "method";
}
for (i=contextPtr->index ; i != TCL_INDEX_NONE ; i--) {
MInvoke *miPtr = &contextPtr->callPtr->chain[i];
@@ -1414,7 +1054,6 @@ TclOONextToObjCmd(
return TCL_ERROR;
}
/* Post-NRE-callback for [next] and [nextto]. */
static int
NextRestoreFrame(
void *data[],
@@ -1568,7 +1207,13 @@ TclOOSelfObjCmd(
} else if (mPtr->declaringObjectPtr != NULL) {
declarerPtr = mPtr->declaringObjectPtr;
} else {
TCL_UNREACHABLE();
/*
* This should be unreachable code.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method without declarer!", TCL_AUTO_LENGTH));
return TCL_ERROR;
}
result[0] = TclOOObjectName(interp, declarerPtr);
@@ -1594,7 +1239,13 @@ TclOOSelfObjCmd(
} else if (mPtr->declaringObjectPtr != NULL) {
declarerPtr = mPtr->declaringObjectPtr;
} else {
TCL_UNREACHABLE();
/*
* This should be unreachable code.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method without declarer!", TCL_AUTO_LENGTH));
return TCL_ERROR;
}
result[0] = TclOOObjectName(interp, declarerPtr);
@@ -1633,7 +1284,13 @@ TclOOSelfObjCmd(
} else if (mPtr->declaringObjectPtr != NULL) {
declarerPtr = mPtr->declaringObjectPtr;
} else {
TCL_UNREACHABLE();
/*
* This should be unreachable code.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method without declarer!", TCL_AUTO_LENGTH));
return TCL_ERROR;
}
result[0] = TclOOObjectName(interp, declarerPtr);
result[1] = mPtr->namePtr;
@@ -1645,9 +1302,8 @@ TclOOSelfObjCmd(
TclNewIndexObj(result[1], contextPtr->index);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
default:
TCL_UNREACHABLE();
}
return TCL_ERROR;
}
/*
@@ -1733,294 +1389,6 @@ TclOOCopyObjectCmd(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOOCallbackObjCmd --
*
* Implementation of the [callback] command, which constructs callbacks
* into the current object.
*
* ----------------------------------------------------------------------
*/
int
TclOOCallbackObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
CallFrame *framePtr = iPtr->varFramePtr;
/*
* Start with sanity checks on the calling context to make sure that we
* are invoked from a suitable method context. If so, we can safely
* retrieve the handle to the object call context.
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}
CallContext *contextPtr = (CallContext *) framePtr->clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "method ...");
return TCL_ERROR;
}
// Get the [my] real name.
Tcl_Obj *namePtr = TclOOObjectMyName(interp, contextPtr->oPtr);
if (!namePtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"no possible safe callback without my", TCL_AUTO_LENGTH));
OO_ERROR(interp, NO_MY);
return TCL_ERROR;
}
// No check that the method exists; could be dynamically added.
Tcl_Obj *listPtr = Tcl_NewListObj(1, &namePtr);
(void) TclListObjAppendElements(NULL, listPtr, objc-1, objv+1);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOOClassVariableObjCmd --
*
* Implementation of the [classvariable] command, which links to
* variables in the class of the current object.
*
* ----------------------------------------------------------------------
*/
int
TclOOClassVariableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
CallFrame *framePtr = iPtr->varFramePtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ...");
return TCL_ERROR;
}
/*
* Start with sanity checks on the calling context to make sure that we
* are invoked from a suitable method context. If so, we can safely
* retrieve the handle to the object call context.
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}
// Get a reference to the class's namespace
CallContext *contextPtr = (CallContext *) framePtr->clientData;
Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;
if (clsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method not defined by a class", TCL_AUTO_LENGTH));
OO_ERROR(interp, UNMATCHED_CONTEXT);
return TCL_ERROR;
}
Tcl_Namespace *clsNsPtr = clsPtr->thisPtr->namespacePtr;
// Check the list of variable names
for (int i = 1; i < objc; i++) {
const char *varName = TclGetString(objv[i]);
if (Tcl_StringMatch(varName, "*(*)")) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad variable name \"%s\": can't create a %s",
varName, "scalar variable that looks like an array element"));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
return TCL_ERROR;
}
if (Tcl_StringMatch(varName, "*::*")) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad variable name \"%s\": can't create a %s",
varName, "local variable with a namespace separator in it"));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
return TCL_ERROR;
}
}
// Lastly, link the caller's local variables to the class's variables
Tcl_Namespace *ourNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
for (int i = 1; i < objc; i++) {
// Locate the other variable.
iPtr->varFramePtr->nsPtr = (Namespace *) clsNsPtr;
Var *arrayPtr, *otherPtr = TclObjLookupVarEx(interp, objv[i], NULL,
(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
"access", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
iPtr->varFramePtr->nsPtr = (Namespace *) ourNsPtr;
if (otherPtr == NULL) {
return TCL_ERROR;
}
// Create the new variable and link it to otherPtr.
if (TclPtrObjMakeUpvarIdx(interp, otherPtr, objv[i], 0,
TCL_INDEX_NONE) != TCL_OK) {
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOODelegateNameObjCmd --
*
* Implementation of the [oo::DelegateName] command, which is a utility
* that gets the name of the class delegate for a class. It's trivial,
* but makes working with them much easier as delegate names are
* intentionally hard to create by accident.
*
* Not part of TclOO public API. No public documentation.
*
* ----------------------------------------------------------------------
*/
int
TclOODelegateNameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "class");
return TCL_ERROR;
}
Class *clsPtr = TclOOGetClassFromObj(interp, objv[1]);
if (clsPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s:: oo ::delegate",
clsPtr->thisPtr->namespacePtr->fullName));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOO_Singleton_New, MarkAsSingleton --
*
* Implementation for oo::singleton->new method.
*
* ----------------------------------------------------------------------
*/
int
TclOO_Singleton_New(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Class *clsPtr = oPtr->classPtr;
if (clsPtr->instances.num) {
Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->instances.list[0]));
return TCL_OK;
}
TclNRAddCallback(interp, MarkAsSingleton, clsPtr, NULL, NULL, NULL);
return TclNRNewObjectInstance(interp, (Tcl_Class) clsPtr,
NULL, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context),
AddConstructionFinalizer(interp));
}
/* Once the singleton object is made, this mixes in a class to disable easy
* deleting of the instance. */
static int
MarkAsSingleton(
void *data[],
Tcl_Interp *interp,
int result)
{
Class *clsPtr = (Class *) data[0];
if (result == TCL_OK && clsPtr->instances.num) {
// Prepend oo::SingletonInstance to the list of mixins
Tcl_Obj *singletonInstanceName = Tcl_NewStringObj(
"::oo::SingletonInstance", TCL_AUTO_LENGTH);
Class *singInst = TclOOGetClassFromObj(interp, singletonInstanceName);
Tcl_BounceRefCount(singletonInstanceName);
if (!singInst) {
return TCL_ERROR;
}
Object *oPtr = clsPtr->instances.list[0];
Tcl_Size mixinc = oPtr->mixins.num;
Class **mixins = (Class **)TclStackAlloc(interp,
sizeof(Class *) * (mixinc + 1));
if (mixinc > 0) {
memcpy(mixins + 1, oPtr->mixins.list, mixinc * sizeof(Class *));
}
mixins[0] = singInst;
TclOOObjectSetMixins(oPtr, mixinc + 1, mixins);
TclStackFree(interp, mixins);
}
return result;
}
/*
* ----------------------------------------------------------------------
*
* TclOO_SingletonInstance_Destroy, TclOO_SingletonInstance_Cloned --
*
* Implementation for oo::SingletonInstance->destroy method and its
* cloning callback method.
*
* ----------------------------------------------------------------------
*/
int
TclOO_SingletonInstance_Destroy(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for error reporting. */
TCL_UNUSED(Tcl_ObjectContext),
TCL_UNUSED(int),
TCL_UNUSED(Tcl_Obj *const *))
{
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"may not destroy a singleton object"));
OO_ERROR(interp, SINGLETON);
return TCL_ERROR;
}
int
TclOO_SingletonInstance_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
TCL_UNUSED(Tcl_ObjectContext),
TCL_UNUSED(int),
TCL_UNUSED(Tcl_Obj *const *))
{
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"may not clone a singleton object"));
OO_ERROR(interp, SINGLETON);
return TCL_ERROR;
}
/*
* Local Variables:
* mode: c
+9 -31
View File
@@ -427,29 +427,6 @@ FinalizeMethodRefs(
return result;
}
/*
* ----------------------------------------------------------------------
*
* TclOOContextTypeName --
*
* Get the name of the (high-level) type of method that a context is
* processing. Used for error message generation.
*
* ----------------------------------------------------------------------
*/
const char *
TclOOContextTypeName(
CallContext *contextPtr)
{
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
return "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
return "destructor";
} else {
return "method";
}
}
/*
* ----------------------------------------------------------------------
*
@@ -460,7 +437,7 @@ TclOOContextTypeName(
* ----------------------------------------------------------------------
*/
Tcl_Size
int
TclOOGetSortedMethodList(
Object *oPtr, /* The object to get the method names for. */
Object *contextObj, /* From what context object we are inquiring.
@@ -799,7 +776,9 @@ AddPrivateMethodNames(
FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
if (IS_PRIVATE(mPtr)) {
hPtr = Tcl_CreateHashEntry(namesPtr, namePtr, NULL);
int isNew;
hPtr = Tcl_CreateHashEntry(namesPtr, namePtr, &isNew);
Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
}
}
@@ -825,7 +804,7 @@ AddStandardMethodName(
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
&& mPtr->typePtr != NULL) {
Tcl_Size isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
isWanted &= ~NO_IMPLEMENTATION;
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
@@ -1575,13 +1554,14 @@ TclOOGetStereotypeCallChain(
}
} else {
if (hPtr == NULL) {
int isNew;
if (clsPtr->classChainCache == NULL) {
clsPtr->classChainCache = (Tcl_HashTable *)
Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(clsPtr->classChainCache);
}
hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
methodNameObj, NULL);
methodNameObj, &isNew);
}
callPtr->refCount++;
Tcl_SetHashValue(hPtr, callPtr);
@@ -1667,7 +1647,6 @@ AddClassFiltersToCallContext(
AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
flags);
}
TCL_FALLTHROUGH();
case 0:
return;
}
@@ -1755,7 +1734,7 @@ AddPrivatesFromClassChainToCallContext(
return 1;
}
}
TCL_FALLTHROUGH();
/* FALLTHRU */
case 0:
return 0;
}
@@ -1850,7 +1829,7 @@ AddSimpleClassChainToCallContext(
privateDanger |= AddSimpleClassChainToCallContext(superPtr,
methodNameObj, cbPtr, doneFilters, flags, filterDecl);
}
TCL_FALLTHROUGH();
/* FALLTHRU */
case 0:
return privateDanger;
}
@@ -2088,7 +2067,6 @@ AddSimpleClassDefineNamespaces(
FOREACH(superPtr, classPtr->superclasses) {
AddSimpleClassDefineNamespaces(superPtr, definePtr, flags);
}
TCL_FALLTHROUGH();
case 0:
return;
}

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