Compare commits
213
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ffa8d1d461 | ||
|
|
eff08da703 | ||
|
|
807ed7b13c | ||
|
|
3ef704b39c | ||
|
|
346721f3f0 | ||
|
|
b3e4fc2a04 | ||
|
|
a22953bb77 | ||
|
|
20664f1fa1 | ||
|
|
33955d6933 | ||
|
|
4404292972 | ||
|
|
82ffc550db | ||
|
|
3c53be5e75 | ||
|
|
f163c24b4c | ||
|
|
076a7e2839 | ||
|
|
9efaa4d7f1 | ||
|
|
dc84eca339 | ||
|
|
f15717bcda | ||
|
|
ff316586bc | ||
|
|
109828f090 | ||
|
|
37d6f90099 | ||
|
|
b0654427ca | ||
|
|
34d3750e3c | ||
|
|
1c788e178d | ||
|
|
cac264cd19 | ||
|
|
c41f605368 | ||
|
|
fb10e693b2 | ||
|
|
fd9662ee1c | ||
|
|
7f986a59bf | ||
|
|
ad823f4eb1 | ||
|
|
40c3ec35ee | ||
|
|
0b669eacf8 | ||
|
|
71b64b8e1c | ||
|
|
546165585c | ||
|
|
59a788a6c4 | ||
|
|
f3ae2684eb | ||
|
|
3fc1392c92 | ||
|
|
81e7623b78 | ||
|
|
579cd0b138 | ||
|
|
208927f009 | ||
|
|
e250b6f551 | ||
|
|
4a3369807b | ||
|
|
5039e7ce17 | ||
|
|
5c9a145403 | ||
|
|
e53cbf77bf | ||
|
|
a9405cc253 | ||
|
|
1f4f47ccf5 | ||
|
|
accd2800ec | ||
|
|
2b01204e41 | ||
|
|
43e27f10a5 | ||
|
|
38b30033c8 | ||
|
|
f6bf85fb67 | ||
|
|
866a79313b | ||
|
|
636e4d4826 | ||
|
|
e6b8f92493 | ||
|
|
67f864dc65 | ||
|
|
00a4f18c38 | ||
|
|
8f0b94f037 | ||
|
|
9d34b872ce | ||
|
|
e4fcd7152b | ||
|
|
3ee0402bd5 | ||
|
|
9e43cbb973 | ||
|
|
7a56ff406f | ||
|
|
107d130ce3 | ||
|
|
e42885732a | ||
|
|
1a94f57ab6 | ||
|
|
ac45c8d851 | ||
|
|
e14285c3a1 | ||
|
|
76e4a71917 | ||
|
|
23520a7648 | ||
|
|
1dc3124160 | ||
|
|
52f93c85fd | ||
|
|
fa3cf75311 | ||
|
|
262b6297ea | ||
|
|
f0ec68f072 | ||
|
|
6e44927248 | ||
|
|
7f62b76887 | ||
|
|
0715d88019 | ||
|
|
2592b1e93b | ||
|
|
f4d0f6366c | ||
|
|
60fde1d90f | ||
|
|
a7f1b76ad2 | ||
|
|
66dd14a480 | ||
|
|
f2963d15d0 | ||
|
|
a4abf50c23 | ||
|
|
d85664964a | ||
|
|
264c84606b | ||
|
|
724de352e3 | ||
|
|
6b0b7154f1 | ||
|
|
6c69cf8504 | ||
|
|
30fd8c842c | ||
|
|
213447740b | ||
|
|
5bb0947953 | ||
|
|
01b6b4918f | ||
|
|
db4a945f2e | ||
|
|
e3707dae62 | ||
|
|
643301e722 | ||
|
|
30c146de54 | ||
|
|
be42098b82 | ||
|
|
6149b214e8 | ||
|
|
4af0efa4cb | ||
|
|
953e3ea899 | ||
|
|
3b1ca15e07 | ||
|
|
c1d3ca8bae | ||
|
|
ffe530a1b2 | ||
|
|
df56e0e1df | ||
|
|
43d2fdc86c | ||
|
|
1d040a5bae | ||
|
|
82df9bf8f8 | ||
|
|
0d23451993 | ||
|
|
171bea3624 | ||
|
|
06a30a3a2a | ||
|
|
120f367646 | ||
|
|
5f4ef0229d | ||
|
|
b2d5b24a70 | ||
|
|
dc1ca56b6a | ||
|
|
d753cbc088 | ||
|
|
749efa7f84 | ||
|
|
1971f6ab14 | ||
|
|
591c90cd3e | ||
|
|
40b259956c | ||
|
|
6560454489 | ||
|
|
270c9b99d6 | ||
|
|
e1968256d8 | ||
|
|
840355939d | ||
|
|
52549ae747 | ||
|
|
cc21b0be2a | ||
|
|
330e4967ab | ||
|
|
39db46fbe1 | ||
|
|
998409ea9b | ||
|
|
dddf36c195 | ||
|
|
4b9763f5f7 | ||
|
|
c07c2bb91c | ||
|
|
30710a3cbd | ||
|
|
d73c6dbd81 | ||
|
|
36d06e1e0b | ||
|
|
e29e808f57 | ||
|
|
6c0be70d2b | ||
|
|
9d14ed87d0 | ||
|
|
f397a9ac9d | ||
|
|
3cd49200d7 | ||
|
|
fd3f2b486c | ||
|
|
4f513496d8 | ||
|
|
823d13656d | ||
|
|
5ed72038da | ||
|
|
1cadacd498 | ||
|
|
4b765a3aff | ||
|
|
bb9b5e7606 | ||
|
|
f460900f9f | ||
|
|
9557127009 | ||
|
|
a2db4b22d0 | ||
|
|
35d0992797 | ||
|
|
0f06b1b667 | ||
|
|
d40f0fe1b3 | ||
|
|
ca51d20173 | ||
|
|
c1c4367262 | ||
|
|
493182df76 | ||
|
|
34aa927a14 | ||
|
|
e14cd07627 | ||
|
|
7c4cabaaae | ||
|
|
c92e694158 | ||
|
|
0d231a3919 | ||
|
|
0e59966ac5 | ||
|
|
7f6ef9991b | ||
|
|
7fba80338f | ||
|
|
720183a9af | ||
|
|
14cfbc651c | ||
|
|
55bf49d15f | ||
|
|
5016da417f | ||
|
|
f472165a3d | ||
|
|
cab7f268d6 | ||
|
|
204434e4d4 | ||
|
|
e6a9f22409 | ||
|
|
99d517e3cb | ||
|
|
a03c2cb1c2 | ||
|
|
bbe2ea1d0e | ||
|
|
a15ea81906 | ||
|
|
f48f2735de | ||
|
|
a541a7be4c | ||
|
|
d12eb85c8f | ||
|
|
201d01f9da | ||
|
|
4bca76be3b | ||
|
|
6310c709d3 | ||
|
|
690f2c2839 | ||
|
|
a300508fee | ||
|
|
2a52ff28dd | ||
|
|
651f71edfd | ||
|
|
56e784cb1b | ||
|
|
9598926f42 | ||
|
|
711c236648 | ||
|
|
3cb9dde39e | ||
|
|
565b9dca95 | ||
|
|
8bd505ac83 | ||
|
|
634e9464b5 | ||
|
|
79214905a2 | ||
|
|
69fdd85b74 | ||
|
|
c14dbae8ad | ||
|
|
4e07591402 | ||
|
|
ea2a934216 | ||
|
|
a26b107bd3 | ||
|
|
26cf086c2c | ||
|
|
7169e0abe0 | ||
|
|
6d32ec4c20 | ||
|
|
4c326aa381 | ||
|
|
12ba446acb | ||
|
|
f0a97b5c71 | ||
|
|
cca23e5286 | ||
|
|
af4b36c13d | ||
|
|
9c9af976ae | ||
|
|
c256107a5c | ||
|
|
2c1750c78f | ||
|
|
0d59960edf | ||
|
|
7f5a85dcea | ||
|
|
932835c1eb |
@@ -1,9 +1,12 @@
|
||||
compat/zlib/win32/zdll.lib
|
||||
compat/zlib/win32/zlib1.dll
|
||||
compat/zlib/win64/zdll.lib
|
||||
compat/zlib/win64/zlib1.dll
|
||||
compat/zlib/win64/libz.dll.a
|
||||
compat/zlib/zlib.3.pdf
|
||||
*.a
|
||||
*.bmp
|
||||
*.dll
|
||||
*.exe
|
||||
*.gif
|
||||
*.png
|
||||
*.gz
|
||||
*.jpg
|
||||
*.lib
|
||||
*.pdf
|
||||
*.png
|
||||
*.xlsx
|
||||
*.zip
|
||||
|
||||
@@ -32,7 +32,7 @@ libtommath/pretty.build
|
||||
libtommath/tommath.src
|
||||
libtommath/*.log
|
||||
libtommath/*.pdf
|
||||
libtommath/gen.pl
|
||||
libtommath/*.pl
|
||||
libtommath/*.sh
|
||||
libtommath/doc/*
|
||||
libtommath/tombc/*
|
||||
@@ -64,4 +64,5 @@ win/*.manifest
|
||||
win/pkgs/*
|
||||
win/coffbase.txt
|
||||
win/tcl.hpj
|
||||
win/nmakehlp.out
|
||||
win/nmhlp-out.txt
|
||||
|
||||
@@ -27,6 +27,7 @@
|
||||
|
||||
# Denote all files that are truly binary and should not be modified.
|
||||
*.a binary
|
||||
*.bmp binary
|
||||
*.dll binary
|
||||
*.exe binary
|
||||
*.gif binary
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
name: Linux Build and Test
|
||||
on: [push]
|
||||
jobs:
|
||||
gcc:
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
matrix:
|
||||
symbols:
|
||||
- "no"
|
||||
- "mem"
|
||||
- "all"
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: unix
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Configure (symbols=${{ matrix.symbols }})
|
||||
run: |
|
||||
mkdir "${HOME}/install dir"
|
||||
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-symbols=${{ matrix.symbols }}
|
||||
- name: Prepare
|
||||
run: touch tclStubInit.c tclOOStubInit.c
|
||||
working-directory: generic
|
||||
- name: Build
|
||||
run: |
|
||||
make all
|
||||
- name: Build Test Harness
|
||||
run: |
|
||||
make tcltest
|
||||
- name: Run Tests
|
||||
run: |
|
||||
make test
|
||||
- name: Test-Drive Installation
|
||||
run: |
|
||||
make install
|
||||
- name: Create Distribution Package
|
||||
run: |
|
||||
make dist
|
||||
- name: Convert Documentation to HTML
|
||||
run: |
|
||||
make html-tcl
|
||||
@@ -0,0 +1,61 @@
|
||||
name: macOS Build and Test
|
||||
on: [push]
|
||||
jobs:
|
||||
with-Xcode:
|
||||
runs-on: macos-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: macosx
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Prepare
|
||||
run: touch tclStubInit.c tclOOStubInit.c
|
||||
working-directory: generic
|
||||
- name: Build
|
||||
run: make all
|
||||
- name: Run Tests
|
||||
run: make test styles=develop
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
Unix-like:
|
||||
runs-on: macos-latest
|
||||
strategy:
|
||||
matrix:
|
||||
symbols:
|
||||
- "no"
|
||||
- "mem"
|
||||
dtrace:
|
||||
- "no"
|
||||
- "yes"
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: unix
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c
|
||||
mkdir "$HOME/install dir"
|
||||
working-directory: generic
|
||||
- name: Configure (symbols=${{ matrix.symbols }} dtrace=${{ matrix.dtrace }})
|
||||
# Note that macOS is always a 64 bit platform
|
||||
run: ./configure --enable-64bit ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-symbols=${{ matrix.symbols }} --enable-dtrace=${{ matrix.dtrace }}
|
||||
- name: Build
|
||||
run: |
|
||||
make all tcltest
|
||||
- name: Run Tests
|
||||
run: |
|
||||
make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
- name: Trial Installation
|
||||
run: |
|
||||
make install
|
||||
@@ -0,0 +1,71 @@
|
||||
name: Windows Build and Test
|
||||
on: [push]
|
||||
jobs:
|
||||
MSVC:
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: powershell
|
||||
working-directory: win
|
||||
# Using powershell means we need to explicitly stop on failure
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Init MSVC
|
||||
uses: ilammy/msvc-dev-cmd@v1
|
||||
- name: Build
|
||||
run: |
|
||||
&nmake -f makefile.vc all
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
- name: Build Test Harness
|
||||
run: |
|
||||
&nmake -f makefile.vc tcltest
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
- name: Run Tests
|
||||
run: |
|
||||
&nmake -f makefile.vc test
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MSYS-gcc:
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: win
|
||||
strategy:
|
||||
matrix:
|
||||
symbols:
|
||||
- "no"
|
||||
- "mem"
|
||||
- "all"
|
||||
# Using powershell means we need to explicitly stop on failure
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Install MSYS2 and Make
|
||||
run: choco install msys2 make
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c
|
||||
mkdir "${HOME}/install dir"
|
||||
working-directory: generic
|
||||
- name: Configure (symbols=${{ matrix.symbols }})
|
||||
run: |
|
||||
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-64bit --enable-symbols=${{ matrix.symbols }}
|
||||
- name: Build
|
||||
run: make all
|
||||
- name: Build Test Harness
|
||||
run: make tcltest
|
||||
- name: Run Tests
|
||||
run: make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
+54
-49
@@ -1,7 +1,8 @@
|
||||
sudo: false
|
||||
language: c
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- binutils-mingw-w64-i686
|
||||
- binutils-mingw-w64-x86-64
|
||||
@@ -10,77 +11,59 @@ addons:
|
||||
- gcc-mingw-w64-i686
|
||||
- gcc-mingw-w64-x86-64
|
||||
- gcc-multilib
|
||||
homebrew:
|
||||
packages:
|
||||
- libtommath
|
||||
update: true
|
||||
matrix:
|
||||
jobs:
|
||||
include:
|
||||
# Testing on Linux with various compilers
|
||||
# Testing on Linux GCC
|
||||
- name: "Linux/GCC/Shared"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/GCC/Shared: UTF_MAX=4"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT=CFLAGS=-DTCL_UTF_MAX=4
|
||||
- name: "Linux/GCC/Shared: UTF_MAX=6"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT=CFLAGS=-DTCL_UTF_MAX=6
|
||||
- name: "Linux/GCC/Static"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- CFGOPT="--disable-shared"
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/GCC/Debug"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="--enable-symbols"
|
||||
- name: "Linux/GCC/Mem-Debug"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="--enable-symbols=mem"
|
||||
# Older versions of GCC...
|
||||
- name: "Linux/GCC 7/Shared"
|
||||
# Newer/Older versions of GCC
|
||||
- name: "Linux/GCC 10/Shared"
|
||||
os: linux
|
||||
dist: bionic
|
||||
compiler: gcc-7
|
||||
dist: focal
|
||||
compiler: gcc-10
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-7
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/GCC 6/Shared"
|
||||
os: linux
|
||||
dist: bionic
|
||||
compiler: gcc-6
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-6
|
||||
- g++-10
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/GCC 5/Shared"
|
||||
@@ -89,44 +72,42 @@ matrix:
|
||||
compiler: gcc-5
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-5
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
# Clang
|
||||
# Testing on Linux Clang
|
||||
- name: "Linux/Clang/Shared"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: clang
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/Clang/Static"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: clang
|
||||
env:
|
||||
- CFGOPT="--disable-shared"
|
||||
- BUILD_DIR=unix
|
||||
- name: "Linux/Clang/Debug"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: clang
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="--enable-symbols"
|
||||
- name: "Linux/Clang/Mem-Debug"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: clang
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="--enable-symbols=mem"
|
||||
# Testing on Mac, various styles
|
||||
- name: "macOS/Xcode 11.5/Shared"
|
||||
- name: "macOS/Xcode 12/Shared"
|
||||
os: osx
|
||||
osx_image: xcode11.5
|
||||
osx_image: xcode12.2
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
install: []
|
||||
@@ -134,15 +115,24 @@ matrix:
|
||||
- make all
|
||||
# The styles=develop avoids some weird problems on OSX
|
||||
- make test styles=develop
|
||||
- name: "macOS/Xcode 11.5/Shared/Unix-like"
|
||||
- name: "macOS/Xcode 12/Shared/Unix-like"
|
||||
os: osx
|
||||
osx_image: xcode11.5
|
||||
osx_image: xcode12.2
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT="--enable-dtrace"
|
||||
# Newer MacOS versions
|
||||
- name: "macOS/Xcode 12/Universal Apps/Shared"
|
||||
os: osx
|
||||
osx_image: xcode12u
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
install: []
|
||||
script: *mactest
|
||||
# Older MacOS versions
|
||||
- name: "macOS/Xcode 11/Shared"
|
||||
os: osx
|
||||
osx_image: xcode11
|
||||
osx_image: xcode11.7
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
install: []
|
||||
@@ -156,7 +146,7 @@ matrix:
|
||||
script: *mactest
|
||||
- name: "macOS/Xcode 9/Shared"
|
||||
os: osx
|
||||
osx_image: xcode9.2
|
||||
osx_image: xcode9.4
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
install: []
|
||||
@@ -172,7 +162,7 @@ matrix:
|
||||
# Doesn't run tests because wine is only an imperfect Windows emulation
|
||||
- name: "Linux-cross-Windows/GCC/Shared/no test"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: x86_64-w64-mingw32-gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
@@ -186,7 +176,7 @@ matrix:
|
||||
# Doesn't run tests because wine is only an imperfect Windows emulation
|
||||
- name: "Linux-cross-Windows-32/GCC/Shared/no test"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: i686-w64-mingw32-gcc
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
@@ -200,6 +190,8 @@ matrix:
|
||||
- BUILD_DIR=win
|
||||
- VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build"
|
||||
before_install: &vcpreinst
|
||||
- rm -rf tests/safe-stock8*.test
|
||||
- touch generic/tclStubInit.c generic/tclOOStubInit.c
|
||||
- PATH="$PATH:$VCDIR"
|
||||
- cd ${BUILD_DIR}
|
||||
install: []
|
||||
@@ -224,6 +216,15 @@ matrix:
|
||||
script:
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
|
||||
- name: "Windows/MSVC/StaticPackage"
|
||||
os: windows
|
||||
compiler: cl
|
||||
env: *vcenv
|
||||
before_install: *vcpreinst
|
||||
install: []
|
||||
script:
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test
|
||||
- name: "Windows/MSVC/Debug"
|
||||
os: windows
|
||||
compiler: cl
|
||||
@@ -296,6 +297,8 @@ matrix:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="--enable-64bit"
|
||||
before_install: &makepreinst
|
||||
- rm -rf tests/safe-stock8*.test
|
||||
- touch generic/tclStubInit.c generic/tclOOStubInit.c
|
||||
- choco install -y make
|
||||
- cd ${BUILD_DIR}
|
||||
- name: "Windows/GCC/Shared: UTF_MAX=4"
|
||||
@@ -364,13 +367,15 @@ matrix:
|
||||
# "make dist" only
|
||||
- name: "Linux: make dist"
|
||||
os: linux
|
||||
dist: bionic
|
||||
dist: focal
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
script:
|
||||
- make dist
|
||||
before_install:
|
||||
- rm -rf tests/safe-stock8*.test
|
||||
- touch generic/tclStubInit.c generic/tclOOStubInit.c
|
||||
- cd ${BUILD_DIR}
|
||||
install:
|
||||
- mkdir "$HOME/install dir"
|
||||
@@ -378,6 +383,6 @@ install:
|
||||
before_script:
|
||||
- export ERROR_ON_FAILURES=1
|
||||
script:
|
||||
- make all tcltest
|
||||
- make all tcltest || echo "Something wrong, maybe a hickup, let's try again"
|
||||
- make test
|
||||
- make install
|
||||
|
||||
+2
-2
@@ -351,7 +351,7 @@
|
||||
|
||||
* mac/tclMacFile.c: fixed bug in permission checking code
|
||||
|
||||
* mac/tclMacLoad.c: corrected utf8 handling, comparison of package
|
||||
* mac/tclMacLoad.c: corrected utf-8 handling, comparison of package
|
||||
names to code fragment names changed to only match on the length of
|
||||
package name, this allows for fragment names with version numbers
|
||||
appended.
|
||||
@@ -3525,7 +3525,7 @@
|
||||
* generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to avoid
|
||||
a read off the end of the argument array that could occur when
|
||||
executing something like [unset -nocomplain] was executed. Improved
|
||||
the error message given when too few arguments are given (-nocomplain
|
||||
the error message given when not enough arguments are given (-nocomplain
|
||||
should obviously be *before* --, not after it) and also modified the
|
||||
test suite to take account of that and the documentation to use the
|
||||
same improvement. [Bug 405769]
|
||||
|
||||
+1
-1
@@ -1753,7 +1753,7 @@
|
||||
|
||||
2002-07-05 Reinhard Max <max@suse.de>
|
||||
|
||||
* generic/tclClock.c (FormatClock): Convert the format string to UTF8
|
||||
* generic/tclClock.c (FormatClock): Convert the format string to utf-8
|
||||
before calling TclpStrftime, so that non-ASCII characters don't get
|
||||
mangled when the result string is being converted back.
|
||||
* tests/clock.test: Added a test for that.
|
||||
|
||||
+2
-2
@@ -2302,7 +2302,7 @@
|
||||
934511].
|
||||
|
||||
* doc/CrtCommand.3: Added note that the arguments given to the command
|
||||
proc of a Tcl_CreateCommand are in utf8 since Tcl 8.1. Closing [Patch
|
||||
proc of a Tcl_CreateCommand are in utf-8 since Tcl 8.1. Closing [Patch
|
||||
414778].
|
||||
|
||||
* doc/ChnlStack.3: Removed the declaration that the interp argument to
|
||||
@@ -2873,7 +2873,7 @@
|
||||
2004-06-02 Jeff Hobbs <jeffh@ActiveState.com>
|
||||
|
||||
* win/tclWinFile.c (TclpFindExecutable): when using GetModuleFileNameA
|
||||
(Win9x), convert from CP_ACP to WCHAR then convert back to utf8.
|
||||
(Win9x), convert from CP_ACP to WCHAR then convert back to utf-8.
|
||||
Adjunct to 2004-04-07 fix.
|
||||
|
||||
2004-06-02 David Gravereaux <davygrvy@pobox.com>
|
||||
|
||||
@@ -5,7 +5,20 @@ This is the **Tcl 8.6.10** source distribution.
|
||||
You can get any source release of Tcl from [our distribution
|
||||
site](https://sourceforge.net/projects/tcl/files/Tcl/).
|
||||
|
||||
[](https://travis-ci.org/tcltk/tcl)
|
||||
8.6.10
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-6-branch)
|
||||
<br>
|
||||
8.7a4
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-branch)
|
||||
<br>
|
||||
9.0a2
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Amain)
|
||||
|
||||
## Contents
|
||||
1. [Introduction](#intro)
|
||||
|
||||
+1
-1
@@ -36,7 +36,7 @@ mkstemp(
|
||||
{
|
||||
static const char alphanumerics[] =
|
||||
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
|
||||
register char *a, *b;
|
||||
char *a, *b;
|
||||
int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */
|
||||
|
||||
a = template + strlen(template);
|
||||
|
||||
+57
-30
@@ -8,7 +8,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
|
||||
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_CreateSlave, Tcl_GetChild, Tcl_GetSlave, Tcl_GetParent, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -19,32 +19,47 @@ int
|
||||
int
|
||||
\fBTcl_MakeSafe\fR(\fIinterp\fR)
|
||||
.sp
|
||||
.VS "TIP 581"
|
||||
Tcl_Interp *
|
||||
\fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR)
|
||||
.VE "TIP 581"
|
||||
.sp
|
||||
Tcl_Interp *
|
||||
\fBTcl_CreateSlave\fR(\fIinterp, name, isSafe\fR)
|
||||
.sp
|
||||
.VS "TIP 581"
|
||||
Tcl_Interp *
|
||||
\fBTcl_GetChild\fR(\fIinterp, name\fR)
|
||||
.VE "TIP 581"
|
||||
.sp
|
||||
Tcl_Interp *
|
||||
\fBTcl_GetSlave\fR(\fIinterp, name\fR)
|
||||
.sp
|
||||
.VS "TIP 581"
|
||||
Tcl_Interp *
|
||||
\fBTcl_GetParent\fR(\fIinterp\fR)
|
||||
.VE "TIP 581"
|
||||
.sp
|
||||
Tcl_Interp *
|
||||
\fBTcl_GetMaster\fR(\fIinterp\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GetInterpPath\fR(\finterp, slaveInterp\fR)
|
||||
\fBTcl_GetInterpPath\fR(\fIinterp, childInterp\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
|
||||
\fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
|
||||
argc, argv\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_CreateAliasObj\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
|
||||
\fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
|
||||
objc, objv\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GetAlias\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
|
||||
\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
|
||||
argcPtr, argvPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GetAliasObj\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
|
||||
\fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
|
||||
objcPtr, objvPtr\fR)
|
||||
.sp
|
||||
int
|
||||
@@ -57,16 +72,16 @@ int
|
||||
.AP Tcl_Interp *interp in
|
||||
Interpreter in which to execute the specified command.
|
||||
.AP "const char" *name in
|
||||
Name of slave interpreter to create or manipulate.
|
||||
Name of child interpreter to create or manipulate.
|
||||
.AP int isSafe in
|
||||
If non-zero, a
|
||||
.QW safe
|
||||
slave that is suitable for running untrusted code
|
||||
is created, otherwise a trusted slave is created.
|
||||
.AP Tcl_Interp *slaveInterp in
|
||||
child that is suitable for running untrusted code
|
||||
is created, otherwise a trusted child is created.
|
||||
.AP Tcl_Interp *childInterp in
|
||||
Interpreter to use for creating the source command for an alias (see
|
||||
below).
|
||||
.AP "const char" *slaveCmd in
|
||||
.AP "const char" *childCmd in
|
||||
Name of source command for alias.
|
||||
.AP Tcl_Interp *targetInterp in
|
||||
Interpreter that contains the target command for an alias.
|
||||
@@ -121,17 +136,21 @@ interpreter. The return value for those procedures that return an \fBint\fR
|
||||
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
|
||||
then the interpreter's result contains an error message.
|
||||
.PP
|
||||
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
|
||||
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
|
||||
allows \fIinterp\fR to manipulate the new slave.
|
||||
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
|
||||
\fBTcl_CreateSlave\fR creates a new interpreter as a child of \fIinterp\fR.
|
||||
It also creates a child command named \fIchildName\fR in \fIinterp\fR which
|
||||
allows \fIinterp\fR to manipulate the new child.
|
||||
If \fIisSafe\fR is zero, the command creates a trusted child in which Tcl
|
||||
code has access to all the Tcl commands.
|
||||
If it is \fB1\fR, the command creates a
|
||||
.QW safe
|
||||
slave in which Tcl code has access only to set of Tcl commands defined as
|
||||
child in which Tcl code has access only to set of Tcl commands defined as
|
||||
.QW "Safe Tcl" ;
|
||||
see the manual entry for the Tcl \fBinterp\fR command for details.
|
||||
If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
|
||||
If the creation of the new child interpreter failed, \fBNULL\fR is returned.
|
||||
.PP
|
||||
.VS "TIP 581"
|
||||
\fBTcl_CreateChild\fR is a synonym for \fBTcl_CreateSlave\fR.
|
||||
.VE "TIP 581"
|
||||
.PP
|
||||
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
|
||||
.QW safe
|
||||
@@ -150,31 +169,39 @@ Callers will want to take care with their use of \fBTcl_MakeSafe\fR
|
||||
to avoid false claims of safety. For many situations, \fBTcl_CreateSlave\fR
|
||||
may be a better choice, since it creates interpreters in a known-safe state.
|
||||
.PP
|
||||
\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of
|
||||
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
|
||||
If no such slave interpreter exists, \fBNULL\fR is returned.
|
||||
\fBTcl_GetSlave\fR returns a pointer to a child interpreter of
|
||||
\fIinterp\fR. The child interpreter is identified by \fIchildName\fR.
|
||||
If no such child interpreter exists, \fBNULL\fR is returned.
|
||||
.PP
|
||||
.VS "TIP 581"
|
||||
\fBTcl_GetChild\fR is a synonym for \fBTcl_GetSlave\fR.
|
||||
.VE "TIP 581"
|
||||
.PP
|
||||
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
|
||||
\fIinterp\fR. If \fIinterp\fR has no master (it is a
|
||||
top-level interpreter) then \fBNULL\fR is returned.
|
||||
.PP
|
||||
\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
|
||||
the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
|
||||
\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
|
||||
.VS "TIP 581"
|
||||
\fBTcl_GetParent\fR is a synonym for \fBTcl_GetMaster\fR.
|
||||
.VE "TIP 581"
|
||||
.PP
|
||||
\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
|
||||
the relative path between \fIinterp\fR and \fIchildInterp\fR;
|
||||
\fIchildInterp\fR must be a child of \fIinterp\fR. If the computation
|
||||
of the relative path succeeds, \fBTCL_OK\fR is returned, else
|
||||
\fBTCL_ERROR\fR is returned and an error message is stored as the
|
||||
result of \fIaskingInterp\fR.
|
||||
result of \fIinterp\fR.
|
||||
.PP
|
||||
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
|
||||
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
|
||||
\fBTcl_CreateAlias\fR creates a command named \fIchildCmd\fR in
|
||||
\fIchildInterp\fR that when invoked, will cause the command \fItargetCmd\fR
|
||||
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
|
||||
contained in \fIargv\fR are always prepended to any arguments supplied in the
|
||||
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
|
||||
invocation of \fIchildCmd\fR and passed to \fItargetCmd\fR.
|
||||
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
|
||||
it fails; in that case, an error message is left in the value result
|
||||
of \fIslaveInterp\fR.
|
||||
of \fIchildInterp\fR.
|
||||
Note that there are no restrictions on the ancestry relationship (as
|
||||
created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
|
||||
created by \fBTcl_CreateSlave\fR) between \fIchildInterp\fR and
|
||||
\fItargetInterp\fR. Any two interpreters can be used, without any
|
||||
restrictions on how they are related.
|
||||
.PP
|
||||
@@ -233,4 +260,4 @@ interp
|
||||
|
||||
.SH KEYWORDS
|
||||
alias, command, exposed commands, hidden commands, interpreter, invoke,
|
||||
master, slave
|
||||
parent, child
|
||||
|
||||
+2
-2
@@ -1350,11 +1350,11 @@ is considered to be owned by the filesystem (not by Tcl's core), but
|
||||
should be given a reference count for Tcl. Tcl will use the contents of the
|
||||
list and then decrement that reference count. This allows filesystems to
|
||||
choose whether they actually want to retain a
|
||||
.QW "master list"
|
||||
.QW "global list"
|
||||
of volumes
|
||||
or not (if not, they generate the list on the fly and pass it to Tcl
|
||||
with a reference count of 1 and then forget about the list, if yes, then
|
||||
they simply increment the reference count of their master list and pass it
|
||||
they simply increment the reference count of their global list and pass it
|
||||
to Tcl which will copy the contents and then decrement the count back
|
||||
to where it was).
|
||||
.PP
|
||||
|
||||
+1
-1
@@ -116,7 +116,7 @@ execution of the callbacks is unspecified) execution in the limited
|
||||
interpreter is stopped by raising an error and setting a flag that
|
||||
prevents the \fBcatch\fR command in that interpreter from trapping
|
||||
that error. It is up to the context that started execution in that
|
||||
interpreter (typically a master interpreter) to handle the error.
|
||||
interpreter (typically the main interpreter) to handle the error.
|
||||
.SH "LIMIT CHECKING API"
|
||||
.PP
|
||||
To check the resource limits for an interpreter, call
|
||||
|
||||
+6
-6
@@ -79,7 +79,7 @@ against the standard Tcl library. Extensions (stub-enabled or
|
||||
not) are not intended to call \fBTcl_Main\fR.
|
||||
.PP
|
||||
\fBTcl_Main\fR is not thread-safe. It should only be called by
|
||||
a single master thread of a multi-threaded application. This
|
||||
a single main thread of a multi-threaded application. This
|
||||
restriction is not a problem with normal use described above.
|
||||
.PP
|
||||
\fBTcl_Main\fR and therefore all applications based upon it, like
|
||||
@@ -112,7 +112,7 @@ The file name and encoding values managed by the routines
|
||||
\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
|
||||
are stored per-thread. Although the storage and retrieval
|
||||
functions of these routines work in any thread, only those
|
||||
calls in the same master thread as \fBTcl_Main\fR can have
|
||||
calls in the same main thread as \fBTcl_Main\fR can have
|
||||
any influence on it.
|
||||
.PP
|
||||
The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR
|
||||
@@ -126,7 +126,7 @@ a \fIstartup script\fR, and \fIname\fR is taken to be the name
|
||||
of the encoding of the contents of that file. \fBTcl_Main\fR
|
||||
then calls \fBTcl_SetStartupScript\fR with these values.
|
||||
.PP
|
||||
\fBTcl_Main\fR then defines in its master interpreter
|
||||
\fBTcl_Main\fR then defines in its main interpreter
|
||||
the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
|
||||
\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
|
||||
.PP
|
||||
@@ -154,9 +154,9 @@ When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls
|
||||
been requested, if any. If a startup script has been provided,
|
||||
\fBTcl_Main\fR attempts to evaluate it. Otherwise, interactive
|
||||
mode begins with examination of the variable \fItcl_rcFileName\fR
|
||||
in the master interpreter. If that variable exists and holds the
|
||||
in the main interpreter. If that variable exists and holds the
|
||||
name of a readable file, the contents of that file are evaluated
|
||||
in the master interpreter. Then interactive operations begin,
|
||||
in the main interpreter. Then interactive operations begin,
|
||||
with prompts and command evaluation results written to the standard
|
||||
output channel, and commands read from the standard input channel
|
||||
and then evaluated. The prompts written to the standard output
|
||||
@@ -164,7 +164,7 @@ channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
|
||||
and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
|
||||
The prompts and command evaluation results are written to the standard
|
||||
output channel only if the Tcl variable \fItcl_interactive\fR in the
|
||||
master interpreter holds a non-zero integer value.
|
||||
main interpreter holds a non-zero integer value.
|
||||
.PP
|
||||
\fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
|
||||
This allows, for example, Tk to be dynamically loaded and set its event
|
||||
|
||||
+6
-6
@@ -472,36 +472,36 @@ The following format groups are recognized by the \fBclock scan\fR and
|
||||
\fBclock format\fR commands.
|
||||
.TP
|
||||
\fB%a\fR
|
||||
On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
|
||||
On output, produces an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
|
||||
of the week in the given locale. On input, matches the name of the day
|
||||
of the week in the given locale (in either abbreviated or full form, or
|
||||
any unique prefix of either form).
|
||||
.TP
|
||||
\fB%A\fR
|
||||
On output, receives the full name (\fIe.g.,\fR \fBMonday\fR) of the day
|
||||
On output, produces the full name (\fIe.g.,\fR \fBMonday\fR) of the day
|
||||
of the week in the given locale. On input, matches the name of the day
|
||||
of the week in the given locale (in either abbreviated or full form, or
|
||||
any unique prefix of either form).
|
||||
.TP
|
||||
\fB%b\fR
|
||||
On output, receives an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
|
||||
On output, produces an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
|
||||
of the month in the given locale. On input, matches the name of the month
|
||||
in the given locale (in either abbreviated or full form, or
|
||||
any unique prefix of either form).
|
||||
.TP
|
||||
\fB%B\fR
|
||||
On output, receives the full name (\fIe.g.,\fR \fBJanuary\fR)
|
||||
On output, produces the full name (\fIe.g.,\fR \fBJanuary\fR)
|
||||
of the month in the given locale. On input, matches the name of the month
|
||||
in the given locale (in either abbreviated or full form, or
|
||||
any unique prefix of either form).
|
||||
.TP
|
||||
\fB%c\fR
|
||||
On output, receives a localized representation of date and time of day;
|
||||
On output, produces a localized representation of date and time of day;
|
||||
the localized representation is expected to use the Gregorian calendar.
|
||||
On input, matches whatever \fB%c\fR produces.
|
||||
.TP
|
||||
\fB%C\fR
|
||||
On output, receives the number of the century in Indo-Arabic numerals.
|
||||
On output, produces the number of the century in Indo-Arabic numerals.
|
||||
On input, matches one or two digits, possibly with leading whitespace,
|
||||
that are expected to be the number of the century.
|
||||
.TP
|
||||
|
||||
+5
-4
@@ -107,9 +107,9 @@ will produce the value on the right side of the line:
|
||||
.PP
|
||||
.CS
|
||||
.ta 9c
|
||||
\fBexpr\fR 3.1 + $a \fI6.1\fR
|
||||
\fBexpr\fR 2 + "$a.$b" \fI5.6\fR
|
||||
\fBexpr\fR 4*[llength "6 2"] \fI8\fR
|
||||
\fBexpr\fR {3.1 + $a} \fI6.1\fR
|
||||
\fBexpr\fR {2 + "$a.$b"} \fI5.6\fR
|
||||
\fBexpr\fR {4*[llength "6 2"]} \fI8\fR
|
||||
\fBexpr\fR {{word one} < "word $a"} \fI0\fR
|
||||
.CE
|
||||
.SS OPERATORS
|
||||
@@ -246,7 +246,7 @@ just as in C, which means that operands are not evaluated if they are
|
||||
not needed to determine the outcome. For example, in the command
|
||||
.PP
|
||||
.CS
|
||||
\fBexpr\fR {$v ? [a] : [b]}
|
||||
\fBexpr\fR {$v?[a]:[b]}
|
||||
.CE
|
||||
.PP
|
||||
only one of
|
||||
@@ -496,4 +496,5 @@ Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
|
||||
.fi
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" fill-column: 78
|
||||
'\" End:
|
||||
|
||||
@@ -250,6 +250,10 @@ proc httpHandlerCallback {socket token} {
|
||||
return $nbytes
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
The \fBhttp::geturl\fR code for the \fB-handler\fR option is not compatible with either compression or chunked transfer-encoding. If \fB-handler\fR is specified, then to work around these issues \fBhttp::geturl\fR will reduce the HTTP protocol to 1.0, and override the \fB-zip\fR option (i.e. it will not send the header "\fBAccept-Encoding: gzip,deflate,compress\fR").
|
||||
.PP
|
||||
If options \fB-handler\fR and \fB-channel\fR are used together, the handler is responsible for copying the data from the HTTP socket to the specified channel. The name of the channel is available to the handler as element \fB-channel\fR of the token array.
|
||||
.RE
|
||||
.TP
|
||||
\fB\-headers\fR \fIkeyvaluelist\fR
|
||||
|
||||
+127
-121
@@ -19,18 +19,18 @@ interp \- Create and manipulate Tcl interpreters
|
||||
.PP
|
||||
This command makes it possible to create one or more new Tcl
|
||||
interpreters that co-exist with the creating interpreter in the
|
||||
same application. The creating interpreter is called the \fImaster\fR
|
||||
and the new interpreter is called a \fIslave\fR.
|
||||
A master can create any number of slaves, and each slave can
|
||||
itself create additional slaves for which it is master, resulting
|
||||
same application. The creating interpreter is called the \fIparent\fR
|
||||
and the new interpreter is called a \fIchild\fR.
|
||||
A parent can create any number of children, and each child can
|
||||
itself create additional children for which it is parent, resulting
|
||||
in a hierarchy of interpreters.
|
||||
.PP
|
||||
Each interpreter is independent from the others: it has its own name
|
||||
space for commands, procedures, and global variables.
|
||||
A master interpreter may create connections between its slaves and
|
||||
A parent interpreter may create connections between its children and
|
||||
itself using a mechanism called an \fIalias\fR. An \fIalias\fR is
|
||||
a command in a slave interpreter which, when invoked, causes a
|
||||
command to be invoked in its master interpreter or in another slave
|
||||
a command in a child interpreter which, when invoked, causes a
|
||||
command to be invoked in its parent interpreter or in another child
|
||||
interpreter. The only other connections between interpreters are
|
||||
through environment variables (the \fBenv\fR variable), which are
|
||||
normally shared among all interpreters in the application,
|
||||
@@ -41,7 +41,7 @@ share files and to transfer references to open files from one interpreter
|
||||
to another.
|
||||
.PP
|
||||
The \fBinterp\fR command also provides support for \fIsafe\fR
|
||||
interpreters. A safe interpreter is a slave whose functions have
|
||||
interpreters. A safe interpreter is a child whose functions have
|
||||
been greatly restricted, so that it is safe to execute untrusted
|
||||
scripts without fear of them damaging other interpreters or the
|
||||
application's environment. For example, all IO channel creation
|
||||
@@ -54,18 +54,18 @@ instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
|
||||
access to it. For a detailed explanation of hidden commands, see
|
||||
\fBHIDDEN COMMANDS\fR, below.
|
||||
The alias mechanism can be used for protected communication (analogous to a
|
||||
kernel call) between a slave interpreter and its master.
|
||||
kernel call) between a child interpreter and its parent.
|
||||
See \fBALIAS INVOCATION\fR, below, for more details
|
||||
on how the alias mechanism works.
|
||||
.PP
|
||||
A qualified interpreter name is a proper Tcl lists containing a subset of its
|
||||
A qualified interpreter name is a proper Tcl list containing a subset of its
|
||||
ancestors in the interpreter hierarchy, terminated by the string naming the
|
||||
interpreter in its immediate master. Interpreter names are relative to the
|
||||
interpreter in its immediate parent. Interpreter names are relative to the
|
||||
interpreter in which they are used. For example, if
|
||||
.QW \fBa\fR
|
||||
is a slave of the current interpreter and it has a slave
|
||||
is a child of the current interpreter and it has a child
|
||||
.QW \fBa1\fR ,
|
||||
which in turn has a slave
|
||||
which in turn has a child
|
||||
.QW \fBa11\fR ,
|
||||
the qualified name of
|
||||
.QW \fBa11\fR
|
||||
@@ -77,14 +77,14 @@ is the list
|
||||
The \fBinterp\fR command, described below, accepts qualified interpreter
|
||||
names as arguments; the interpreter in which the command is being evaluated
|
||||
can always be referred to as \fB{}\fR (the empty list or string). Note that
|
||||
it is impossible to refer to a master (ancestor) interpreter by name in a
|
||||
slave interpreter except through aliases. Also, there is no global name by
|
||||
it is impossible to refer to a parent (ancestor) interpreter by name in a
|
||||
child interpreter except through aliases. Also, there is no global name by
|
||||
which one can refer to the first interpreter created in an application.
|
||||
Both restrictions are motivated by safety concerns.
|
||||
.SH "THE INTERP COMMAND"
|
||||
.PP
|
||||
The \fBinterp\fR command is used to create, delete, and manipulate
|
||||
slave interpreters, and to share or transfer
|
||||
child interpreters, and to share or transfer
|
||||
channels between interpreters. It can have any of several forms, depending
|
||||
on the \fIsubcommand\fR argument:
|
||||
.TP
|
||||
@@ -94,11 +94,11 @@ Returns a Tcl list whose elements are the \fItargetCmd\fR and
|
||||
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
|
||||
(this is the value returned when the alias was
|
||||
created; it is possible that the name of the source command in the
|
||||
slave is different from \fIsrcToken\fR).
|
||||
child is different from \fIsrcToken\fR).
|
||||
.TP
|
||||
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR
|
||||
.
|
||||
Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by
|
||||
Deletes the alias for \fIsrcToken\fR in the child interpreter identified by
|
||||
\fIsrcPath\fR.
|
||||
\fIsrcToken\fR refers to the value returned when the alias
|
||||
was created; if the source command has been renamed, the renamed
|
||||
@@ -106,9 +106,9 @@ command will be deleted.
|
||||
.TP
|
||||
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
|
||||
.
|
||||
This command creates an alias between one slave and another (see the
|
||||
\fBalias\fR slave command below for creating aliases between a slave
|
||||
and its master). In this command, either of the slave interpreters
|
||||
This command creates an alias between one child and another (see the
|
||||
\fBalias\fR child command below for creating aliases between a child
|
||||
and its parent). In this command, either of the child interpreters
|
||||
may be anywhere in the hierarchy of interpreters under the interpreter
|
||||
invoking the command.
|
||||
\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
|
||||
@@ -117,9 +117,9 @@ interpreter. For example,
|
||||
.QW "\fBa b\fR"
|
||||
identifies an interpreter
|
||||
.QW \fBb\fR ,
|
||||
which is a slave of interpreter
|
||||
which is a child of interpreter
|
||||
.QW \fBa\fR ,
|
||||
which is a slave of the invoking interpreter. An empty list specifies
|
||||
which is a child of the invoking interpreter. An empty list specifies
|
||||
the interpreter invoking the command. \fIsrcCmd\fR gives the name of
|
||||
a new command, which will be created in the source interpreter.
|
||||
\fITargetPath\fR and \fItargetCmd\fR specify a target interpreter
|
||||
@@ -171,33 +171,33 @@ used.
|
||||
.TP
|
||||
\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
|
||||
.
|
||||
Creates a slave interpreter identified by \fIpath\fR and a new command,
|
||||
called a \fIslave command\fR. The name of the slave command is the last
|
||||
component of \fIpath\fR. The new slave interpreter and the slave command
|
||||
Creates a child interpreter identified by \fIpath\fR and a new command,
|
||||
called a \fIchild command\fR. The name of the child command is the last
|
||||
component of \fIpath\fR. The new child interpreter and the child command
|
||||
are created in the interpreter identified by the path obtained by removing
|
||||
the last component from \fIpath\fR. For example, if \fIpath\fR is \fBa b
|
||||
c\fR then a new slave interpreter and slave command named \fBc\fR are
|
||||
c\fR then a new child interpreter and child command named \fBc\fR are
|
||||
created in the interpreter identified by the path \fBa b\fR.
|
||||
The slave command may be used to manipulate the new interpreter as
|
||||
The child command may be used to manipulate the new interpreter as
|
||||
described below. If \fIpath\fR is omitted, Tcl creates a unique name of the
|
||||
form \fBinterp\fIx\fR, where \fIx\fR is an integer, and uses it for the
|
||||
interpreter and the slave command. If the \fB\-safe\fR switch is specified
|
||||
(or if the master interpreter is a safe interpreter), the new slave
|
||||
interpreter and the child command. If the \fB\-safe\fR switch is specified
|
||||
(or if the parent interpreter is a safe interpreter), the new child
|
||||
interpreter will be created as a safe interpreter with limited
|
||||
functionality; otherwise the slave will include the full set of Tcl
|
||||
functionality; otherwise the child will include the full set of Tcl
|
||||
built-in commands and variables. The \fB\-\|\-\fR switch can be used to
|
||||
mark the end of switches; it may be needed if \fIpath\fR is an unusual
|
||||
value such as \fB\-safe\fR. The result of the command is the name of the
|
||||
new interpreter. The name of a slave interpreter must be unique among all
|
||||
the slaves for its master; an error occurs if a slave interpreter by the
|
||||
given name already exists in this master.
|
||||
The initial recursion limit of the slave interpreter is set to the
|
||||
new interpreter. The name of a child interpreter must be unique among all
|
||||
the children for its parent; an error occurs if a child interpreter by the
|
||||
given name already exists in this parent.
|
||||
The initial recursion limit of the child interpreter is set to the
|
||||
current recursion limit of its parent interpreter.
|
||||
.TP
|
||||
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
|
||||
.
|
||||
Controls whether frame-level stack information is captured in the
|
||||
slave interpreter identified by \fIpath\fR. If no arguments are
|
||||
child interpreter identified by \fIpath\fR. If no arguments are
|
||||
given, option and current setting are returned. If \fB\-frame\fR
|
||||
is given, the debug setting is set to the given boolean if provided
|
||||
and the current setting is returned.
|
||||
@@ -239,8 +239,8 @@ consistency of the underlying interpreter's state.
|
||||
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
|
||||
.
|
||||
Deletes zero or more interpreters given by the optional \fIpath\fR
|
||||
arguments, and for each interpreter, it also deletes its slaves. The
|
||||
command also deletes the slave command for each interpreter deleted.
|
||||
arguments, and for each interpreter, it also deletes its children. The
|
||||
command also deletes the child command for each interpreter deleted.
|
||||
For each \fIpath\fR argument, if no interpreter by that name
|
||||
exists, the command raises an error.
|
||||
.TP
|
||||
@@ -248,20 +248,20 @@ exists, the command raises an error.
|
||||
.
|
||||
This command concatenates all of the \fIarg\fR arguments in the same
|
||||
fashion as the \fBconcat\fR command, then evaluates the resulting string as
|
||||
a Tcl script in the slave interpreter identified by \fIpath\fR. The result
|
||||
a Tcl script in the child interpreter identified by \fIpath\fR. The result
|
||||
of this evaluation (including all \fBreturn\fR options,
|
||||
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
|
||||
error occurs) is returned to the invoking interpreter.
|
||||
Note that the script will be executed in the current context stack frame of the
|
||||
\fIpath\fR interpreter; this is so that the implementations (in a master
|
||||
interpreter) of aliases in a slave interpreter can execute scripts in
|
||||
the slave that find out information about the slave's current state
|
||||
\fIpath\fR interpreter; this is so that the implementations (in a parent
|
||||
interpreter) of aliases in a child interpreter can execute scripts in
|
||||
the child that find out information about the child's current state
|
||||
and stack frame.
|
||||
.TP
|
||||
\fBinterp exists \fIpath\fR
|
||||
.
|
||||
Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
|
||||
exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
|
||||
Returns \fB1\fR if a child interpreter by the specified \fIpath\fR
|
||||
exists in this parent, \fB0\fR otherwise. If \fIpath\fR is omitted, the
|
||||
invoking interpreter is used.
|
||||
.TP
|
||||
\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
|
||||
@@ -287,7 +287,7 @@ Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
|
||||
not contain namespace qualifiers, or an error is raised.
|
||||
Commands to be hidden by \fBinterp hide\fR are looked up in the global
|
||||
namespace even if the current namespace is not the global one. This
|
||||
prevents slaves from fooling a master interpreter into hiding the wrong
|
||||
prevents children from fooling a parent interpreter into hiding the wrong
|
||||
command, by making the current namespace be different from the global one.
|
||||
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
|
||||
.TP
|
||||
@@ -373,9 +373,15 @@ interpreter is destroyed.
|
||||
.TP
|
||||
\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
|
||||
.
|
||||
Returns a Tcl list of the names of all the slave interpreters associated
|
||||
Returns a Tcl list of the names of all the child interpreters associated
|
||||
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
|
||||
the invoking interpreter is used.
|
||||
.VS "TIP 581"
|
||||
.TP
|
||||
\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
|
||||
.
|
||||
Synonym for . \fBinterp\fR \fBslaves\fR ?\fIpath\fR?
|
||||
.VE "TIP 581"
|
||||
.TP
|
||||
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
|
||||
.
|
||||
@@ -393,48 +399,48 @@ The target command does not have to be defined at the time of this invocation.
|
||||
Causes the IO channel identified by \fIchannelId\fR to become available in
|
||||
the interpreter identified by \fIdestPath\fR and unavailable in the
|
||||
interpreter identified by \fIsrcPath\fR.
|
||||
.SH "SLAVE COMMAND"
|
||||
.SH "child COMMAND"
|
||||
.PP
|
||||
For each slave interpreter created with the \fBinterp\fR command, a
|
||||
new Tcl command is created in the master interpreter with the same
|
||||
For each child interpreter created with the \fBinterp\fR command, a
|
||||
new Tcl command is created in the parent interpreter with the same
|
||||
name as the new interpreter. This command may be used to invoke
|
||||
various operations on the interpreter. It has the following
|
||||
general form:
|
||||
.PP
|
||||
.CS
|
||||
\fIslave command \fR?\fIarg arg ...\fR?
|
||||
\fIchild command \fR?\fIarg arg ...\fR?
|
||||
.CE
|
||||
.PP
|
||||
\fISlave\fR is the name of the interpreter, and \fIcommand\fR
|
||||
\fIchild\fR is the name of the interpreter, and \fIcommand\fR
|
||||
and the \fIarg\fRs determine the exact behavior of the command.
|
||||
The valid forms of this command are:
|
||||
.TP
|
||||
\fIslave \fBaliases\fR
|
||||
\fIchild \fBaliases\fR
|
||||
.
|
||||
Returns a Tcl list whose elements are the tokens of all the
|
||||
aliases in \fIslave\fR. The tokens correspond to the values returned when
|
||||
aliases in \fIchild\fR. The tokens correspond to the values returned when
|
||||
the aliases were created (which may not be the same
|
||||
as the current names of the commands).
|
||||
.TP
|
||||
\fIslave \fBalias \fIsrcToken\fR
|
||||
\fIchild \fBalias \fIsrcToken\fR
|
||||
.
|
||||
Returns a Tcl list whose elements are the \fItargetCmd\fR and
|
||||
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
|
||||
(this is the value returned when the alias was
|
||||
created; it is possible that the actual source command in the
|
||||
slave is different from \fIsrcToken\fR).
|
||||
child is different from \fIsrcToken\fR).
|
||||
.TP
|
||||
\fIslave \fBalias \fIsrcToken \fB{}\fR
|
||||
\fIchild \fBalias \fIsrcToken \fB{}\fR
|
||||
.
|
||||
Deletes the alias for \fIsrcToken\fR in the slave interpreter.
|
||||
Deletes the alias for \fIsrcToken\fR in the child interpreter.
|
||||
\fIsrcToken\fR refers to the value returned when the alias
|
||||
was created; if the source command has been renamed, the renamed
|
||||
command will be deleted.
|
||||
.TP
|
||||
\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
|
||||
\fIchild \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
|
||||
.
|
||||
Creates an alias such that whenever \fIsrcCmd\fR is invoked
|
||||
in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
|
||||
in \fIchild\fR, \fItargetCmd\fR is invoked in the parent.
|
||||
The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
|
||||
arguments, prepended before any arguments passed in the invocation of
|
||||
\fIsrcCmd\fR.
|
||||
@@ -443,69 +449,69 @@ The command returns a token that uniquely identifies the command created
|
||||
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
|
||||
does not have to be equal to \fIsrcCmd\fR.
|
||||
.TP
|
||||
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
|
||||
\fIchild \fBbgerror\fR ?\fIcmdPrefix\fR?
|
||||
.
|
||||
This command either gets or sets the current background exception handler
|
||||
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
|
||||
for the \fIchild\fR interpreter. If \fIcmdPrefix\fR is
|
||||
absent, the current background exception handler is returned, and if it is
|
||||
present, it is a list of words (of minimum length one) that describes
|
||||
what to set the interpreter's background exception handler to. See the
|
||||
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
|
||||
.TP
|
||||
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
|
||||
\fIchild \fBeval \fIarg \fR?\fIarg ..\fR?
|
||||
.
|
||||
This command concatenates all of the \fIarg\fR arguments in
|
||||
the same fashion as the \fBconcat\fR command, then evaluates
|
||||
the resulting string as a Tcl script in \fIslave\fR.
|
||||
the resulting string as a Tcl script in \fIchild\fR.
|
||||
The result of this evaluation (including all \fBreturn\fR options,
|
||||
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
|
||||
error occurs) is returned to the invoking interpreter.
|
||||
Note that the script will be executed in the current context stack frame
|
||||
of \fIslave\fR; this is so that the implementations (in a master
|
||||
interpreter) of aliases in a slave interpreter can execute scripts in
|
||||
the slave that find out information about the slave's current state
|
||||
of \fIchild\fR; this is so that the implementations (in a parent
|
||||
interpreter) of aliases in a child interpreter can execute scripts in
|
||||
the child that find out information about the child's current state
|
||||
and stack frame.
|
||||
.TP
|
||||
\fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
|
||||
\fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
|
||||
.
|
||||
This command exposes the hidden command \fIhiddenName\fR, eventually bringing
|
||||
it back under a new \fIexposedCmdName\fR name (this name is currently
|
||||
accepted only if it is a valid global name space name without any ::),
|
||||
in \fIslave\fR.
|
||||
in \fIchild\fR.
|
||||
If an exposed command with the targeted name already exists, this command
|
||||
fails.
|
||||
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
|
||||
.TP
|
||||
\fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
|
||||
\fIchild \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
|
||||
.
|
||||
This command hides the exposed command \fIexposedCmdName\fR, renaming it to
|
||||
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
|
||||
argument is not given, in the \fIslave\fR interpreter.
|
||||
argument is not given, in the \fIchild\fR interpreter.
|
||||
If a hidden command with the targeted name already exists, this command
|
||||
fails.
|
||||
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
|
||||
not contain namespace qualifiers, or an error is raised.
|
||||
Commands to be hidden are looked up in the global
|
||||
namespace even if the current namespace is not the global one. This
|
||||
prevents slaves from fooling a master interpreter into hiding the wrong
|
||||
prevents children from fooling a parent interpreter into hiding the wrong
|
||||
command, by making the current namespace be different from the global one.
|
||||
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
|
||||
.TP
|
||||
\fIslave \fBhidden\fR
|
||||
\fIchild \fBhidden\fR
|
||||
.
|
||||
Returns a list of the names of all hidden commands in \fIslave\fR.
|
||||
Returns a list of the names of all hidden commands in \fIchild\fR.
|
||||
.TP
|
||||
\fIslave \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
|
||||
\fIchild \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
|
||||
.
|
||||
This command invokes the hidden command \fIhiddenName\fR with the
|
||||
supplied arguments, in \fIslave\fR. No substitutions or evaluations are
|
||||
supplied arguments, in \fIchild\fR. No substitutions or evaluations are
|
||||
applied to the arguments. Three \fI\-option\fRs are supported, all
|
||||
of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
|
||||
argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
|
||||
If the \fB\-namespace\fR flag is given, the hidden command is invoked in
|
||||
the specified namespace in the slave.
|
||||
the specified namespace in the child.
|
||||
If the \fB\-global\fR flag is given, the command is invoked at the global
|
||||
level in the slave; otherwise it is invoked at the current call frame and
|
||||
level in the child; otherwise it is invoked at the current call frame and
|
||||
can access local variables in that or outer call frames.
|
||||
The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
|
||||
.QW \-
|
||||
@@ -513,37 +519,37 @@ character, and is otherwise unnecessary.
|
||||
If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the
|
||||
\fB\-namespace\fR flag is ignored.
|
||||
Note that the hidden command will be executed (by default) in the
|
||||
current context stack frame of \fIslave\fR.
|
||||
current context stack frame of \fIchild\fR.
|
||||
For more details on hidden commands,
|
||||
see \fBHIDDEN COMMANDS\fR, below.
|
||||
.TP
|
||||
\fIslave \fBissafe\fR
|
||||
\fIchild \fBissafe\fR
|
||||
.
|
||||
Returns \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
|
||||
Returns \fB1\fR if the child interpreter is safe, \fB0\fR otherwise.
|
||||
.TP
|
||||
\fIslave \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
|
||||
\fIchild \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
|
||||
.
|
||||
Sets up, manipulates and queries the configuration of the resource
|
||||
limit \fIlimitType\fR for the slave interpreter. If no \fI\-option\fR
|
||||
limit \fIlimitType\fR for the child interpreter. If no \fI\-option\fR
|
||||
is specified, return the current configuration of the limit. If
|
||||
\fI\-option\fR is the sole argument, return the value of that option.
|
||||
Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must
|
||||
supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of
|
||||
what limits and options are supported.
|
||||
.TP
|
||||
\fIslave \fBmarktrusted\fR
|
||||
\fIchild \fBmarktrusted\fR
|
||||
.
|
||||
Marks the slave interpreter as trusted. Can only be invoked by a
|
||||
Marks the child interpreter as trusted. Can only be invoked by a
|
||||
trusted interpreter. This command does not expose any hidden
|
||||
commands in the slave interpreter. The command has no effect if the slave
|
||||
commands in the child interpreter. The command has no effect if the child
|
||||
is already trusted.
|
||||
.TP
|
||||
\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
|
||||
\fIchild\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
|
||||
.
|
||||
Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
|
||||
If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
|
||||
Returns the maximum allowable nesting depth for the \fIchild\fR interpreter.
|
||||
If \fInewlimit\fR is specified, the recursion limit in \fIchild\fR will be
|
||||
set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
|
||||
and related procedures in \fIslave\fR will return an error.
|
||||
and related procedures in \fIchild\fR will return an error.
|
||||
The \fInewlimit\fR value is also returned.
|
||||
The \fInewlimit\fR value must be a positive integer between 1 and the
|
||||
maximum value of a non-long integer on the platform.
|
||||
@@ -567,14 +573,14 @@ For example, commands to create files on disk are removed, and the
|
||||
\fBexec\fR command is removed, since it could be used to cause damage
|
||||
through subprocesses.
|
||||
Limited access to these facilities can be provided, by creating
|
||||
aliases to the master interpreter which check their arguments carefully
|
||||
aliases to the parent interpreter which check their arguments carefully
|
||||
and provide restricted access to a safe subset of facilities.
|
||||
For example, file creation might be allowed in a particular subdirectory
|
||||
and subprocess invocation might be allowed for a carefully selected and
|
||||
fixed set of programs.
|
||||
.PP
|
||||
A safe interpreter is created by specifying the \fB\-safe\fR switch
|
||||
to the \fBinterp create\fR command. Furthermore, any slave created
|
||||
to the \fBinterp create\fR command. Furthermore, any child created
|
||||
by a safe interpreter will also be safe.
|
||||
.PP
|
||||
A safe interpreter is created with exactly the following set of
|
||||
@@ -661,15 +667,15 @@ including itself.
|
||||
.SH "ALIAS INVOCATION"
|
||||
.PP
|
||||
The alias mechanism has been carefully designed so that it can
|
||||
be used safely when an untrusted script is executing
|
||||
in a safe slave and the target of the alias is a trusted
|
||||
master. The most important thing in guaranteeing safety is to
|
||||
ensure that information passed from the slave to the master is
|
||||
never evaluated or substituted in the master; if this were to
|
||||
occur, it would enable an evil script in the slave to invoke
|
||||
arbitrary functions in the master, which would compromise security.
|
||||
be used safely in an untrusted script which is being executed in a
|
||||
safe interpreter even if the target of the alias is not a safe
|
||||
interpreter. The most important thing in guaranteeing safety is to
|
||||
ensure that information passed from the child to the parent is
|
||||
never evaluated or substituted in the parent; if this were to
|
||||
occur, it would enable an evil script in the child to invoke
|
||||
arbitrary functions in the parent, which would compromise security.
|
||||
.PP
|
||||
When the source for an alias is invoked in the slave interpreter, the
|
||||
When the source for an alias is invoked in the child interpreter, the
|
||||
usual Tcl substitutions are performed when parsing that command.
|
||||
These substitutions are carried out in the source interpreter just
|
||||
as they would be for any other command invoked in that interpreter.
|
||||
@@ -696,8 +702,8 @@ the alias's source command is parsed in the source interpreter.
|
||||
When writing the \fItargetCmd\fRs for aliases in safe interpreters,
|
||||
it is very important that the arguments to that command never be
|
||||
evaluated or substituted, since this would provide an escape
|
||||
mechanism whereby the slave interpreter could execute arbitrary
|
||||
code in the master. This in turn would compromise the security
|
||||
mechanism whereby the child interpreter could execute arbitrary
|
||||
code in the parent. This in turn would compromise the security
|
||||
of the system.
|
||||
.SH "HIDDEN COMMANDS"
|
||||
.PP
|
||||
@@ -724,28 +730,28 @@ invoke\fR. Hidden commands and exposed commands reside in separate name
|
||||
spaces. It is possible to define a hidden command and an exposed command by
|
||||
the same name within one interpreter.
|
||||
.PP
|
||||
Hidden commands in a slave interpreter can be invoked in the body of
|
||||
procedures called in the master during alias invocation. For example, an
|
||||
alias for \fBsource\fR could be created in a slave interpreter. When it is
|
||||
invoked in the slave interpreter, a procedure is called in the master
|
||||
Hidden commands in a child interpreter can be invoked in the body of
|
||||
procedures called in the parent during alias invocation. For example, an
|
||||
alias for \fBsource\fR could be created in a child interpreter. When it is
|
||||
invoked in the child interpreter, a procedure is called in the parent
|
||||
interpreter to check that the operation is allowable (e.g. it asks to
|
||||
source a file that the slave interpreter is allowed to access). The
|
||||
procedure then it invokes the hidden \fBsource\fR command in the slave
|
||||
source a file that the child interpreter is allowed to access). The
|
||||
procedure then it invokes the hidden \fBsource\fR command in the child
|
||||
interpreter to actually source in the contents of the file. Note that two
|
||||
commands named \fBsource\fR exist in the slave interpreter: the alias, and
|
||||
commands named \fBsource\fR exist in the child interpreter: the alias, and
|
||||
the hidden command.
|
||||
.PP
|
||||
Because a master interpreter may invoke a hidden command as part of
|
||||
Because a parent interpreter may invoke a hidden command as part of
|
||||
handling an alias invocation, great care must be taken to avoid evaluating
|
||||
any arguments passed in through the alias invocation.
|
||||
Otherwise, malicious slave interpreters could cause a trusted master
|
||||
Otherwise, malicious child interpreters could cause a trusted parent
|
||||
interpreter to execute dangerous commands on their behalf. See the section
|
||||
on \fBALIAS INVOCATION\fR for a more complete discussion of this topic.
|
||||
To help avoid this problem, no substitutions or evaluations are
|
||||
applied to arguments of \fBinterp invokehidden\fR.
|
||||
.PP
|
||||
Safe interpreters are not allowed to invoke hidden commands in themselves
|
||||
or in their descendants. This prevents safe slaves from gaining access to
|
||||
or in their descendants. This prevents them from gaining access to
|
||||
hidden functionality in themselves or their descendants.
|
||||
.PP
|
||||
The set of hidden commands in an interpreter can be manipulated by a trusted
|
||||
@@ -764,12 +770,12 @@ qualifiers, and you must first rename a command in a namespace to the
|
||||
global namespace before you can hide it.
|
||||
Commands to be hidden by \fBinterp hide\fR are looked up in the global
|
||||
namespace even if the current namespace is not the global one. This
|
||||
prevents slaves from fooling a master interpreter into hiding the wrong
|
||||
prevents children from fooling a parent interpreter into hiding the wrong
|
||||
command, by making the current namespace be different from the global one.
|
||||
.SH "RESOURCE LIMITS"
|
||||
.PP
|
||||
Every interpreter has two kinds of resource limits that may be imposed by any
|
||||
master interpreter upon its slaves. Command limits (of type \fBcommand\fR)
|
||||
parent interpreter upon its children. Command limits (of type \fBcommand\fR)
|
||||
restrict the total number of Tcl commands that may be executed by an
|
||||
interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and
|
||||
time limits (of type \fBtime\fR) place a limit by which execution within the
|
||||
@@ -778,7 +784,7 @@ interpreter must complete. Note that time limits are expressed as
|
||||
\fBafter\fR) because they may be modified after creation.
|
||||
.PP
|
||||
When a limit is exceeded for an interpreter, first any handler callbacks
|
||||
defined by master interpreters are called. If those callbacks increase or
|
||||
defined by parent interpreters are called. If those callbacks increase or
|
||||
remove the limit, execution within the (previously) limited interpreter
|
||||
continues. If the limit is still in force, an error is generated at that point
|
||||
and normal processing of errors within the interpreter (by the \fBcatch\fR
|
||||
@@ -835,13 +841,13 @@ This option specifies the number of commands that the interpreter may execute
|
||||
before triggering the command limit. This option may be the empty string,
|
||||
which indicates that a command limit is not set for the interpreter.
|
||||
.PP
|
||||
Where an interpreter with a resource limit set on it creates a slave
|
||||
interpreter, that slave interpreter will have resource limits imposed on it
|
||||
that are at least as restrictive as the limits on the creating master
|
||||
interpreter. If the master interpreter of the limited master wishes to relax
|
||||
Where an interpreter with a resource limit set on it creates a child
|
||||
interpreter, that child interpreter will have resource limits imposed on it
|
||||
that are at least as restrictive as the limits on the creating parent
|
||||
interpreter. If the parent interpreter of the limited parent wishes to relax
|
||||
these conditions, it should hide the \fBinterp\fR command in the child and
|
||||
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
|
||||
access as it chooses to the \fBinterp\fR command to the limited master as
|
||||
access as it chooses to the \fBinterp\fR command to the limited parent as
|
||||
necessary.
|
||||
.SH "BACKGROUND EXCEPTION HANDLING"
|
||||
.PP
|
||||
@@ -902,9 +908,9 @@ set i [\fBinterp create\fR]
|
||||
}
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3), Tcl_BackgroundException(3)
|
||||
bgerror(n), load(n), safe(n), Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3)
|
||||
.SH KEYWORDS
|
||||
alias, master interpreter, safe interpreter, slave interpreter
|
||||
alias, parent interpreter, safe interpreter, child interpreter
|
||||
'\"Local Variables:
|
||||
'\"mode: nroff
|
||||
'\"End:
|
||||
|
||||
+1
-1
@@ -124,7 +124,7 @@ will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
|
||||
generate a new index file \fBfoo/tclIndex\fR.
|
||||
.PP
|
||||
\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them into a
|
||||
slave interpreter and monitoring the proc and namespace commands that
|
||||
child interpreter and monitoring the proc and namespace commands that
|
||||
are executed. Extensions can use the (undocumented)
|
||||
auto_mkindex_parser package to register other commands that can
|
||||
contribute to the auto_load index. You will have to read through
|
||||
|
||||
+2
-2
@@ -42,7 +42,7 @@ The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
|
||||
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
|
||||
with package information about all the files given by the \fIpattern\fR
|
||||
arguments.
|
||||
It does this by loading each file into a slave
|
||||
It does this by loading each file into a child
|
||||
interpreter and seeing what packages
|
||||
and new commands appear (this is why it is essential to have
|
||||
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
|
||||
@@ -109,7 +109,7 @@ the use of \fIauto_reset\fR, and therefore its use is discouraged.
|
||||
.TP 15
|
||||
\fB\-load \fIpkgPat\fR
|
||||
The index process will pre-load any packages that exist in the
|
||||
current interpreter and match \fIpkgPat\fR into the slave interpreter used to
|
||||
current interpreter and match \fIpkgPat\fR into the child interpreter used to
|
||||
generate the index. The pattern match uses string match rules, but without
|
||||
making case distinctions.
|
||||
See \fBCOMPLEX CASES\fR below.
|
||||
|
||||
+59
-51
@@ -11,17 +11,17 @@
|
||||
.SH NAME
|
||||
safe \- Creating and manipulating safe interpreters
|
||||
.SH SYNOPSIS
|
||||
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
|
||||
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
|
||||
.sp
|
||||
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
|
||||
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
|
||||
.sp
|
||||
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
|
||||
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
|
||||
.sp
|
||||
\fB::safe::interpDelete\fR \fIslave\fR
|
||||
\fB::safe::interpDelete\fR \fIchild\fR
|
||||
.sp
|
||||
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
|
||||
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
|
||||
.sp
|
||||
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
|
||||
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
|
||||
.sp
|
||||
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
|
||||
.SS OPTIONS
|
||||
@@ -44,7 +44,7 @@ application or computer. Untrusted scripts are also prevented from
|
||||
disclosing information stored on the hosting computer or in the
|
||||
hosting application to any party.
|
||||
.PP
|
||||
Safe Tcl allows a master interpreter to create safe, restricted
|
||||
Safe Tcl allows a parent interpreter to create safe, restricted
|
||||
interpreters that contain a set of predefined aliases for the \fBsource\fR,
|
||||
\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
|
||||
are able to use the auto-loading and package mechanisms.
|
||||
@@ -53,39 +53,47 @@ No knowledge of the file system structure is leaked to the
|
||||
safe interpreter, because it has access only to a virtualized path
|
||||
containing tokens. When the safe interpreter requests to source a file, it
|
||||
uses the token in the virtual path as part of the file name to source; the
|
||||
master interpreter transparently
|
||||
parent interpreter transparently
|
||||
translates the token into a real directory name and executes the
|
||||
requested operation (see the section \fBSECURITY\fR below for details).
|
||||
Different levels of security can be selected by using the optional flags
|
||||
of the commands described below.
|
||||
.PP
|
||||
All commands provided in the master interpreter by Safe Tcl reside in
|
||||
All commands provided in the parent interpreter by Safe Tcl reside in
|
||||
the \fBsafe\fR namespace.
|
||||
.SH COMMANDS
|
||||
The following commands are provided in the master interpreter:
|
||||
The following commands are provided in the parent interpreter:
|
||||
.TP
|
||||
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
|
||||
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
|
||||
Creates a safe interpreter, installs the aliases described in the section
|
||||
\fBALIASES\fR and initializes the auto-loading and package mechanism as
|
||||
specified by the supplied \fIoptions\fR.
|
||||
See the \fBOPTIONS\fR section below for a description of the
|
||||
optional arguments.
|
||||
If the \fIslave\fR argument is omitted, a name will be generated.
|
||||
If the \fIchild\fR argument is omitted, a name will be generated.
|
||||
\fB::safe::interpCreate\fR always returns the interpreter name.
|
||||
.sp
|
||||
The interpreter name \fIchild\fR may include namespace separators,
|
||||
but may not have leading or trailing namespace separators, or excess
|
||||
colon characters in namespace separators. The interpreter name is
|
||||
qualified relative to the global namespace ::, not the namespace in which
|
||||
the \fB::safe::interpCreate\fR command is evaluated.
|
||||
.TP
|
||||
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
|
||||
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
|
||||
This command is similar to \fBinterpCreate\fR except it that does not
|
||||
create the safe interpreter. \fIslave\fR must have been created by some
|
||||
other means, like \fBinterp create\fR \fB\-safe\fR.
|
||||
create the safe interpreter. \fIchild\fR must have been created by some
|
||||
other means, like \fBinterp create\fR \fB\-safe\fR. The interpreter
|
||||
name \fIchild\fR may include namespace separators, subject to the same
|
||||
restrictions as for \fBinterpCreate\fR.
|
||||
.TP
|
||||
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
|
||||
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
|
||||
If no \fIoptions\fR are given, returns the settings for all options for the
|
||||
named safe interpreter as a list of options and their current values
|
||||
for that \fIslave\fR.
|
||||
for that \fIchild\fR.
|
||||
If a single additional argument is provided,
|
||||
it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
|
||||
\fIname\fR is the full name of that option and \fIvalue\fR the current value
|
||||
for that option and the \fIslave\fR.
|
||||
for that option and the \fIchild\fR.
|
||||
If more than two additional arguments are provided, it will reconfigure the
|
||||
safe interpreter and change each and only the provided options.
|
||||
See the section on \fBOPTIONS\fR below for options description.
|
||||
@@ -105,14 +113,14 @@ safe::interpConfigure $i0 \-delete {foo bar} \-statics 0
|
||||
.CE
|
||||
.RE
|
||||
.TP
|
||||
\fB::safe::interpDelete\fR \fIslave\fR
|
||||
\fB::safe::interpDelete\fR \fIchild\fR
|
||||
Deletes the safe interpreter and cleans up the corresponding
|
||||
master interpreter data structures.
|
||||
parent interpreter data structures.
|
||||
If a \fIdeleteHook\fR script was specified for this interpreter it is
|
||||
evaluated before the interpreter is deleted, with the name of the
|
||||
interpreter as an additional argument.
|
||||
.TP
|
||||
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
|
||||
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
|
||||
This command finds and returns the token for the real directory
|
||||
\fIdirectory\fR in the safe interpreter's current virtual access path.
|
||||
It generates an error if the directory is not found.
|
||||
@@ -120,14 +128,14 @@ Example of use:
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
$slave eval [list set tk_library \e
|
||||
$child eval [list set tk_library \e
|
||||
[::safe::interpFindInAccessPath $name $tk_library]]
|
||||
.CE
|
||||
.RE
|
||||
.TP
|
||||
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
|
||||
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
|
||||
This command adds \fIdirectory\fR to the virtual path maintained for the
|
||||
safe interpreter in the master, and returns the token that can be used in
|
||||
safe interpreter in the parent, and returns the token that can be used in
|
||||
the safe interpreter to obtain access to files in that directory.
|
||||
If the directory is already in the virtual path, it only returns the token
|
||||
without adding the directory to the virtual path again.
|
||||
@@ -135,7 +143,7 @@ Example of use:
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
$slave eval [list set tk_library \e
|
||||
$child eval [list set tk_library \e
|
||||
[::safe::interpAddToAccessPath $name $tk_library]]
|
||||
.CE
|
||||
.RE
|
||||
@@ -168,10 +176,10 @@ Note that the safe interpreter only received an error message saying that
|
||||
the file was not found:
|
||||
.PP
|
||||
.CS
|
||||
NOTICE for slave interp10 : Created
|
||||
NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
|
||||
NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
|
||||
ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
|
||||
NOTICE for child interp10 : Created
|
||||
NOTICE for child interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
|
||||
NOTICE for child interp10 : auto_path in interp10 has been set to {$p(:0:)}
|
||||
ERROR for child interp10 : /foo/bar/init.tcl: no such file or directory
|
||||
.CE
|
||||
.RE
|
||||
.SS OPTIONS
|
||||
@@ -187,7 +195,7 @@ This option sets the list of directories from which the safe interpreter
|
||||
can \fBsource\fR and \fBload\fR files.
|
||||
If this option is not specified, or if it is given as the
|
||||
empty list, the safe interpreter will use the same directories as its
|
||||
master for auto-loading.
|
||||
parent for auto-loading.
|
||||
See the section \fBSECURITY\fR below for more detail about virtual paths,
|
||||
tokens and access control.
|
||||
.TP
|
||||
@@ -216,7 +224,7 @@ to load packages into its own sub-interpreters.
|
||||
.TP
|
||||
\fB\-deleteHook\fR \fIscript\fR
|
||||
When this option is given a non-empty \fIscript\fR, it will be
|
||||
evaluated in the master with the name of
|
||||
evaluated in the parent with the name of
|
||||
the safe interpreter as an additional argument
|
||||
just before actually deleting the safe interpreter.
|
||||
Giving an empty value removes any currently installed deletion hook
|
||||
@@ -281,8 +289,8 @@ potential for information leakage about its directory structure.
|
||||
To prevent this, commands that take file names as arguments in a safe
|
||||
interpreter use tokens instead of the real directory names.
|
||||
These tokens are translated to the real directory name while a request to,
|
||||
e.g., source a file is mediated by the master interpreter.
|
||||
This virtual path system is maintained in the master interpreter for each safe
|
||||
e.g., source a file is mediated by the parent interpreter.
|
||||
This virtual path system is maintained in the parent interpreter for each safe
|
||||
interpreter created by \fB::safe::interpCreate\fR or initialized by
|
||||
\fB::safe::interpInit\fR and
|
||||
the path maps tokens accessible in the safe interpreter into real path
|
||||
@@ -291,7 +299,7 @@ from gaining knowledge about the
|
||||
structure of the file system of the host on which the interpreter is
|
||||
executing.
|
||||
The only valid file names arguments
|
||||
for the \fBsource\fR and \fBload\fR aliases provided to the slave
|
||||
for the \fBsource\fR and \fBload\fR aliases provided to the child
|
||||
are path in the form of
|
||||
\fB[file join \fItoken filename\fB]\fR (i.e. when using the
|
||||
native file path formats: \fItoken\fB/\fIfilename\fR
|
||||
@@ -320,26 +328,26 @@ or be called
|
||||
.PP
|
||||
Each element of the initial access path
|
||||
list will be assigned a token that will be set in
|
||||
the slave \fBauto_path\fR and the first element of that list will be set as
|
||||
the \fBtcl_library\fR for that slave.
|
||||
the child \fBauto_path\fR and the first element of that list will be set as
|
||||
the \fBtcl_library\fR for that child.
|
||||
.PP
|
||||
If the access path argument is not given or is the empty list,
|
||||
the default behavior is to let the slave access the same packages
|
||||
as the master has access to (Or to be more precise:
|
||||
the default behavior is to let the child access the same packages
|
||||
as the parent has access to (Or to be more precise:
|
||||
only packages written in Tcl (which by definition cannot be dangerous
|
||||
as they run in the slave interpreter) and C extensions that
|
||||
provides a _SafeInit entry point). For that purpose, the master's
|
||||
\fBauto_path\fR will be used to construct the slave access path.
|
||||
In order that the slave successfully loads the Tcl library files
|
||||
as they run in the child interpreter) and C extensions that
|
||||
provides a _SafeInit entry point). For that purpose, the parent's
|
||||
\fBauto_path\fR will be used to construct the child access path.
|
||||
In order that the child successfully loads the Tcl library files
|
||||
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
|
||||
added or moved to the first position if necessary, in the
|
||||
slave access path, so the slave
|
||||
\fBtcl_library\fR will be the same as the master's (its real
|
||||
path will still be invisible to the slave though).
|
||||
In order that auto-loading works the same for the slave and
|
||||
the master in this by default case, the first-level
|
||||
sub directories of each directory in the master \fBauto_path\fR will
|
||||
also be added (if not already included) to the slave access path.
|
||||
child access path, so the child
|
||||
\fBtcl_library\fR will be the same as the parent's (its real
|
||||
path will still be invisible to the child though).
|
||||
In order that auto-loading works the same for the child and
|
||||
the parent in this by default case, the first-level
|
||||
sub directories of each directory in the parent \fBauto_path\fR will
|
||||
also be added (if not already included) to the child access path.
|
||||
You can always specify a more
|
||||
restrictive path for which sub directories will never be searched by
|
||||
explicitly specifying your directory list with the \fB\-accessPath\fR flag
|
||||
@@ -352,8 +360,8 @@ to synchronize its \fBauto_index\fR with the new token list.
|
||||
.SH "SEE ALSO"
|
||||
interp(n), library(n), load(n), package(n), source(n), unknown(n)
|
||||
.SH KEYWORDS
|
||||
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
|
||||
interpreter, slave interpreter, source
|
||||
alias, auto\-loading, auto_mkindex, load, parent interpreter, safe
|
||||
interpreter, child interpreter, source
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
|
||||
+11
-11
@@ -203,7 +203,7 @@ array. Returns an empty string.
|
||||
.TP
|
||||
\fBrunAllTests\fR
|
||||
.
|
||||
This is a master command meant to run an entire suite of tests,
|
||||
This is a main command meant to run an entire suite of tests,
|
||||
spanning multiple files and/or directories, as governed by
|
||||
the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR
|
||||
below for a complete description of the many variations possible
|
||||
@@ -804,17 +804,17 @@ then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
|
||||
evaluate each file. The multi-process operation is useful
|
||||
when testing can cause errors so severe that a process
|
||||
terminates. Although such an error may terminate a child
|
||||
process evaluating one file, the master process can continue
|
||||
process evaluating one file, the main process can continue
|
||||
with the rest of the test suite. In multi-process operation,
|
||||
the configuration of \fBtcltest\fR in the master process is
|
||||
the configuration of \fBtcltest\fR in the main process is
|
||||
passed to the child processes as command line arguments,
|
||||
with the exception of \fBconfigure \-outfile\fR. The
|
||||
\fBrunAllTests\fR command in the
|
||||
master process collects all output from the child processes
|
||||
and collates their results into one master report. Any
|
||||
main process collects all output from the child processes
|
||||
and collates their results into one main report. Any
|
||||
reports of individual test failures, or messages requested
|
||||
by a \fBconfigure \-verbose\fR setting are passed directly
|
||||
on to \fBoutputChannel\fR by the master process.
|
||||
on to \fBoutputChannel\fR by the main process.
|
||||
.PP
|
||||
After evaluating all selected test files, a summary of the
|
||||
results is printed to \fBoutputChannel\fR. The summary
|
||||
@@ -1134,7 +1134,7 @@ A good namespace to use is a child namespace \fBtest\fR of the namespace
|
||||
of the module you are testing.
|
||||
.PP
|
||||
A test file should also be able to be evaluated directly as a script,
|
||||
not depending on being called by a master \fBrunAllTests\fR. This
|
||||
not depending on being called by a main \fBrunAllTests\fR. This
|
||||
means that each test file should process command line arguments to give
|
||||
the tester all the configuration control that \fBtcltest\fR provides.
|
||||
.PP
|
||||
@@ -1145,7 +1145,7 @@ Here is a sketch of a sample test file illustrating those points:
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
package require tcltest 2.2
|
||||
package require tcltest 2.5
|
||||
eval \fB::tcltest::configure\fR $argv
|
||||
package require example
|
||||
namespace eval ::example::test {
|
||||
@@ -1175,12 +1175,12 @@ doing any necessary setup. This script is usually named \fBall.tcl\fR
|
||||
because that is the default name used by \fBrunAllTests\fR when combining
|
||||
multiple test suites into one testing run.
|
||||
.IP [8]
|
||||
Here is a sketch of a sample test suite master script:
|
||||
Here is a sketch of a sample test suite main script:
|
||||
.RS
|
||||
.PP
|
||||
.CS
|
||||
package require Tcl 8.4
|
||||
package require tcltest 2.2
|
||||
package require Tcl 8.6
|
||||
package require tcltest 2.5
|
||||
package require example
|
||||
\fB::tcltest::configure\fR -testdir \e
|
||||
[file dirname [file normalize [info script]]]
|
||||
|
||||
+1
-1
@@ -73,7 +73,7 @@ struct dfa {
|
||||
chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
|
||||
struct sset *search; /* replacement-search-pointer memory */
|
||||
int cptsmalloced; /* were the areas individually malloced? */
|
||||
char *mallocarea; /* self, or master malloced area, or NULL */
|
||||
char *mallocarea; /* self, or malloced area, or NULL */
|
||||
};
|
||||
|
||||
#define WORK 1 /* number of work bitvectors needed */
|
||||
|
||||
+7
-7
@@ -316,12 +316,12 @@ declare 85 {
|
||||
int flags)
|
||||
}
|
||||
declare 86 {
|
||||
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
|
||||
int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd,
|
||||
Tcl_Interp *target, const char *targetCmd, int argc,
|
||||
CONST84 char *const *argv)
|
||||
}
|
||||
declare 87 {
|
||||
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
|
||||
int Tcl_CreateAliasObj(Tcl_Interp *childInterp, const char *childCmd,
|
||||
Tcl_Interp *target, const char *targetCmd, int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
}
|
||||
@@ -364,7 +364,7 @@ declare 96 {
|
||||
Tcl_CmdDeleteProc *deleteProc)
|
||||
}
|
||||
declare 97 {
|
||||
Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
|
||||
Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
|
||||
int isSafe)
|
||||
}
|
||||
declare 98 {
|
||||
@@ -527,12 +527,12 @@ declare 147 {
|
||||
void Tcl_FreeResult(Tcl_Interp *interp)
|
||||
}
|
||||
declare 148 {
|
||||
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
|
||||
int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
|
||||
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
|
||||
int *argcPtr, CONST84 char ***argvPtr)
|
||||
}
|
||||
declare 149 {
|
||||
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
|
||||
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
|
||||
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
|
||||
int *objcPtr, Tcl_Obj ***objv)
|
||||
}
|
||||
@@ -582,7 +582,7 @@ declare 162 {
|
||||
CONST84_RETURN char *Tcl_GetHostName(void)
|
||||
}
|
||||
declare 163 {
|
||||
int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *slaveInterp)
|
||||
int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp)
|
||||
}
|
||||
declare 164 {
|
||||
Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
|
||||
@@ -616,7 +616,7 @@ declare 171 {
|
||||
int Tcl_GetServiceMode(void)
|
||||
}
|
||||
declare 172 {
|
||||
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
|
||||
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *name)
|
||||
}
|
||||
declare 173 {
|
||||
Tcl_Channel Tcl_GetStdChannel(int type)
|
||||
|
||||
+2
-2
@@ -384,7 +384,7 @@ typedef long LONG;
|
||||
*/
|
||||
|
||||
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
|
||||
# if defined(_WIN32)
|
||||
# if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
|
||||
# define TCL_WIDE_INT_TYPE __int64
|
||||
# ifdef __BORLANDC__
|
||||
# define TCL_LL_MODIFIER "L"
|
||||
@@ -2517,7 +2517,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
# define Tcl_DecrRefCount(objPtr) \
|
||||
do { \
|
||||
Tcl_Obj *_objPtr = (objPtr); \
|
||||
if ((_objPtr)->refCount-- <= 1) { \
|
||||
if (_objPtr->refCount-- <= 1) { \
|
||||
TclFreeObj(_objPtr); \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
+13
-13
@@ -24,7 +24,7 @@
|
||||
#include "tclInt.h"
|
||||
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
|
||||
|
||||
#if USE_TCLALLOC
|
||||
#if defined(USE_TCLALLOC) && USE_TCLALLOC
|
||||
|
||||
/*
|
||||
* We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
|
||||
@@ -253,9 +253,9 @@ char *
|
||||
TclpAlloc(
|
||||
unsigned int numBytes) /* Number of bytes to allocate. */
|
||||
{
|
||||
register union overhead *overPtr;
|
||||
register long bucket;
|
||||
register unsigned amount;
|
||||
union overhead *overPtr;
|
||||
long bucket;
|
||||
unsigned amount;
|
||||
struct block *bigBlockPtr = NULL;
|
||||
|
||||
if (!allocInit) {
|
||||
@@ -274,7 +274,7 @@ TclpAlloc(
|
||||
|
||||
if (numBytes >= MAXMALLOC - OVERHEAD) {
|
||||
if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
|
||||
bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
|
||||
bigBlockPtr = (struct block *) TclpSysAlloc(
|
||||
(sizeof(struct block) + OVERHEAD + numBytes), 0);
|
||||
}
|
||||
if (bigBlockPtr == NULL) {
|
||||
@@ -387,8 +387,8 @@ static void
|
||||
MoreCore(
|
||||
int bucket) /* What bucket to allocat to. */
|
||||
{
|
||||
register union overhead *overPtr;
|
||||
register long size; /* size of desired block */
|
||||
union overhead *overPtr;
|
||||
long size; /* size of desired block */
|
||||
long amount; /* amount to allocate */
|
||||
int numBlocks; /* how many blocks we get */
|
||||
struct block *blockPtr;
|
||||
@@ -405,7 +405,7 @@ MoreCore(
|
||||
numBlocks = amount / size;
|
||||
ASSERT(numBlocks*size == amount);
|
||||
|
||||
blockPtr = (struct block *) TclpSysAlloc((unsigned)
|
||||
blockPtr = (struct block *) TclpSysAlloc(
|
||||
(sizeof(struct block) + amount), 1);
|
||||
/* no more room! */
|
||||
if (blockPtr == NULL) {
|
||||
@@ -448,8 +448,8 @@ void
|
||||
TclpFree(
|
||||
char *oldPtr) /* Pointer to memory to free. */
|
||||
{
|
||||
register long size;
|
||||
register union overhead *overPtr;
|
||||
long size;
|
||||
union overhead *overPtr;
|
||||
struct block *bigBlockPtr;
|
||||
|
||||
if (oldPtr == NULL) {
|
||||
@@ -604,7 +604,7 @@ TclpRealloc(
|
||||
if (maxSize < numBytes) {
|
||||
numBytes = maxSize;
|
||||
}
|
||||
memcpy(newPtr, oldPtr, (size_t) numBytes);
|
||||
memcpy(newPtr, oldPtr, numBytes);
|
||||
TclpFree(oldPtr);
|
||||
return newPtr;
|
||||
}
|
||||
@@ -645,8 +645,8 @@ void
|
||||
mstats(
|
||||
char *s) /* Where to write info. */
|
||||
{
|
||||
register int i, j;
|
||||
register union overhead *overPtr;
|
||||
int i, j;
|
||||
union overhead *overPtr;
|
||||
int totalFree = 0, totalUsed = 0;
|
||||
|
||||
Tcl_MutexLock(allocMutexPtr);
|
||||
|
||||
@@ -803,7 +803,7 @@ TclNRAssembleObjCmd(
|
||||
Tcl_AddErrorInfo(interp, "\n (\"");
|
||||
Tcl_AppendObjToErrorInfo(interp, objv[0]);
|
||||
Tcl_AddErrorInfo(interp, "\" body, line ");
|
||||
backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
|
||||
TclNewIntObj(backtrace, Tcl_GetErrorLine(interp));
|
||||
Tcl_AppendObjToErrorInfo(interp, backtrace);
|
||||
Tcl_AddErrorInfo(interp, ")");
|
||||
return TCL_ERROR;
|
||||
@@ -2089,8 +2089,9 @@ GetNextOperand(
|
||||
* with \-substitutions done. */
|
||||
{
|
||||
Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
|
||||
Tcl_Obj* operandObj = Tcl_NewObj();
|
||||
Tcl_Obj* operandObj;
|
||||
|
||||
TclNewObj(operandObj);
|
||||
if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
|
||||
Tcl_DecrRefCount(operandObj);
|
||||
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
|
||||
@@ -4260,7 +4261,7 @@ AddBasicBlockRangeToErrorInfo(
|
||||
Tcl_Obj* lineNo; /* Line number in the source */
|
||||
|
||||
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
|
||||
lineNo = Tcl_NewIntObj(bbPtr->startLine);
|
||||
TclNewIntObj(lineNo, bbPtr->startLine);
|
||||
Tcl_IncrRefCount(lineNo);
|
||||
Tcl_AppendObjToErrorInfo(interp, lineNo);
|
||||
Tcl_AddErrorInfo(interp, " and ");
|
||||
|
||||
+31
-30
@@ -1036,7 +1036,7 @@ int
|
||||
TclHideUnsafeCommands(
|
||||
Tcl_Interp *interp) /* Hide commands in this interpreter. */
|
||||
{
|
||||
register const CmdInfo *cmdInfoPtr;
|
||||
const CmdInfo *cmdInfoPtr;
|
||||
|
||||
if (interp == NULL) {
|
||||
return TCL_ERROR;
|
||||
@@ -2485,7 +2485,7 @@ int
|
||||
TclInvokeStringCommand(
|
||||
ClientData clientData, /* Points to command's Command structure. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
register int objc, /* Number of arguments. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Command *cmdPtr = clientData;
|
||||
@@ -2534,7 +2534,7 @@ TclInvokeObjectCommand(
|
||||
ClientData clientData, /* Points to command's Command structure. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int argc, /* Number of arguments. */
|
||||
register const char **argv) /* Argument strings. */
|
||||
const char **argv) /* Argument strings. */
|
||||
{
|
||||
Command *cmdPtr = clientData;
|
||||
Tcl_Obj *objPtr;
|
||||
@@ -3025,7 +3025,7 @@ Tcl_GetCommandFullName(
|
||||
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Command *cmdPtr = (Command *) command;
|
||||
Command *cmdPtr = (Command *) command;
|
||||
char *name;
|
||||
|
||||
/*
|
||||
@@ -3268,6 +3268,7 @@ Tcl_DeleteCommandFromToken(
|
||||
* TclNRExecuteByteCode looks up the command in the command hashtable).
|
||||
*/
|
||||
|
||||
cmdPtr->flags |= CMD_DEAD;
|
||||
TclCleanupCommandMacro(cmdPtr);
|
||||
return 0;
|
||||
}
|
||||
@@ -3301,7 +3302,7 @@ CallCommandTraces(
|
||||
* trigger, either TCL_TRACE_DELETE or
|
||||
* TCL_TRACE_RENAME. */
|
||||
{
|
||||
register CommandTrace *tracePtr;
|
||||
CommandTrace *tracePtr;
|
||||
ActiveCommandTrace active;
|
||||
char *result;
|
||||
Tcl_Obj *oldNamePtr = NULL;
|
||||
@@ -3443,11 +3444,11 @@ CancelEvalProc(
|
||||
TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
|
||||
|
||||
/*
|
||||
* Now, we must set the script cancellation flags on all the slave
|
||||
* Now, we must set the script cancellation flags on all the child
|
||||
* interpreters belonging to this one.
|
||||
*/
|
||||
|
||||
TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
|
||||
TclSetChildCancelFlags((Tcl_Interp *) iPtr,
|
||||
cancelInfo->flags | CANCELED, 0);
|
||||
|
||||
/*
|
||||
@@ -3491,7 +3492,7 @@ CancelEvalProc(
|
||||
|
||||
void
|
||||
TclCleanupCommand(
|
||||
register Command *cmdPtr) /* Points to the Command structure to
|
||||
Command *cmdPtr) /* Points to the Command structure to
|
||||
* be freed. */
|
||||
{
|
||||
cmdPtr->refCount--;
|
||||
@@ -3876,7 +3877,7 @@ int
|
||||
TclInterpReady(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Reset both the interpreter's string and object results and clear out
|
||||
@@ -3948,7 +3949,7 @@ TclResetCancellation(
|
||||
Tcl_Interp *interp,
|
||||
int force)
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (iPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
@@ -3966,7 +3967,7 @@ TclResetCancellation(
|
||||
* Tcl_Canceled --
|
||||
*
|
||||
* Check if the script in progress has been canceled, i.e.,
|
||||
* Tcl_CancelEval was called for this interpreter or any of its master
|
||||
* Tcl_CancelEval was called for this interpreter or any of its parent
|
||||
* interpreters.
|
||||
*
|
||||
* Results:
|
||||
@@ -3990,7 +3991,7 @@ Tcl_Canceled(
|
||||
Tcl_Interp *interp,
|
||||
int flags)
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Has the current script in progress for this interpreter been canceled
|
||||
@@ -4138,7 +4139,7 @@ Tcl_CancelEval(
|
||||
if (resultObjPtr != NULL) {
|
||||
result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
|
||||
cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
|
||||
memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
|
||||
memcpy(cancelInfo->result, result, cancelInfo->length);
|
||||
TclDecrRefCount(resultObjPtr); /* Discard their result object. */
|
||||
} else {
|
||||
cancelInfo->result = NULL;
|
||||
@@ -4331,7 +4332,7 @@ EvalObjvCore(
|
||||
* Caller gave it to us.
|
||||
*/
|
||||
|
||||
if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
|
||||
if (!(preCmdPtr->flags & CMD_DEAD)) {
|
||||
/*
|
||||
* So long as it exists, use it.
|
||||
*/
|
||||
@@ -4719,7 +4720,7 @@ TEOV_NotFound(
|
||||
newObjv[i] = handlerObjv[i];
|
||||
Tcl_IncrRefCount(newObjv[i]);
|
||||
}
|
||||
memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
|
||||
memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc);
|
||||
|
||||
/*
|
||||
* Look up and invoke the handler (by recursive call to this function). If
|
||||
@@ -5046,7 +5047,7 @@ TclEvalEx(
|
||||
* the embedded command, which is refered to
|
||||
* by 'script'. The 'clNextOuter' refers to
|
||||
* the current entry in the table of
|
||||
* continuation lines in this "master script",
|
||||
* continuation lines in this "main script",
|
||||
* and the character offsets are relative to
|
||||
* the 'outerScript' as well.
|
||||
*
|
||||
@@ -5505,7 +5506,7 @@ TclAdvanceLines(
|
||||
const char *start,
|
||||
const char *end)
|
||||
{
|
||||
register const char *p;
|
||||
const char *p;
|
||||
|
||||
for (p = start; p < end; p++) {
|
||||
if (*p == '\n') {
|
||||
@@ -6030,7 +6031,7 @@ int
|
||||
Tcl_EvalObjEx(
|
||||
Tcl_Interp *interp, /* Token for command interpreter (returned by
|
||||
* a previous call to Tcl_CreateInterp). */
|
||||
register Tcl_Obj *objPtr, /* Pointer to object containing commands to
|
||||
Tcl_Obj *objPtr, /* Pointer to object containing commands to
|
||||
* execute. */
|
||||
int flags) /* Collection of OR-ed bits that control the
|
||||
* evaluation of the script. Supported values
|
||||
@@ -6043,7 +6044,7 @@ int
|
||||
TclEvalObjEx(
|
||||
Tcl_Interp *interp, /* Token for command interpreter (returned by
|
||||
* a previous call to Tcl_CreateInterp). */
|
||||
register Tcl_Obj *objPtr, /* Pointer to object containing commands to
|
||||
Tcl_Obj *objPtr, /* Pointer to object containing commands to
|
||||
* execute. */
|
||||
int flags, /* Collection of OR-ed bits that control the
|
||||
* evaluation of the script. Supported values
|
||||
@@ -6062,7 +6063,7 @@ int
|
||||
TclNREvalObjEx(
|
||||
Tcl_Interp *interp, /* Token for command interpreter (returned by
|
||||
* a previous call to Tcl_CreateInterp). */
|
||||
register Tcl_Obj *objPtr, /* Pointer to object containing commands to
|
||||
Tcl_Obj *objPtr, /* Pointer to object containing commands to
|
||||
* execute. */
|
||||
int flags, /* Collection of OR-ed bits that control the
|
||||
* evaluation of the script. Supported values
|
||||
@@ -6370,7 +6371,7 @@ Tcl_ExprLong(
|
||||
const char *exprstring, /* Expression to evaluate. */
|
||||
long *ptr) /* Where to store result. */
|
||||
{
|
||||
register Tcl_Obj *exprPtr;
|
||||
Tcl_Obj *exprPtr;
|
||||
int result = TCL_OK;
|
||||
if (*exprstring == '\0') {
|
||||
/*
|
||||
@@ -6397,7 +6398,7 @@ Tcl_ExprDouble(
|
||||
const char *exprstring, /* Expression to evaluate. */
|
||||
double *ptr) /* Where to store result. */
|
||||
{
|
||||
register Tcl_Obj *exprPtr;
|
||||
Tcl_Obj *exprPtr;
|
||||
int result = TCL_OK;
|
||||
|
||||
if (*exprstring == '\0') {
|
||||
@@ -6477,7 +6478,7 @@ int
|
||||
Tcl_ExprLongObj(
|
||||
Tcl_Interp *interp, /* Context in which to evaluate the
|
||||
* expression. */
|
||||
register Tcl_Obj *objPtr, /* Expression to evaluate. */
|
||||
Tcl_Obj *objPtr, /* Expression to evaluate. */
|
||||
long *ptr) /* Where to store long result. */
|
||||
{
|
||||
Tcl_Obj *resultPtr;
|
||||
@@ -6525,7 +6526,7 @@ int
|
||||
Tcl_ExprDoubleObj(
|
||||
Tcl_Interp *interp, /* Context in which to evaluate the
|
||||
* expression. */
|
||||
register Tcl_Obj *objPtr, /* Expression to evaluate. */
|
||||
Tcl_Obj *objPtr, /* Expression to evaluate. */
|
||||
double *ptr) /* Where to store double result. */
|
||||
{
|
||||
Tcl_Obj *resultPtr;
|
||||
@@ -6561,7 +6562,7 @@ int
|
||||
Tcl_ExprBooleanObj(
|
||||
Tcl_Interp *interp, /* Context in which to evaluate the
|
||||
* expression. */
|
||||
register Tcl_Obj *objPtr, /* Expression to evaluate. */
|
||||
Tcl_Obj *objPtr, /* Expression to evaluate. */
|
||||
int *ptr) /* Where to store 0/1 result. */
|
||||
{
|
||||
Tcl_Obj *resultPtr;
|
||||
@@ -6673,7 +6674,7 @@ TclNRInvoke(
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
|
||||
const char *cmdName; /* Name of the command from objv[0]. */
|
||||
Tcl_HashEntry *hPtr = NULL;
|
||||
@@ -6867,7 +6868,7 @@ Tcl_AddObjErrorInfo(
|
||||
int length) /* The number of bytes in the message. If < 0,
|
||||
* then append all bytes up to a NULL byte. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* If we are just starting to log an error, errorInfo is initialized from
|
||||
@@ -7015,7 +7016,7 @@ Tcl_GlobalEval(
|
||||
* command. */
|
||||
const char *command) /* Command to evaluate. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int result;
|
||||
CallFrame *savedVarFramePtr;
|
||||
|
||||
@@ -8006,8 +8007,8 @@ MathFuncWrongNumArgs(
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"too %s arguments for math function \"%s\"",
|
||||
(found < expected ? "few" : "many"), name));
|
||||
"%s arguments for math function \"%s\"",
|
||||
(found < expected ? "not enough" : "too many"), name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
|
||||
}
|
||||
|
||||
|
||||
+13
-13
@@ -199,7 +199,7 @@ typedef struct ByteArray {
|
||||
* array. */
|
||||
int allocated; /* The amount of space actually allocated
|
||||
* minus 1 byte. */
|
||||
unsigned char bytes[1]; /* The array of bytes. The actual size of this
|
||||
unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this
|
||||
* field depends on the 'allocated' field
|
||||
* above. */
|
||||
} ByteArray;
|
||||
@@ -334,12 +334,12 @@ Tcl_SetByteArrayObj(
|
||||
if (length < 0) {
|
||||
length = 0;
|
||||
}
|
||||
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
|
||||
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
|
||||
byteArrayPtr->used = length;
|
||||
byteArrayPtr->allocated = length;
|
||||
|
||||
if ((bytes != NULL) && (length > 0)) {
|
||||
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
|
||||
memcpy(byteArrayPtr->bytes, bytes, length);
|
||||
}
|
||||
objPtr->typePtr = &tclByteArrayType;
|
||||
SET_BYTEARRAY(objPtr, byteArrayPtr);
|
||||
@@ -460,7 +460,7 @@ SetByteArrayFromAny(
|
||||
src = TclGetStringFromObj(objPtr, &length);
|
||||
srcEnd = src + length;
|
||||
|
||||
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
|
||||
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
|
||||
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
*dst++ = UCHAR(ch);
|
||||
@@ -529,10 +529,10 @@ DupByteArrayInternalRep(
|
||||
srcArrayPtr = GET_BYTEARRAY(srcPtr);
|
||||
length = srcArrayPtr->used;
|
||||
|
||||
copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
|
||||
copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
|
||||
copyArrayPtr->used = length;
|
||||
copyArrayPtr->allocated = length;
|
||||
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
|
||||
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
|
||||
SET_BYTEARRAY(copyPtr, copyArrayPtr);
|
||||
|
||||
copyPtr->typePtr = &tclByteArrayType;
|
||||
@@ -588,12 +588,12 @@ UpdateStringOfByteArray(
|
||||
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
|
||||
}
|
||||
|
||||
dst = ckalloc(size + 1);
|
||||
dst = (char *)ckalloc(size + 1);
|
||||
objPtr->bytes = dst;
|
||||
objPtr->length = size;
|
||||
|
||||
if (size == length) {
|
||||
memcpy(dst, src, (size_t) size);
|
||||
memcpy(dst, src, size);
|
||||
dst[size] = '\0';
|
||||
} else {
|
||||
for (i = 0; i < length; i++) {
|
||||
@@ -945,7 +945,7 @@ BinaryFormatCmd(
|
||||
|
||||
resultPtr = Tcl_NewObj();
|
||||
buffer = Tcl_SetByteArrayLength(resultPtr, length);
|
||||
memset(buffer, 0, (size_t) length);
|
||||
memset(buffer, 0, length);
|
||||
|
||||
/*
|
||||
* Pack the data into the result object. Note that we can skip the error
|
||||
@@ -982,10 +982,10 @@ BinaryFormatCmd(
|
||||
count = 1;
|
||||
}
|
||||
if (length >= count) {
|
||||
memcpy(cursor, bytes, (size_t) count);
|
||||
memcpy(cursor, bytes, count);
|
||||
} else {
|
||||
memcpy(cursor, bytes, (size_t) length);
|
||||
memset(cursor + length, pad, (size_t) (count - length));
|
||||
memcpy(cursor, bytes, length);
|
||||
memset(cursor + length, pad, count - length);
|
||||
}
|
||||
cursor += count;
|
||||
break;
|
||||
@@ -1174,7 +1174,7 @@ BinaryFormatCmd(
|
||||
if (count == BINARY_NOCOUNT) {
|
||||
count = 1;
|
||||
}
|
||||
memset(cursor, 0, (size_t) count);
|
||||
memset(cursor, 0, count);
|
||||
cursor += count;
|
||||
break;
|
||||
case 'X':
|
||||
|
||||
@@ -406,7 +406,7 @@ Tcl_DbCkalloc(
|
||||
|
||||
/* Don't let size argument to TclpAlloc overflow */
|
||||
if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
|
||||
result = (struct mem_header *) TclpAlloc((unsigned)size +
|
||||
result = (struct mem_header *) TclpAlloc(size +
|
||||
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
|
||||
}
|
||||
if (result == NULL) {
|
||||
@@ -496,7 +496,7 @@ Tcl_AttemptDbCkalloc(
|
||||
|
||||
/* Don't let size argument to TclpAlloc overflow */
|
||||
if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
|
||||
result = (struct mem_header *) TclpAlloc((unsigned)size +
|
||||
result = (struct mem_header *) TclpAlloc(size +
|
||||
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
|
||||
}
|
||||
if (result == NULL) {
|
||||
@@ -623,7 +623,7 @@ Tcl_DbCkfree(
|
||||
Tcl_MutexLock(ckallocMutexPtr);
|
||||
ValidateMemory(memp, file, line, TRUE);
|
||||
if (init_malloced_bodies) {
|
||||
memset(ptr, GUARD_VALUE, (size_t) memp->length);
|
||||
memset(ptr, GUARD_VALUE, memp->length);
|
||||
}
|
||||
|
||||
total_frees++;
|
||||
@@ -693,7 +693,7 @@ Tcl_DbCkrealloc(
|
||||
copySize = memp->length;
|
||||
}
|
||||
newPtr = Tcl_DbCkalloc(size, file, line);
|
||||
memcpy(newPtr, ptr, (size_t) copySize);
|
||||
memcpy(newPtr, ptr, copySize);
|
||||
Tcl_DbCkfree(ptr, file, line);
|
||||
return newPtr;
|
||||
}
|
||||
@@ -727,7 +727,7 @@ Tcl_AttemptDbCkrealloc(
|
||||
if (newPtr == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
memcpy(newPtr, ptr, (size_t) copySize);
|
||||
memcpy(newPtr, ptr, copySize);
|
||||
Tcl_DbCkfree(ptr, file, line);
|
||||
return newPtr;
|
||||
}
|
||||
@@ -1324,7 +1324,7 @@ TclFinalizeMemorySubsystem(void)
|
||||
Tcl_MutexUnlock(ckallocMutexPtr);
|
||||
#endif
|
||||
|
||||
#if USE_TCLALLOC
|
||||
#if defined(USE_TCLALLOC) && USE_TCLALLOC
|
||||
TclFinalizeAllocSubsystem();
|
||||
#endif
|
||||
}
|
||||
|
||||
+1
-1
@@ -263,7 +263,7 @@ TclClockInit(
|
||||
};
|
||||
|
||||
/*
|
||||
* Safe interps get [::clock] as alias to a master, so do not need their
|
||||
* Safe interps get [::clock] as alias to a parent, so do not need their
|
||||
* own copies of the support routines.
|
||||
*/
|
||||
|
||||
|
||||
+13
-12
@@ -401,7 +401,7 @@ Tcl_IncrObjCmd(
|
||||
if (objc == 3) {
|
||||
incrPtr = objv[2];
|
||||
} else {
|
||||
incrPtr = Tcl_NewIntObj(1);
|
||||
TclNewIntObj(incrPtr, 1);
|
||||
}
|
||||
Tcl_IncrRefCount(incrPtr);
|
||||
newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
|
||||
@@ -719,7 +719,7 @@ InfoCommandsCmd(
|
||||
if (entryPtr != NULL) {
|
||||
if (specificNsInPattern) {
|
||||
cmd = Tcl_GetHashValue(entryPtr);
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
|
||||
} else {
|
||||
cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
|
||||
@@ -770,7 +770,7 @@ InfoCommandsCmd(
|
||||
|| Tcl_StringMatch(cmdName, simplePattern)) {
|
||||
if (specificNsInPattern) {
|
||||
cmd = Tcl_GetHashValue(entryPtr);
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
|
||||
} else {
|
||||
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
|
||||
@@ -997,8 +997,9 @@ InfoDefaultCmd(
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
|
||||
} else {
|
||||
Tcl_Obj *nullObjPtr = Tcl_NewObj();
|
||||
Tcl_Obj *nullObjPtr;
|
||||
|
||||
TclNewObj(nullObjPtr);
|
||||
valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
|
||||
nullObjPtr, TCL_LEAVE_ERR_MSG);
|
||||
if (valueObjPtr == NULL) {
|
||||
@@ -1054,7 +1055,7 @@ InfoErrorStackCmd(
|
||||
|
||||
target = interp;
|
||||
if (objc == 2) {
|
||||
target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
|
||||
target = Tcl_GetChild(interp, Tcl_GetString(objv[1]));
|
||||
if (target == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1908,7 +1909,7 @@ InfoProcsCmd(
|
||||
} else {
|
||||
simpleProcOK:
|
||||
if (specificNsInPattern) {
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
|
||||
elemObjPtr);
|
||||
} else {
|
||||
@@ -1936,7 +1937,7 @@ InfoProcsCmd(
|
||||
} else {
|
||||
procOK:
|
||||
if (specificNsInPattern) {
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
|
||||
elemObjPtr);
|
||||
} else {
|
||||
@@ -2169,7 +2170,7 @@ Tcl_JoinObjCmd(
|
||||
joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
|
||||
Tcl_IncrRefCount(joinObjPtr);
|
||||
|
||||
resObjPtr = Tcl_NewObj();
|
||||
TclNewObj(resObjPtr);
|
||||
for (i = 0; i < listLen; i++) {
|
||||
if (i > 0) {
|
||||
|
||||
@@ -3485,7 +3486,7 @@ Tcl_LsearchObjCmd(
|
||||
} else if (returnSubindices) {
|
||||
int j;
|
||||
|
||||
itemPtr = Tcl_NewIntObj(i);
|
||||
TclNewIntObj(itemPtr, i);
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
|
||||
TclIndexDecode(sortInfo.indexv[j], listc)));
|
||||
@@ -3507,7 +3508,7 @@ Tcl_LsearchObjCmd(
|
||||
if (returnSubindices) {
|
||||
int j;
|
||||
|
||||
itemPtr = Tcl_NewIntObj(index);
|
||||
TclNewIntObj(itemPtr, index);
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
|
||||
TclIndexDecode(sortInfo.indexv[j], listc)));
|
||||
@@ -4087,7 +4088,7 @@ Tcl_LsortObjCmd(
|
||||
idx = elementPtr->payload.index;
|
||||
for (j = 0; j < groupSize; j++) {
|
||||
if (indices) {
|
||||
objPtr = Tcl_NewIntObj(idx + j - groupOffset);
|
||||
TclNewIntObj(objPtr, idx + j - groupOffset);
|
||||
newArray[i++] = objPtr;
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
} else {
|
||||
@@ -4099,7 +4100,7 @@ Tcl_LsortObjCmd(
|
||||
}
|
||||
} else if (indices) {
|
||||
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
|
||||
objPtr = Tcl_NewIntObj(elementPtr->payload.index);
|
||||
TclNewIntObj(objPtr, elementPtr->payload.index);
|
||||
newArray[i++] = objPtr;
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
}
|
||||
|
||||
+17
-16
@@ -357,7 +357,7 @@ Tcl_RegexpObjCmd(
|
||||
|
||||
objc = info.nsubs + 1;
|
||||
if (all <= 1) {
|
||||
resultPtr = Tcl_NewObj();
|
||||
TclNewObj(resultPtr);
|
||||
}
|
||||
}
|
||||
for (i = 0; i < objc; i++) {
|
||||
@@ -399,7 +399,7 @@ Tcl_RegexpObjCmd(
|
||||
offset + info.matches[i].start,
|
||||
offset + info.matches[i].end - 1);
|
||||
} else {
|
||||
newPtr = Tcl_NewObj();
|
||||
TclNewObj(newPtr);
|
||||
}
|
||||
}
|
||||
if (doinline) {
|
||||
@@ -1058,7 +1058,7 @@ Tcl_SplitObjCmd(
|
||||
|
||||
stringPtr = TclGetStringFromObj(objv[1], &stringLen);
|
||||
end = stringPtr + stringLen;
|
||||
listPtr = Tcl_NewObj();
|
||||
TclNewObj(listPtr);
|
||||
|
||||
if (stringLen == 0) {
|
||||
/*
|
||||
@@ -1231,7 +1231,7 @@ StringFirstCmd(
|
||||
*/
|
||||
|
||||
if (needleLen > 0 && needleLen <= haystackLen) {
|
||||
register Tcl_UniChar *p, *end;
|
||||
Tcl_UniChar *p, *end;
|
||||
|
||||
end = haystackStr + haystackLen - needleLen + 1;
|
||||
for (p = haystackStr; p < end; p++) {
|
||||
@@ -1712,7 +1712,7 @@ StringIsCmd(
|
||||
|
||||
const char *elemStart, *nextElem;
|
||||
int lenRemain, elemSize;
|
||||
register const char *p;
|
||||
const char *p;
|
||||
|
||||
string1 = TclGetStringFromObj(objPtr, &length1);
|
||||
end = string1 + length1;
|
||||
@@ -2035,7 +2035,7 @@ StringMapCmd(
|
||||
(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
|
||||
/* Restrict max compare length. */
|
||||
(end-ustring1 >= length2) && ((length2 == 1) ||
|
||||
!strCmpFn(ustring2, ustring1, (unsigned) length2))) {
|
||||
!strCmpFn(ustring2, ustring1, length2))) {
|
||||
if (p != ustring1) {
|
||||
/*
|
||||
* Put the skipped chars onto the result first.
|
||||
@@ -2272,7 +2272,7 @@ StringReptCmd(
|
||||
* Include space for the NUL.
|
||||
*/
|
||||
|
||||
string2 = attemptckalloc((unsigned) length2 + 1);
|
||||
string2 = attemptckalloc(length2 + 1);
|
||||
if (string2 == NULL) {
|
||||
/*
|
||||
* Alloc failed. Note that in this case we try to do an error message
|
||||
@@ -2288,7 +2288,7 @@ StringReptCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
for (index = 0; index < count; index++) {
|
||||
memcpy(string2 + (length1 * index), string1, (size_t) length1);
|
||||
memcpy(string2 + (length1 * index), string1, length1);
|
||||
}
|
||||
string2[length2] = '\0';
|
||||
|
||||
@@ -2850,7 +2850,7 @@ TclStringCmp(
|
||||
* The comparison function should compare up to the minimum byte
|
||||
* length only.
|
||||
*/
|
||||
match = memCmpFn(s1, s2, (size_t) length);
|
||||
match = memCmpFn(s1, s2, length);
|
||||
}
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = s1len - s2len;
|
||||
@@ -3915,7 +3915,8 @@ TclNRSwitchObjCmd(
|
||||
rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
|
||||
rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
|
||||
} else {
|
||||
rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
|
||||
TclNewIntObj(rangeObjAry[1], -1);
|
||||
rangeObjAry[0] = rangeObjAry[1];
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -4185,9 +4186,9 @@ Tcl_TimeObjCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objs[4];
|
||||
register int i, result;
|
||||
int i, result;
|
||||
int count;
|
||||
double totalMicroSec;
|
||||
#ifndef TCL_WIDE_CLICKS
|
||||
@@ -4286,8 +4287,8 @@ Tcl_TimeRateObjCmd(
|
||||
static double measureOverhead = 0;
|
||||
/* global measure-overhead */
|
||||
double overhead = -1; /* given measure-overhead */
|
||||
register Tcl_Obj *objPtr;
|
||||
register int result, i;
|
||||
Tcl_Obj *objPtr;
|
||||
int result, i;
|
||||
Tcl_Obj *calibrate = NULL, *direct = NULL;
|
||||
TclWideMUInt count = 0; /* Holds repetition count */
|
||||
Tcl_WideInt maxms = WIDE_MIN;
|
||||
@@ -4301,7 +4302,7 @@ Tcl_TimeRateObjCmd(
|
||||
* zero (i.e., never < 1) */
|
||||
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
|
||||
* growth of execution time. */
|
||||
register Tcl_WideInt start, middle, stop;
|
||||
Tcl_WideInt start, middle, stop;
|
||||
#ifndef TCL_WIDE_CLICKS
|
||||
Tcl_Time now;
|
||||
#endif /* !TCL_WIDE_CLICKS */
|
||||
@@ -4857,7 +4858,7 @@ TclNRTryObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
bodyObj = objv[1];
|
||||
handlersObj = Tcl_NewObj();
|
||||
TclNewObj(handlersObj);
|
||||
bodyShared = 0;
|
||||
haveHandlers = 0;
|
||||
for (i=2 ; i<objc ; i++) {
|
||||
|
||||
+10
-10
@@ -403,9 +403,9 @@ TclCompileArraySetCmd(
|
||||
keyVar = AnonymousLocal(envPtr);
|
||||
valVar = AnonymousLocal(envPtr);
|
||||
|
||||
infoPtr = ckalloc(sizeof(ForeachInfo));
|
||||
infoPtr = ckalloc(TclOffset(ForeachInfo, varLists) + sizeof(ForeachVarList *));
|
||||
infoPtr->numLists = 1;
|
||||
infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
|
||||
infoPtr->varLists[0] = ckalloc(TclOffset(ForeachVarList, varIndexes) + 2 * sizeof(int));
|
||||
infoPtr->varLists[0]->numVars = 2;
|
||||
infoPtr->varLists[0]->varIndexes[0] = keyVar;
|
||||
infoPtr->varLists[0]->varIndexes[1] = valVar;
|
||||
@@ -1776,7 +1776,7 @@ TclCompileDictUpdateCmd(
|
||||
* that are to be used.
|
||||
*/
|
||||
|
||||
duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
|
||||
duiPtr = ckalloc(TclOffset(DictUpdateInfo, varIndices) + sizeof(int) * numVars);
|
||||
duiPtr->length = numVars;
|
||||
keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
|
||||
tokenPtr = TokenAfter(dictVarTokenPtr);
|
||||
@@ -2258,7 +2258,7 @@ DupDictUpdateInfo(
|
||||
unsigned len;
|
||||
|
||||
dui1Ptr = clientData;
|
||||
len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
|
||||
len = TclOffset(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length;
|
||||
dui2Ptr = ckalloc(len);
|
||||
memcpy(dui2Ptr, dui1Ptr, len);
|
||||
return dui2Ptr;
|
||||
@@ -2712,8 +2712,8 @@ CompileEachloopCmd(
|
||||
*/
|
||||
|
||||
numLists = (numWords - 2)/2;
|
||||
infoPtr = ckalloc(sizeof(ForeachInfo)
|
||||
+ (numLists - 1) * sizeof(ForeachVarList *));
|
||||
infoPtr = ckalloc(TclOffset(ForeachInfo, varLists)
|
||||
+ numLists * sizeof(ForeachVarList *));
|
||||
infoPtr->numLists = 0; /* Count this up as we go */
|
||||
|
||||
/*
|
||||
@@ -2746,8 +2746,8 @@ CompileEachloopCmd(
|
||||
goto done;
|
||||
}
|
||||
|
||||
varListPtr = ckalloc(sizeof(ForeachVarList)
|
||||
+ (numVars - 1) * sizeof(int));
|
||||
varListPtr = ckalloc(TclOffset(ForeachVarList, varIndexes)
|
||||
+ numVars * sizeof(int));
|
||||
varListPtr->numVars = numVars;
|
||||
infoPtr->varLists[i/2] = varListPtr;
|
||||
infoPtr->numLists++;
|
||||
@@ -2882,7 +2882,7 @@ DupForeachInfo(
|
||||
ForeachVarList *srcListPtr, *dupListPtr;
|
||||
int numVars, i, j, numLists = srcPtr->numLists;
|
||||
|
||||
dupPtr = ckalloc(sizeof(ForeachInfo)
|
||||
dupPtr = ckalloc(TclOffset(ForeachInfo, varLists)
|
||||
+ numLists * sizeof(ForeachVarList *));
|
||||
dupPtr->numLists = numLists;
|
||||
dupPtr->firstValueTemp = srcPtr->firstValueTemp;
|
||||
@@ -2891,7 +2891,7 @@ DupForeachInfo(
|
||||
for (i = 0; i < numLists; i++) {
|
||||
srcListPtr = srcPtr->varLists[i];
|
||||
numVars = srcListPtr->numVars;
|
||||
dupListPtr = ckalloc(sizeof(ForeachVarList)
|
||||
dupListPtr = ckalloc(TclOffset(ForeachVarList, varIndexes)
|
||||
+ numVars * sizeof(int));
|
||||
dupListPtr->numVars = numVars;
|
||||
for (j = 0; j < numVars; j++) {
|
||||
|
||||
@@ -881,7 +881,7 @@ TclCompileLappendCmd(
|
||||
*/
|
||||
|
||||
if (numWords > 2) {
|
||||
Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
|
||||
valueTokenPtr = TokenAfter(varTokenPtr);
|
||||
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 2);
|
||||
}
|
||||
@@ -1073,7 +1073,7 @@ TclCompileLindexCmd(
|
||||
int i, idx, numWords = parsePtr->numWords;
|
||||
|
||||
/*
|
||||
* Quit if too few args.
|
||||
* Quit if not enough args.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
@@ -2119,7 +2119,7 @@ TclCompileRegexpCmd(
|
||||
sawLast++;
|
||||
i++;
|
||||
break;
|
||||
} else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
|
||||
} else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) {
|
||||
nocase = 1;
|
||||
} else {
|
||||
/*
|
||||
|
||||
@@ -756,7 +756,7 @@ TclCompileStringMatchCmd(
|
||||
}
|
||||
str = tokenPtr[1].start;
|
||||
length = tokenPtr[1].size;
|
||||
if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
|
||||
if ((length <= 1) || strncmp(str, "-nocase", length)) {
|
||||
/*
|
||||
* Fail at run time, not in compilation.
|
||||
*/
|
||||
|
||||
+11
-11
@@ -2068,7 +2068,7 @@ ParseLexeme(
|
||||
} else {
|
||||
char utfBytes[TCL_UTF_MAX];
|
||||
|
||||
memcpy(utfBytes, start, (size_t) numBytes);
|
||||
memcpy(utfBytes, start, numBytes);
|
||||
utfBytes[numBytes] = '\0';
|
||||
scanned = TclUtfToUniChar(utfBytes, &ch);
|
||||
}
|
||||
@@ -2424,8 +2424,8 @@ CompileExprTree(
|
||||
if (optimize) {
|
||||
int length;
|
||||
const char *bytes = TclGetStringFromObj(literal, &length);
|
||||
int index = TclRegisterNewLiteral(envPtr, bytes, length);
|
||||
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
|
||||
int idx = TclRegisterNewLiteral(envPtr, bytes, length);
|
||||
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);
|
||||
|
||||
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
|
||||
/*
|
||||
@@ -2445,7 +2445,7 @@ CompileExprTree(
|
||||
objPtr->internalRep = literal->internalRep;
|
||||
literal->typePtr = NULL;
|
||||
}
|
||||
TclEmitPush(index, envPtr);
|
||||
TclEmitPush(idx, envPtr);
|
||||
} else {
|
||||
/*
|
||||
* When optimize==0, we know the expression is a one-off and
|
||||
@@ -2471,7 +2471,7 @@ CompileExprTree(
|
||||
|
||||
if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
|
||||
== TCL_OK) {
|
||||
int index;
|
||||
int idx;
|
||||
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
|
||||
|
||||
/*
|
||||
@@ -2482,9 +2482,9 @@ CompileExprTree(
|
||||
if (objPtr->bytes) {
|
||||
Tcl_Obj *tableValue;
|
||||
|
||||
index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
|
||||
idx = TclRegisterNewLiteral(envPtr, objPtr->bytes,
|
||||
objPtr->length);
|
||||
tableValue = TclFetchLiteral(envPtr, index);
|
||||
tableValue = TclFetchLiteral(envPtr, idx);
|
||||
if ((tableValue->typePtr == NULL) &&
|
||||
(objPtr->typePtr != NULL)) {
|
||||
/*
|
||||
@@ -2496,9 +2496,9 @@ CompileExprTree(
|
||||
objPtr->typePtr = NULL;
|
||||
}
|
||||
} else {
|
||||
index = TclAddLiteralObj(envPtr, objPtr, NULL);
|
||||
idx = TclAddLiteralObj(envPtr, objPtr, NULL);
|
||||
}
|
||||
TclEmitPush(index, envPtr);
|
||||
TclEmitPush(idx, envPtr);
|
||||
} else {
|
||||
TclCompileSyntaxError(interp, envPtr);
|
||||
}
|
||||
@@ -2689,7 +2689,7 @@ TclVariadicOpCmd(
|
||||
Tcl_Obj *const *litObjPtrPtr = litObjv;
|
||||
|
||||
if (lexeme == EXPON) {
|
||||
litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
|
||||
TclNewIntObj(litObjv[1], occdPtr->i.identity);
|
||||
Tcl_IncrRefCount(litObjv[1]);
|
||||
decrMe = 1;
|
||||
litObjv[0] = objv[1];
|
||||
@@ -2705,7 +2705,7 @@ TclVariadicOpCmd(
|
||||
if (lexeme == DIVIDE) {
|
||||
litObjv[0] = Tcl_NewDoubleObj(1.0);
|
||||
} else {
|
||||
litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
|
||||
TclNewIntObj(litObjv[0], occdPtr->i.identity);
|
||||
}
|
||||
Tcl_IncrRefCount(litObjv[0]);
|
||||
litObjv[1] = objv[1];
|
||||
|
||||
@@ -827,7 +827,7 @@ TclSetByteCodeFromAny(
|
||||
* faster code in some cases, and more compact code in more.
|
||||
*/
|
||||
|
||||
if (Tcl_GetMaster(interp) == NULL &&
|
||||
if (Tcl_GetParent(interp) == NULL &&
|
||||
!Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
|
||||
&& IsCompactibleCompileEnv(interp, &compEnv)) {
|
||||
TclFreeCompileEnv(&compEnv);
|
||||
@@ -2820,7 +2820,7 @@ TclInitByteCodeObj(
|
||||
|
||||
p += sizeof(ByteCode);
|
||||
codePtr->codeStart = p;
|
||||
memcpy(p, envPtr->codeStart, (size_t) codeBytes);
|
||||
memcpy(p, envPtr->codeStart, codeBytes);
|
||||
|
||||
p += TCL_ALIGN(codeBytes); /* align object array */
|
||||
codePtr->objArrayPtr = (Tcl_Obj **) p;
|
||||
@@ -2853,7 +2853,7 @@ TclInitByteCodeObj(
|
||||
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
|
||||
if (exceptArrayBytes > 0) {
|
||||
codePtr->exceptArrayPtr = (ExceptionRange *) p;
|
||||
memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
|
||||
memcpy(p, envPtr->exceptArrayPtr, exceptArrayBytes);
|
||||
} else {
|
||||
codePtr->exceptArrayPtr = NULL;
|
||||
}
|
||||
@@ -2861,7 +2861,7 @@ TclInitByteCodeObj(
|
||||
p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
|
||||
if (auxDataArrayBytes > 0) {
|
||||
codePtr->auxDataArrayPtr = (AuxData *) p;
|
||||
memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
|
||||
memcpy(p, envPtr->auxDataArrayPtr, auxDataArrayBytes);
|
||||
} else {
|
||||
codePtr->auxDataArrayPtr = NULL;
|
||||
}
|
||||
@@ -2996,7 +2996,7 @@ TclFindCompiledLocal(
|
||||
char *localName = localPtr->name;
|
||||
|
||||
if ((nameBytes == localPtr->nameLength) &&
|
||||
(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
|
||||
(strncmp(name, localName, nameBytes) == 0)) {
|
||||
return i;
|
||||
}
|
||||
}
|
||||
@@ -3028,7 +3028,7 @@ TclFindCompiledLocal(
|
||||
localPtr->resolveInfo = NULL;
|
||||
|
||||
if (name != NULL) {
|
||||
memcpy(localPtr->name, name, (size_t) nameBytes);
|
||||
memcpy(localPtr->name, name, nameBytes);
|
||||
}
|
||||
localPtr->name[nameBytes] = '\0';
|
||||
procPtr->numCompiledLocals++;
|
||||
|
||||
@@ -966,7 +966,7 @@ typedef struct JumpFixupArray {
|
||||
|
||||
typedef struct ForeachVarList {
|
||||
int numVars; /* The number of variables in the list. */
|
||||
int varIndexes[1]; /* An array of the indexes ("slot numbers")
|
||||
int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")
|
||||
* for each variable in the procedure's array
|
||||
* of local variables. Only scalar variables
|
||||
* are supported. The actual size of this
|
||||
@@ -990,7 +990,7 @@ typedef struct ForeachInfo {
|
||||
* the loop's iteration count. Used to
|
||||
* determine next value list element to assign
|
||||
* each loop var. */
|
||||
ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
|
||||
ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList
|
||||
* structures describing each var list. The
|
||||
* actual size of this field will be large
|
||||
* enough to numVars indexes. THIS MUST BE THE
|
||||
@@ -1021,7 +1021,7 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType;
|
||||
|
||||
typedef struct {
|
||||
int length; /* Size of array */
|
||||
int varIndices[1]; /* Array of variable indices to manage when
|
||||
int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when
|
||||
* processing the start and end of a [dict
|
||||
* update]. There is really more than one
|
||||
* entry, and the structure is allocated to
|
||||
|
||||
+9
-9
@@ -2501,12 +2501,12 @@ TclDateerror(
|
||||
Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
|
||||
Tcl_AppendToObj(infoPtr->messages, s, -1);
|
||||
Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
|
||||
t = Tcl_NewIntObj(location->first_column);
|
||||
TclNewIntObj(t, location->first_column);
|
||||
Tcl_IncrRefCount(t);
|
||||
Tcl_AppendObjToObj(infoPtr->messages, t);
|
||||
Tcl_DecrRefCount(t);
|
||||
Tcl_AppendToObj(infoPtr->messages, "-", -1);
|
||||
t = Tcl_NewIntObj(location->last_column);
|
||||
TclNewIntObj(t, location->last_column);
|
||||
Tcl_IncrRefCount(t);
|
||||
Tcl_AppendObjToObj(infoPtr->messages, t);
|
||||
Tcl_DecrRefCount(t);
|
||||
@@ -2788,7 +2788,7 @@ TclClockOldscanObjCmd(
|
||||
yyHaveRel = 0;
|
||||
yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
|
||||
|
||||
dateInfo.messages = Tcl_NewObj();
|
||||
TclNewObj(dateInfo.messages);
|
||||
dateInfo.separatrix = "";
|
||||
Tcl_IncrRefCount(dateInfo.messages);
|
||||
|
||||
@@ -2845,8 +2845,8 @@ TclClockOldscanObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
result = Tcl_NewObj();
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(result);
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveDate) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyYear));
|
||||
@@ -2864,7 +2864,7 @@ TclClockOldscanObjCmd(
|
||||
Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
|
||||
}
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveZone) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) -yyTimezone));
|
||||
@@ -2873,7 +2873,7 @@ TclClockOldscanObjCmd(
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, result, resultElement);
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveRel) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyRelMonth));
|
||||
@@ -2884,7 +2884,7 @@ TclClockOldscanObjCmd(
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, result, resultElement);
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveDay && !yyHaveDate) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyDayOrdinal));
|
||||
@@ -2893,7 +2893,7 @@ TclClockOldscanObjCmd(
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, result, resultElement);
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveOrdinalMonth) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyMonthOrdinal));
|
||||
|
||||
+20
-18
@@ -279,13 +279,13 @@ EXTERN int Tcl_ConvertElement(const char *src, char *dst,
|
||||
EXTERN int Tcl_ConvertCountedElement(const char *src,
|
||||
int length, char *dst, int flags);
|
||||
/* 86 */
|
||||
EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
|
||||
const char *slaveCmd, Tcl_Interp *target,
|
||||
EXTERN int Tcl_CreateAlias(Tcl_Interp *childInterp,
|
||||
const char *childCmd, Tcl_Interp *target,
|
||||
const char *targetCmd, int argc,
|
||||
CONST84 char *const *argv);
|
||||
/* 87 */
|
||||
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
|
||||
const char *slaveCmd, Tcl_Interp *target,
|
||||
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *childInterp,
|
||||
const char *childCmd, Tcl_Interp *target,
|
||||
const char *targetCmd, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
/* 88 */
|
||||
@@ -323,8 +323,8 @@ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
/* 97 */
|
||||
EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp,
|
||||
const char *slaveName, int isSafe);
|
||||
EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
|
||||
int isSafe);
|
||||
/* 98 */
|
||||
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
|
||||
Tcl_TimerProc *proc, ClientData clientData);
|
||||
@@ -458,13 +458,13 @@ EXTERN int Tcl_Flush(Tcl_Channel chan);
|
||||
EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
|
||||
/* 148 */
|
||||
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
|
||||
const char *slaveCmd,
|
||||
const char *childCmd,
|
||||
Tcl_Interp **targetInterpPtr,
|
||||
CONST84 char **targetCmdPtr, int *argcPtr,
|
||||
CONST84 char ***argvPtr);
|
||||
/* 149 */
|
||||
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
|
||||
const char *slaveCmd,
|
||||
const char *childCmd,
|
||||
Tcl_Interp **targetInterpPtr,
|
||||
CONST84 char **targetCmdPtr, int *objcPtr,
|
||||
Tcl_Obj ***objv);
|
||||
@@ -504,7 +504,7 @@ EXTERN int Tcl_GetErrno(void);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
|
||||
/* 163 */
|
||||
EXTERN int Tcl_GetInterpPath(Tcl_Interp *interp,
|
||||
Tcl_Interp *slaveInterp);
|
||||
Tcl_Interp *childInterp);
|
||||
/* 164 */
|
||||
EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
|
||||
/* 165 */
|
||||
@@ -532,8 +532,7 @@ EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
|
||||
/* 171 */
|
||||
EXTERN int Tcl_GetServiceMode(void);
|
||||
/* 172 */
|
||||
EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
|
||||
const char *slaveName);
|
||||
EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *name);
|
||||
/* 173 */
|
||||
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
|
||||
/* 174 */
|
||||
@@ -1949,8 +1948,8 @@ typedef struct TclStubs {
|
||||
char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
|
||||
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
|
||||
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
|
||||
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
|
||||
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
|
||||
int (*tcl_CreateAlias) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
|
||||
int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
|
||||
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
|
||||
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
|
||||
void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
|
||||
@@ -1960,7 +1959,7 @@ typedef struct TclStubs {
|
||||
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
|
||||
void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
|
||||
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
|
||||
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
|
||||
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
|
||||
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
|
||||
Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
|
||||
void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
|
||||
@@ -2011,8 +2010,8 @@ typedef struct TclStubs {
|
||||
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
|
||||
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
|
||||
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
|
||||
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
|
||||
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
|
||||
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
|
||||
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
|
||||
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
|
||||
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
|
||||
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
|
||||
@@ -2026,7 +2025,7 @@ typedef struct TclStubs {
|
||||
CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
|
||||
int (*tcl_GetErrno) (void); /* 161 */
|
||||
CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
|
||||
int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *slaveInterp); /* 163 */
|
||||
int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */
|
||||
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
|
||||
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
|
||||
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
|
||||
@@ -2043,7 +2042,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
|
||||
int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
|
||||
int (*tcl_GetServiceMode) (void); /* 171 */
|
||||
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
|
||||
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *name); /* 172 */
|
||||
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
|
||||
CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
|
||||
CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
@@ -3974,5 +3973,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
#undef Tcl_GlobalEvalObj
|
||||
#define Tcl_GlobalEvalObj(interp,objPtr) \
|
||||
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
|
||||
#define Tcl_CreateChild Tcl_CreateSlave
|
||||
#define Tcl_GetChild Tcl_GetSlave
|
||||
#define Tcl_GetParent Tcl_GetMaster
|
||||
|
||||
#endif /* _TCLDECLS */
|
||||
|
||||
@@ -2142,8 +2142,9 @@ DictIncrCmd(
|
||||
if (objc == 4) {
|
||||
code = TclIncrObj(interp, valuePtr, objv[3]);
|
||||
} else {
|
||||
Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
|
||||
Tcl_Obj *incrPtr;
|
||||
|
||||
TclNewIntObj(incrPtr, 1);
|
||||
Tcl_IncrRefCount(incrPtr);
|
||||
code = TclIncrObj(interp, valuePtr, incrPtr);
|
||||
TclDecrRefCount(incrPtr);
|
||||
|
||||
@@ -116,7 +116,7 @@ typedef struct {
|
||||
* entry in this array is 1, otherwise it is
|
||||
* 0. */
|
||||
int numSubTables; /* Length of following array. */
|
||||
EscapeSubTable subTables[1];/* Information about each EscapeSubTable used
|
||||
EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used
|
||||
* by this encoding type. The actual size is
|
||||
* as large as necessary to hold all
|
||||
* EscapeSubTables. */
|
||||
@@ -2039,7 +2039,7 @@ LoadEscapeEncoding(
|
||||
Tcl_DStringFree(&lineString);
|
||||
}
|
||||
|
||||
size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
|
||||
size = TclOffset(EscapeEncodingData, subTables)
|
||||
+ Tcl_DStringLength(&escapeData);
|
||||
dataPtr = (EscapeEncodingData *)ckalloc(size);
|
||||
dataPtr->initLen = strlen(init);
|
||||
|
||||
+3
-3
@@ -1043,9 +1043,9 @@ TclInitSubsystems(void)
|
||||
* implementation of self-initializing locks.
|
||||
*/
|
||||
|
||||
TclInitThreadStorage(); /* Creates master hash table for
|
||||
TclInitThreadStorage(); /* Creates hash table for
|
||||
* thread local storage */
|
||||
#if USE_TCLALLOC
|
||||
#if defined(USE_TCLALLOC) && USE_TCLALLOC
|
||||
TclInitAlloc(); /* Process wide mutex init */
|
||||
#endif
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
@@ -1157,7 +1157,7 @@ Tcl_Finalize(void)
|
||||
TclFinalizeFilesystem();
|
||||
|
||||
/*
|
||||
* Undo all Tcl_ObjType registrations, and reset the master list of free
|
||||
* Undo all Tcl_ObjType registrations, and reset the global list of free
|
||||
* Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
|
||||
* freed.
|
||||
*
|
||||
|
||||
+26
-26
@@ -914,8 +914,8 @@ TclCreateExecEnv(
|
||||
* [sizeof(Tcl_Obj*)] */
|
||||
{
|
||||
ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
|
||||
ExecStack *esPtr = ckalloc(sizeof(ExecStack)
|
||||
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
|
||||
ExecStack *esPtr = ckalloc(TclOffset(ExecStack, stackWords)
|
||||
+ size * sizeof(Tcl_Obj *));
|
||||
|
||||
eePtr->execStackPtr = esPtr;
|
||||
TclNewBooleanObj(eePtr->constants[0], 0);
|
||||
@@ -1180,7 +1180,7 @@ GrowEvaluationStack(
|
||||
newElems = needed;
|
||||
#endif
|
||||
|
||||
newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
|
||||
newBytes = TclOffset(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);
|
||||
|
||||
oldPtr = esPtr;
|
||||
esPtr = ckalloc(newBytes);
|
||||
@@ -1407,7 +1407,7 @@ int
|
||||
Tcl_ExprObj(
|
||||
Tcl_Interp *interp, /* Context in which to evaluate the
|
||||
* expression. */
|
||||
register Tcl_Obj *objPtr, /* Points to Tcl object containing expression
|
||||
Tcl_Obj *objPtr, /* Points to Tcl object containing expression
|
||||
* to evaluate. */
|
||||
Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression
|
||||
* result is stored if no errors occur. */
|
||||
@@ -1526,7 +1526,7 @@ CompileExprObj(
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
CompileEnv compEnv; /* Compilation environment structure allocated
|
||||
* in frame. */
|
||||
register ByteCode *codePtr = NULL;
|
||||
ByteCode *codePtr = NULL;
|
||||
/* Tcl Internal type of bytecode. Initialized
|
||||
* to avoid compiler warning. */
|
||||
|
||||
@@ -1680,8 +1680,8 @@ TclCompileObj(
|
||||
const CmdFrame *invoker,
|
||||
int word)
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
ByteCode *codePtr; /* Tcl Internal type of bytecode. */
|
||||
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
|
||||
|
||||
/*
|
||||
@@ -2838,7 +2838,7 @@ TEBCresume(
|
||||
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
|
||||
bytes = TclGetStringFromObj(*currPtr, &length);
|
||||
if (bytes != NULL) {
|
||||
memcpy(p, bytes, (size_t) length);
|
||||
memcpy(p, bytes, length);
|
||||
p += length;
|
||||
}
|
||||
}
|
||||
@@ -2873,7 +2873,7 @@ TEBCresume(
|
||||
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
|
||||
if ((*currPtr)->bytes != tclEmptyStringRep) {
|
||||
bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
|
||||
memcpy(p, bytes, (size_t) length);
|
||||
memcpy(p, bytes, length);
|
||||
p += length;
|
||||
}
|
||||
}
|
||||
@@ -3854,7 +3854,7 @@ TEBCresume(
|
||||
case INST_INCR_SCALAR_STK_IMM:
|
||||
case INST_INCR_STK_IMM:
|
||||
increment = TclGetInt1AtPtr(pc+1);
|
||||
incrPtr = Tcl_NewIntObj(increment);
|
||||
TclNewIntObj(incrPtr, increment);
|
||||
Tcl_IncrRefCount(incrPtr);
|
||||
pcAdjustment = 2;
|
||||
|
||||
@@ -3889,7 +3889,7 @@ TEBCresume(
|
||||
case INST_INCR_ARRAY1_IMM:
|
||||
opnd = TclGetUInt1AtPtr(pc+1);
|
||||
increment = TclGetInt1AtPtr(pc+2);
|
||||
incrPtr = Tcl_NewIntObj(increment);
|
||||
TclNewIntObj(incrPtr, increment);
|
||||
Tcl_IncrRefCount(incrPtr);
|
||||
pcAdjustment = 3;
|
||||
|
||||
@@ -6806,8 +6806,8 @@ TEBCresume(
|
||||
if (valuePtr->typePtr == &tclBooleanType) {
|
||||
objResultPtr = TCONST(1);
|
||||
} else {
|
||||
int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
|
||||
objResultPtr = TCONST(result);
|
||||
int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
|
||||
objResultPtr = TCONST(res);
|
||||
}
|
||||
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
|
||||
NEXT_INST_F(1, 0, 1);
|
||||
@@ -7000,7 +7000,7 @@ TEBCresume(
|
||||
}
|
||||
{
|
||||
ForeachInfo *infoPtr;
|
||||
Tcl_Obj *listPtr, **elements, *tmpPtr;
|
||||
Tcl_Obj *listPtr, **elements;
|
||||
ForeachVarList *varListPtr;
|
||||
int numLists, iterMax, listLen, numVars;
|
||||
int iterTmp, iterNum, listTmpDepth;
|
||||
@@ -7286,8 +7286,8 @@ TEBCresume(
|
||||
|
||||
case INST_DICT_GET:
|
||||
case INST_DICT_EXISTS: {
|
||||
register Tcl_Interp *interp2 = interp;
|
||||
register int found;
|
||||
Tcl_Interp *interp2 = interp;
|
||||
int found;
|
||||
|
||||
opnd = TclGetUInt4AtPtr(pc+1);
|
||||
TRACE(("%u => ", opnd));
|
||||
@@ -7394,7 +7394,7 @@ TEBCresume(
|
||||
if (valuePtr == NULL) {
|
||||
Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
|
||||
} else {
|
||||
value2Ptr = Tcl_NewIntObj(opnd);
|
||||
TclNewIntObj(value2Ptr, opnd);
|
||||
Tcl_IncrRefCount(value2Ptr);
|
||||
if (Tcl_IsShared(valuePtr)) {
|
||||
valuePtr = Tcl_DuplicateObj(valuePtr);
|
||||
@@ -9599,7 +9599,7 @@ TclCompareTwoNumbers(
|
||||
|
||||
static void
|
||||
PrintByteCodeInfo(
|
||||
register ByteCode *codePtr) /* The bytecode whose summary is printed to
|
||||
ByteCode *codePtr) /* The bytecode whose summary is printed to
|
||||
* stdout. */
|
||||
{
|
||||
Proc *procPtr = codePtr->procPtr;
|
||||
@@ -9663,7 +9663,7 @@ PrintByteCodeInfo(
|
||||
#ifdef TCL_COMPILE_DEBUG
|
||||
static void
|
||||
ValidatePcAndStackTop(
|
||||
register ByteCode *codePtr, /* The bytecode whose summary is printed to
|
||||
ByteCode *codePtr, /* The bytecode whose summary is printed to
|
||||
* stdout. */
|
||||
const unsigned char *pc, /* Points to first byte of a bytecode
|
||||
* instruction. The program counter. */
|
||||
@@ -9906,7 +9906,7 @@ GetSrcInfoForPc(
|
||||
* of the command containing the pc should
|
||||
* be stored. */
|
||||
{
|
||||
register int pcOffset = (pc - codePtr->codeStart);
|
||||
int pcOffset = (pc - codePtr->codeStart);
|
||||
int numCmds = codePtr->numCommands;
|
||||
unsigned char *codeDeltaNext, *codeLengthNext;
|
||||
unsigned char *srcDeltaNext, *srcLengthNext;
|
||||
@@ -10059,9 +10059,9 @@ GetExceptRangeForPc(
|
||||
{
|
||||
ExceptionRange *rangeArrayPtr;
|
||||
int numRanges = codePtr->numExceptRanges;
|
||||
register ExceptionRange *rangePtr;
|
||||
ExceptionRange *rangePtr;
|
||||
int pcOffset = pc - codePtr->codeStart;
|
||||
register int start;
|
||||
int start;
|
||||
|
||||
if (numRanges == 0) {
|
||||
return NULL;
|
||||
@@ -10193,11 +10193,11 @@ TclExprFloatError(
|
||||
|
||||
int
|
||||
TclLog2(
|
||||
register int value) /* The integer for which to compute the log
|
||||
int value) /* The integer for which to compute the log
|
||||
* base 2. */
|
||||
{
|
||||
register int n = value;
|
||||
register int result = 0;
|
||||
int n = value;
|
||||
int result = 0;
|
||||
|
||||
while (n > 1) {
|
||||
n = n >> 1;
|
||||
@@ -10248,7 +10248,7 @@ EvalStatsCmd(
|
||||
|
||||
#define Percent(a,b) ((a) * 100.0 / (b))
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
TclNewObj(objPtr);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
|
||||
numInstructions = 0.0;
|
||||
|
||||
+1
-1
@@ -904,7 +904,7 @@ FileBasename(
|
||||
}
|
||||
}
|
||||
if (resultPtr == NULL) {
|
||||
resultPtr = Tcl_NewObj();
|
||||
TclNewObj(resultPtr);
|
||||
}
|
||||
Tcl_IncrRefCount(resultPtr);
|
||||
Tcl_DecrRefCount(splitPtr);
|
||||
|
||||
+32
-24
@@ -587,7 +587,8 @@ Tcl_SplitPath(
|
||||
* plus the argv pointers and the terminating NULL pointer.
|
||||
*/
|
||||
|
||||
*argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);
|
||||
*argvPtr = (const char **)ckalloc(
|
||||
((((*argcPtr) + 1) * sizeof(char *)) + size));
|
||||
|
||||
/*
|
||||
* Position p after the last argv pointer and copy the contents of the
|
||||
@@ -598,7 +599,7 @@ Tcl_SplitPath(
|
||||
for (i = 0; i < *argcPtr; i++) {
|
||||
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
|
||||
str = Tcl_GetStringFromObj(eltPtr, &len);
|
||||
memcpy(p, str, (size_t) len+1);
|
||||
memcpy(p, str, len + 1);
|
||||
p += len+1;
|
||||
}
|
||||
|
||||
@@ -644,12 +645,13 @@ SplitUnixPath(
|
||||
{
|
||||
int length;
|
||||
const char *origPath = path, *elementStart;
|
||||
Tcl_Obj *result = Tcl_NewObj();
|
||||
Tcl_Obj *result;
|
||||
|
||||
/*
|
||||
* Deal with the root directory as a special case.
|
||||
*/
|
||||
|
||||
TclNewObj(result);
|
||||
if (*path == '/') {
|
||||
Tcl_Obj *rootElt;
|
||||
++path;
|
||||
@@ -735,9 +737,10 @@ SplitWinPath(
|
||||
const char *p, *elementStart;
|
||||
Tcl_PathType type = TCL_PATH_ABSOLUTE;
|
||||
Tcl_DString buf;
|
||||
Tcl_Obj *result = Tcl_NewObj();
|
||||
Tcl_Obj *result;
|
||||
Tcl_DStringInit(&buf);
|
||||
|
||||
TclNewObj(result);
|
||||
p = ExtractWinRoot(path, &buf, 0, &type);
|
||||
|
||||
/*
|
||||
@@ -821,7 +824,7 @@ Tcl_FSJoinToPath(
|
||||
return TclJoinPath(2, pair, 0);
|
||||
} else {
|
||||
int elemc = objc + 1;
|
||||
Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));
|
||||
Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *));
|
||||
|
||||
elemv[0] = pathPtr;
|
||||
memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
|
||||
@@ -977,7 +980,7 @@ Tcl_JoinPath(
|
||||
Tcl_DString *resultPtr) /* Pointer to previously initialized DString */
|
||||
{
|
||||
int i, len;
|
||||
Tcl_Obj *listObj = Tcl_NewObj();
|
||||
Tcl_Obj *listObj;
|
||||
Tcl_Obj *resultObj;
|
||||
const char *resultStr;
|
||||
|
||||
@@ -985,6 +988,7 @@ Tcl_JoinPath(
|
||||
* Build the list of paths.
|
||||
*/
|
||||
|
||||
TclNewObj(listObj);
|
||||
for (i = 0; i < argc; i++) {
|
||||
Tcl_ListObjAppendElement(NULL, listObj,
|
||||
Tcl_NewStringObj(argv[i], -1));
|
||||
@@ -1072,7 +1076,7 @@ Tcl_TranslateFileName(
|
||||
*/
|
||||
|
||||
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
|
||||
register char *p;
|
||||
char *p;
|
||||
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
|
||||
if (*p == '/') {
|
||||
*p = '\\';
|
||||
@@ -1217,7 +1221,6 @@ DoTildeSubst(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Tcl_GlobObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
@@ -1235,12 +1238,13 @@ Tcl_GlobObjCmd(
|
||||
"-directory", "-join", "-nocomplain", "-path", "-tails",
|
||||
"-types", "--", NULL
|
||||
};
|
||||
enum options {
|
||||
enum globOptionsEnum {
|
||||
GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
|
||||
GLOB_TYPE, GLOB_LAST
|
||||
};
|
||||
enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
|
||||
Tcl_GlobTypeData *globTypes = NULL;
|
||||
(void)dummy;
|
||||
|
||||
globFlags = 0;
|
||||
join = 0;
|
||||
@@ -1268,7 +1272,7 @@ Tcl_GlobObjCmd(
|
||||
}
|
||||
}
|
||||
|
||||
switch (index) {
|
||||
switch ((enum globOptionsEnum) index) {
|
||||
case GLOB_NOCOMPLAIN: /* -nocomplain */
|
||||
globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
|
||||
break;
|
||||
@@ -1281,7 +1285,10 @@ Tcl_GlobObjCmd(
|
||||
}
|
||||
if (dir != PATH_NONE) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"\"-directory\" cannot be used with \"-path\"", -1));
|
||||
dir == PATH_DIR
|
||||
? "\"-directory\" may only be used once"
|
||||
: "\"-directory\" cannot be used with \"-path\"",
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
|
||||
"BADOPTIONCOMBINATION", NULL);
|
||||
return TCL_ERROR;
|
||||
@@ -1306,7 +1313,10 @@ Tcl_GlobObjCmd(
|
||||
}
|
||||
if (dir != PATH_NONE) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"\"-path\" cannot be used with \"-directory\"", -1));
|
||||
dir == PATH_GENERAL
|
||||
? "\"-path\" may only be used once"
|
||||
: "\"-path\" cannot be used with \"-dictionary\"",
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
|
||||
"BADOPTIONCOMBINATION", NULL);
|
||||
return TCL_ERROR;
|
||||
@@ -1344,7 +1354,7 @@ Tcl_GlobObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
separators = NULL; /* lint. */
|
||||
separators = NULL;
|
||||
switch (tclPlatform) {
|
||||
case TCL_PLATFORM_UNIX:
|
||||
separators = "/";
|
||||
@@ -1449,7 +1459,7 @@ Tcl_GlobObjCmd(
|
||||
if (length <= 0) {
|
||||
goto skipTypes;
|
||||
}
|
||||
globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
|
||||
globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
|
||||
globTypes->type = 0;
|
||||
globTypes->perm = 0;
|
||||
globTypes->macType = NULL;
|
||||
@@ -1680,9 +1690,8 @@ Tcl_GlobObjCmd(
|
||||
*
|
||||
* TclGlob --
|
||||
*
|
||||
* This procedure prepares arguments for the DoGlob call. It sets the
|
||||
* separator string based on the platform, performs * tilde substitution,
|
||||
* and calls DoGlob.
|
||||
* Sets the separator string based on the platform, performs tilde
|
||||
* substitution, and calls DoGlob.
|
||||
*
|
||||
* The interpreter's result, on entry to this function, must be a valid
|
||||
* Tcl list (e.g. it could be empty), since we will lappend any new
|
||||
@@ -1705,7 +1714,6 @@ Tcl_GlobObjCmd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
int
|
||||
TclGlob(
|
||||
Tcl_Interp *interp, /* Interpreter for returning error message or
|
||||
@@ -1724,7 +1732,7 @@ TclGlob(
|
||||
int result;
|
||||
Tcl_Obj *filenamesObj, *savedResultObj;
|
||||
|
||||
separators = NULL; /* lint. */
|
||||
separators = NULL;
|
||||
switch (tclPlatform) {
|
||||
case TCL_PLATFORM_UNIX:
|
||||
separators = "/";
|
||||
@@ -2077,7 +2085,7 @@ SkipToChar(
|
||||
int match) /* Character to find. */
|
||||
{
|
||||
int quoted, level;
|
||||
register char *p;
|
||||
char *p;
|
||||
|
||||
quoted = 0;
|
||||
level = 0;
|
||||
@@ -2448,7 +2456,7 @@ DoGlob(
|
||||
int len;
|
||||
const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
|
||||
|
||||
if (strchr(separators, joined[len-1]) == NULL) {
|
||||
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
|
||||
Tcl_AppendToObj(joinedPtr, "/", 1);
|
||||
}
|
||||
}
|
||||
@@ -2485,7 +2493,7 @@ DoGlob(
|
||||
int len;
|
||||
const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
|
||||
|
||||
if (strchr(separators, joined[len-1]) == NULL) {
|
||||
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
|
||||
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
|
||||
Tcl_AppendToObj(joinedPtr, "/", 1);
|
||||
}
|
||||
@@ -2523,7 +2531,7 @@ DoGlob(
|
||||
Tcl_StatBuf *
|
||||
Tcl_AllocStatBuf(void)
|
||||
{
|
||||
return ckalloc(sizeof(Tcl_StatBuf));
|
||||
return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2628,7 +2636,7 @@ Tcl_GetBlocksFromStat(
|
||||
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
|
||||
return (Tcl_WideUInt) statPtr->st_blocks;
|
||||
#else
|
||||
register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
|
||||
unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
|
||||
|
||||
return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
|
||||
#endif
|
||||
|
||||
@@ -716,12 +716,12 @@ TclDateerror(
|
||||
Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
|
||||
Tcl_AppendToObj(infoPtr->messages, s, -1);
|
||||
Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
|
||||
t = Tcl_NewIntObj(location->first_column);
|
||||
TclNewIntObj(t, location->first_column);
|
||||
Tcl_IncrRefCount(t);
|
||||
Tcl_AppendObjToObj(infoPtr->messages, t);
|
||||
Tcl_DecrRefCount(t);
|
||||
Tcl_AppendToObj(infoPtr->messages, "-", -1);
|
||||
t = Tcl_NewIntObj(location->last_column);
|
||||
TclNewIntObj(t, location->last_column);
|
||||
Tcl_IncrRefCount(t);
|
||||
Tcl_AppendObjToObj(infoPtr->messages, t);
|
||||
Tcl_DecrRefCount(t);
|
||||
@@ -1003,7 +1003,7 @@ TclClockOldscanObjCmd(
|
||||
yyHaveRel = 0;
|
||||
yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
|
||||
|
||||
dateInfo.messages = Tcl_NewObj();
|
||||
TclNewObj(dateInfo.messages);
|
||||
dateInfo.separatrix = "";
|
||||
Tcl_IncrRefCount(dateInfo.messages);
|
||||
|
||||
@@ -1060,8 +1060,8 @@ TclClockOldscanObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
result = Tcl_NewObj();
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(result);
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveDate) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyYear));
|
||||
@@ -1079,7 +1079,7 @@ TclClockOldscanObjCmd(
|
||||
Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
|
||||
}
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveZone) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) -yyTimezone));
|
||||
@@ -1088,7 +1088,7 @@ TclClockOldscanObjCmd(
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, result, resultElement);
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveRel) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyRelMonth));
|
||||
@@ -1099,7 +1099,7 @@ TclClockOldscanObjCmd(
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, result, resultElement);
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TcNewObj(resultElement);
|
||||
if (yyHaveDay && !yyHaveDate) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyDayOrdinal));
|
||||
@@ -1108,7 +1108,7 @@ TclClockOldscanObjCmd(
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, result, resultElement);
|
||||
|
||||
resultElement = Tcl_NewObj();
|
||||
TclNewObj(resultElement);
|
||||
if (yyHaveOrdinalMonth) {
|
||||
Tcl_ListObjAppendElement(interp, resultElement,
|
||||
Tcl_NewIntObj((int) yyMonthOrdinal));
|
||||
|
||||
+6
-6
@@ -287,9 +287,9 @@ static int WillRead(Channel *chanPtr);
|
||||
|
||||
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
|
||||
|
||||
#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
|
||||
#define InsertPoint(bufPtr) (&(bufPtr)->buf[(bufPtr)->nextAdded])
|
||||
|
||||
#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
|
||||
#define RemovePoint(bufPtr) (&(bufPtr)->buf[(bufPtr)->nextRemoved])
|
||||
|
||||
/*
|
||||
* For working with channel state flag bits.
|
||||
@@ -4314,7 +4314,7 @@ Write(
|
||||
* that we need to stick at the beginning of this buffer.
|
||||
*/
|
||||
|
||||
memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
|
||||
memcpy(InsertPoint(bufPtr), safe, saved);
|
||||
bufPtr->nextAdded += saved;
|
||||
saved = 0;
|
||||
}
|
||||
@@ -4711,7 +4711,7 @@ Tcl_GetsObj(
|
||||
gs.rawRead -= rawRead;
|
||||
gs.bytesWrote--;
|
||||
gs.charsWrote--;
|
||||
memmove(dst, dst + 1, (size_t) (dstEnd - dst));
|
||||
memmove(dst, dst + 1, dstEnd - dst);
|
||||
dstEnd--;
|
||||
}
|
||||
}
|
||||
@@ -7699,7 +7699,7 @@ Tcl_BadChannelOption(
|
||||
}
|
||||
Tcl_ResetResult(interp);
|
||||
errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
|
||||
optionName);
|
||||
optionName ? optionName : "");
|
||||
argc--;
|
||||
for (i = 0; i < argc; i++) {
|
||||
Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
|
||||
@@ -10475,7 +10475,7 @@ Tcl_IsChannelExisting(
|
||||
}
|
||||
|
||||
if ((*chanName == *name) &&
|
||||
(memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
|
||||
(memcmp(name, chanName, chanNameLen + 1) == 0)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
+1
-1
@@ -44,7 +44,7 @@ typedef struct ChannelBuffer {
|
||||
int bufLength; /* How big is the buffer? */
|
||||
struct ChannelBuffer *nextPtr;
|
||||
/* Next buffer in chain. */
|
||||
char buf[1]; /* Placeholder for real buffer. The real
|
||||
char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real
|
||||
* buffer occuppies this space + bufSize-1
|
||||
* bytes. This must be the last field in the
|
||||
* structure. */
|
||||
|
||||
@@ -1318,7 +1318,7 @@ ReflectInput(
|
||||
|
||||
Tcl_Preserve(rcPtr);
|
||||
|
||||
toReadObj = Tcl_NewIntObj(toRead);
|
||||
TclNewIntObj(toReadObj, toRead);
|
||||
Tcl_IncrRefCount(toReadObj);
|
||||
|
||||
if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
|
||||
@@ -2999,10 +2999,12 @@ ForwardProc(
|
||||
}
|
||||
|
||||
case ForwardedInput: {
|
||||
Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
|
||||
Tcl_IncrRefCount(toReadObj);
|
||||
Tcl_Obj *toReadObj;
|
||||
|
||||
Tcl_Preserve(rcPtr);
|
||||
TclNewIntObj(toReadObj, paramPtr->input.toRead);
|
||||
Tcl_IncrRefCount(toReadObj);
|
||||
|
||||
Tcl_Preserve(rcPtr);
|
||||
if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
|
||||
int code = ErrnoReturn(rcPtr, resObj);
|
||||
|
||||
|
||||
+3
-3
@@ -3244,7 +3244,7 @@ Tcl_LoadFile(
|
||||
}
|
||||
|
||||
if (fsPtr->loadFileProc != NULL) {
|
||||
int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
|
||||
retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
|
||||
(interp, pathPtr, handlePtr, &unloadProcPtr, flags);
|
||||
|
||||
if (retVal == TCL_OK) {
|
||||
@@ -4209,7 +4209,7 @@ TclFSNonnativePathType(
|
||||
if (pathLen < len) {
|
||||
continue;
|
||||
}
|
||||
if (strncmp(strVol, path, (size_t) len) == 0) {
|
||||
if (strncmp(strVol, path, len) == 0) {
|
||||
type = TCL_PATH_ABSOLUTE;
|
||||
if (filesystemPtrPtr != NULL) {
|
||||
*filesystemPtrPtr = fsRecPtr->fsPtr;
|
||||
@@ -4619,7 +4619,7 @@ Tcl_FSGetFileSystemForPath(
|
||||
/*
|
||||
* Check if the filesystem has changed in some way since this object's
|
||||
* internal representation was calculated. Before doing that, assure we
|
||||
* have the most up-to-date copy of the master filesystem. This is
|
||||
* have the most up-to-date copy of the first filesystem. This is
|
||||
* accomplished by the FsGetFirstFilesystem() call.
|
||||
*/
|
||||
|
||||
|
||||
@@ -903,7 +903,7 @@ declare 227 {
|
||||
# Used to be needed for TclOO-extension; unneeded now that TclOO is in the
|
||||
# core and NRE-enabled
|
||||
# declare 228 {
|
||||
# int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
|
||||
# int TclObjInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
|
||||
# int skip, ProcErrorProc *errorProc)
|
||||
# }
|
||||
declare 229 {
|
||||
|
||||
+37
-24
@@ -877,6 +877,12 @@ typedef struct VarInHash {
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# define TCLFLEXARRAY 0
|
||||
#else
|
||||
# define TCLFLEXARRAY 1
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Forward declaration to prevent an error when the forward reference to
|
||||
* Command is encountered in the Proc and ImportRef types declared below.
|
||||
@@ -920,7 +926,7 @@ typedef struct CompiledLocal {
|
||||
* is marked by a unique ClientData tag during
|
||||
* compilation, and that same tag is used to
|
||||
* find the variable at runtime. */
|
||||
char name[1]; /* Name of the local variable starts here. If
|
||||
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
|
||||
* enough to hold the name. MUST BE THE LAST
|
||||
@@ -1254,7 +1260,7 @@ typedef struct CFWordBC {
|
||||
typedef struct ContLineLoc {
|
||||
int num; /* Number of entries in loc, not counting the
|
||||
* final -1 marker entry. */
|
||||
int loc[1]; /* Table of locations, as character offsets.
|
||||
int 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
|
||||
@@ -1403,7 +1409,7 @@ typedef struct ExecStack {
|
||||
Tcl_Obj **markerPtr;
|
||||
Tcl_Obj **endPtr;
|
||||
Tcl_Obj **tosPtr;
|
||||
Tcl_Obj *stackWords[1];
|
||||
Tcl_Obj *stackWords[TCLFLEXARRAY];
|
||||
} ExecStack;
|
||||
|
||||
/*
|
||||
@@ -1682,6 +1688,7 @@ typedef struct Command {
|
||||
#define CMD_COMPILES_EXPANDED 0x08
|
||||
#define CMD_REDEF_IN_PROGRESS 0x10
|
||||
#define CMD_VIA_RESOLVER 0x20
|
||||
#define CMD_DEAD 0x40
|
||||
|
||||
|
||||
/*
|
||||
@@ -1804,7 +1811,7 @@ typedef struct Interp {
|
||||
* of hidden commands on a per-interp
|
||||
* basis. */
|
||||
ClientData interpInfo; /* Information used by tclInterp.c to keep
|
||||
* track of master/slave interps on a
|
||||
* track of parent/child interps on a
|
||||
* per-interp basis. */
|
||||
union {
|
||||
void (*optimizer)(void *envPtr);
|
||||
@@ -2082,7 +2089,7 @@ typedef struct Interp {
|
||||
* (c) are accessed very often (e.g., at each command call)
|
||||
*
|
||||
* Note that these are the same for all interps in the same thread. They
|
||||
* just have to be initialised for the thread's master interp, slaves
|
||||
* just have to be initialised for the thread's parent interp, children
|
||||
* inherit the value.
|
||||
*
|
||||
* They are used by the macros defined below.
|
||||
@@ -2600,20 +2607,20 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
|
||||
/*
|
||||
* A ProcessGlobalValue struct exists for each internal value in Tcl that is
|
||||
* to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
|
||||
* the value, and the master is kept as a counted string, with epoch and mutex
|
||||
* control. Each ProcessGlobalValue struct should be a static variable in some
|
||||
* file.
|
||||
* the value, and the gobal value is kept as a counted string, with epoch and
|
||||
* mutex control. Each ProcessGlobalValue struct should be a static variable in
|
||||
* some file.
|
||||
*/
|
||||
|
||||
typedef struct ProcessGlobalValue {
|
||||
int epoch; /* Epoch counter to detect changes in the
|
||||
* master value. */
|
||||
int numBytes; /* Length of the master string. */
|
||||
char *value; /* The master string value. */
|
||||
Tcl_Encoding encoding; /* system encoding when master string was
|
||||
* global value. */
|
||||
int numBytes; /* Length of the global string. */
|
||||
char *value; /* The global string value. */
|
||||
Tcl_Encoding encoding; /* system encoding when global string was
|
||||
* initialized. */
|
||||
TclInitProcessGlobalValueProc *proc;
|
||||
/* A procedure to initialize the master string
|
||||
/* A procedure to initialize the global string
|
||||
* copy when a "get" request comes in before
|
||||
* any "set" request has been received. */
|
||||
Tcl_Mutex mutex; /* Enforce orderly access from multiple
|
||||
@@ -3097,8 +3104,8 @@ MODULE_SCOPE void TclpInitLock(void);
|
||||
MODULE_SCOPE void TclpInitPlatform(void);
|
||||
MODULE_SCOPE void TclpInitUnlock(void);
|
||||
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
|
||||
MODULE_SCOPE void TclpMasterLock(void);
|
||||
MODULE_SCOPE void TclpMasterUnlock(void);
|
||||
MODULE_SCOPE void TclpGlobalLock(void);
|
||||
MODULE_SCOPE void TclpGlobalUnlock(void);
|
||||
MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators,
|
||||
Tcl_DString *dirPtr, char *pattern, char *tail);
|
||||
MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp,
|
||||
@@ -3242,8 +3249,8 @@ MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
|
||||
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
|
||||
MODULE_SCOPE void * TclpThreadCreateKey(void);
|
||||
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
|
||||
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
|
||||
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
|
||||
MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
|
||||
MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr);
|
||||
|
||||
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
|
||||
|
||||
@@ -4308,8 +4315,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
(objPtr)->bytes = tclEmptyStringRep; \
|
||||
(objPtr)->length = 0; \
|
||||
} else { \
|
||||
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
|
||||
memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
|
||||
(objPtr)->bytes = (char *) ckalloc((len) + 1); \
|
||||
memcpy((objPtr)->bytes, (bytePtr), (len)); \
|
||||
(objPtr)->bytes[len] = '\0'; \
|
||||
(objPtr)->length = (len); \
|
||||
}
|
||||
@@ -4362,12 +4369,18 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
*/
|
||||
|
||||
#define TclInvalidateStringRep(objPtr) \
|
||||
if (objPtr->bytes != NULL) { \
|
||||
if (objPtr->bytes != tclEmptyStringRep) { \
|
||||
ckfree((char *) objPtr->bytes); \
|
||||
do { \
|
||||
Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \
|
||||
if (_isobjPtr->bytes != NULL) { \
|
||||
if (_isobjPtr->bytes != tclEmptyStringRep) { \
|
||||
ckfree((char *)_isobjPtr->bytes); \
|
||||
} \
|
||||
_isobjPtr->bytes = NULL; \
|
||||
} \
|
||||
objPtr->bytes = NULL; \
|
||||
}
|
||||
} while (0)
|
||||
|
||||
#define TclHasStringRep(objPtr) \
|
||||
((objPtr)->bytes != NULL)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
|
||||
@@ -1422,4 +1422,6 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
#undef TclCopyChannelOld
|
||||
#undef TclSockMinimumBuffersOld
|
||||
|
||||
#define TclSetChildCancelFlags TclSetSlaveCancelFlags
|
||||
|
||||
#endif /* _TCLINTDECLS */
|
||||
|
||||
+558
-557
File diff suppressed because it is too large
Load Diff
+16
-16
@@ -420,14 +420,14 @@ TclListObjCopy(
|
||||
int
|
||||
Tcl_ListObjGetElements(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
register Tcl_Obj *listPtr, /* List object for which an element array is
|
||||
Tcl_Obj *listPtr, /* List object for which an element array is
|
||||
* to be returned. */
|
||||
int *objcPtr, /* Where to store the count of objects
|
||||
* referenced by objv. */
|
||||
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
|
||||
* pointers to the list's objects. */
|
||||
{
|
||||
register List *listRepPtr;
|
||||
List *listRepPtr;
|
||||
|
||||
if (listPtr->typePtr != &tclListType) {
|
||||
int result;
|
||||
@@ -481,7 +481,7 @@ Tcl_ListObjGetElements(
|
||||
int
|
||||
Tcl_ListObjAppendList(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
register Tcl_Obj *listPtr, /* List object to append elements to. */
|
||||
Tcl_Obj *listPtr, /* List object to append elements to. */
|
||||
Tcl_Obj *elemListPtr) /* List obj with elements to append. */
|
||||
{
|
||||
int objc;
|
||||
@@ -543,7 +543,7 @@ Tcl_ListObjAppendElement(
|
||||
Tcl_Obj *listPtr, /* List object to append objPtr to. */
|
||||
Tcl_Obj *objPtr) /* Object to append to listPtr's list. */
|
||||
{
|
||||
register List *listRepPtr, *newPtr = NULL;
|
||||
List *listRepPtr, *newPtr = NULL;
|
||||
int numElems, numRequired, needGrow, isShared, attempt;
|
||||
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
@@ -653,7 +653,7 @@ Tcl_ListObjAppendElement(
|
||||
* Old intrep to be freed, re-use refCounts.
|
||||
*/
|
||||
|
||||
memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
|
||||
memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
|
||||
ckfree(listRepPtr);
|
||||
}
|
||||
listRepPtr = newPtr;
|
||||
@@ -711,11 +711,11 @@ Tcl_ListObjAppendElement(
|
||||
int
|
||||
Tcl_ListObjIndex(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
register Tcl_Obj *listPtr, /* List object to index into. */
|
||||
register int index, /* Index of element to return. */
|
||||
Tcl_Obj *listPtr, /* List object to index into. */
|
||||
int index, /* Index of element to return. */
|
||||
Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
|
||||
{
|
||||
register List *listRepPtr;
|
||||
List *listRepPtr;
|
||||
|
||||
if (listPtr->typePtr != &tclListType) {
|
||||
int result;
|
||||
@@ -766,10 +766,10 @@ Tcl_ListObjIndex(
|
||||
int
|
||||
Tcl_ListObjLength(
|
||||
Tcl_Interp *interp, /* Used to report errors if not NULL. */
|
||||
register Tcl_Obj *listPtr, /* List object whose #elements to return. */
|
||||
register int *intPtr) /* The resulting int is stored here. */
|
||||
Tcl_Obj *listPtr, /* List object whose #elements to return. */
|
||||
int *intPtr) /* The resulting int is stored here. */
|
||||
{
|
||||
register List *listRepPtr;
|
||||
List *listRepPtr;
|
||||
|
||||
if (listPtr->typePtr != &tclListType) {
|
||||
int result;
|
||||
@@ -839,7 +839,7 @@ Tcl_ListObjReplace(
|
||||
* insert. */
|
||||
{
|
||||
List *listRepPtr;
|
||||
register Tcl_Obj **elemPtrs;
|
||||
Tcl_Obj **elemPtrs;
|
||||
int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
|
||||
|
||||
if (Tcl_IsShared(listPtr)) {
|
||||
@@ -953,7 +953,7 @@ Tcl_ListObjReplace(
|
||||
if ((numAfterLast > 0) && (shift != 0)) {
|
||||
Tcl_Obj **src = elemPtrs + start;
|
||||
|
||||
memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
|
||||
memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*));
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
@@ -1024,7 +1024,7 @@ Tcl_ListObjReplace(
|
||||
*/
|
||||
|
||||
if (first > 0) {
|
||||
memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
|
||||
memcpy(elemPtrs, oldPtrs, first * sizeof(Tcl_Obj *));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1227,7 +1227,7 @@ TclLindexFlat(
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
listPtr = Tcl_NewObj();
|
||||
TclNewObj(listPtr);
|
||||
} else {
|
||||
/*
|
||||
* Extract the pointer to the appropriate element.
|
||||
@@ -1458,7 +1458,7 @@ TclLsetFlat(
|
||||
if (--indexCount) {
|
||||
parentList = subListPtr;
|
||||
if (index == elemCount) {
|
||||
subListPtr = Tcl_NewObj();
|
||||
TclNewObj(subListPtr);
|
||||
} else {
|
||||
subListPtr = elemPtrs[index];
|
||||
}
|
||||
|
||||
@@ -213,7 +213,7 @@ TclCreateLiteral(
|
||||
|
||||
if ((objLength == length) && ((length == 0)
|
||||
|| ((objBytes[0] == bytes[0])
|
||||
&& (memcmp(objBytes, bytes, (unsigned) length) == 0)))) {
|
||||
&& (memcmp(objBytes, bytes, length) == 0)))) {
|
||||
/*
|
||||
* A literal was found: return it
|
||||
*/
|
||||
@@ -418,7 +418,7 @@ TclRegisterLiteral(
|
||||
objPtr = localPtr->objPtr;
|
||||
if ((objPtr->length == length) && ((length == 0)
|
||||
|| ((objPtr->bytes[0] == bytes[0])
|
||||
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
|
||||
&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
|
||||
if ((flags & LITERAL_ON_HEAP)) {
|
||||
ckfree(bytes);
|
||||
}
|
||||
|
||||
+7
-7
@@ -196,9 +196,9 @@ Tcl_LoadObjCmd(
|
||||
|
||||
target = interp;
|
||||
if (objc == 4) {
|
||||
const char *slaveIntName = Tcl_GetString(objv[3]);
|
||||
const char *childIntName = Tcl_GetString(objv[3]);
|
||||
|
||||
target = Tcl_GetSlave(interp, slaveIntName);
|
||||
target = Tcl_GetChild(interp, childIntName);
|
||||
if (target == NULL) {
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
@@ -619,9 +619,9 @@ Tcl_UnloadObjCmd(
|
||||
|
||||
target = interp;
|
||||
if (objc - i == 3) {
|
||||
const char *slaveIntName = Tcl_GetString(objv[i + 2]);
|
||||
const char *childIntName = Tcl_GetString(objv[i + 2]);
|
||||
|
||||
target = Tcl_GetSlave(interp, slaveIntName);
|
||||
target = Tcl_GetChild(interp, childIntName);
|
||||
if (target == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1049,7 +1049,7 @@ TclGetLoadedPackages(
|
||||
* Return information about all of the available packages.
|
||||
*/
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
TclNewObj(resultObj);
|
||||
Tcl_MutexLock(&packageMutex);
|
||||
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
|
||||
pkgPtr = pkgPtr->nextPtr) {
|
||||
@@ -1068,12 +1068,12 @@ TclGetLoadedPackages(
|
||||
* interpreter.
|
||||
*/
|
||||
|
||||
target = Tcl_GetSlave(interp, targetName);
|
||||
target = Tcl_GetChild(interp, targetName);
|
||||
if (target == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
|
||||
resultObj = Tcl_NewObj();
|
||||
TclNewObj(resultObj);
|
||||
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
|
||||
pkgPtr = ipPtr->pkgPtr;
|
||||
pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
|
||||
|
||||
+4
-3
@@ -306,7 +306,7 @@ Tcl_MainEx(
|
||||
|
||||
is.interp = interp;
|
||||
is.prompt = PROMPT_START;
|
||||
is.commandPtr = Tcl_NewObj();
|
||||
TclNewObj(is.commandPtr);
|
||||
|
||||
/*
|
||||
* If the application has not already set a startup script, parse the
|
||||
@@ -521,7 +521,7 @@ Tcl_MainEx(
|
||||
TCL_EVAL_GLOBAL);
|
||||
is.input = Tcl_GetStdChannel(TCL_STDIN);
|
||||
Tcl_DecrRefCount(is.commandPtr);
|
||||
is.commandPtr = Tcl_NewObj();
|
||||
TclNewObj(is.commandPtr);
|
||||
Tcl_IncrRefCount(is.commandPtr);
|
||||
if (code != TCL_OK) {
|
||||
chan = Tcl_GetStdChannel(TCL_STDERR);
|
||||
@@ -805,7 +805,8 @@ StdinProc(
|
||||
code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
|
||||
isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
|
||||
Tcl_DecrRefCount(commandPtr);
|
||||
isPtr->commandPtr = commandPtr = Tcl_NewObj();
|
||||
TclNewObj(commandPtr);
|
||||
isPtr->commandPtr = commandPtr;
|
||||
Tcl_IncrRefCount(commandPtr);
|
||||
if (chan != NULL) {
|
||||
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
|
||||
|
||||
+41
-39
@@ -225,7 +225,7 @@ TclInitNamespaceSubsystem(void)
|
||||
|
||||
Tcl_Namespace *
|
||||
Tcl_GetCurrentNamespace(
|
||||
register Tcl_Interp *interp)/* Interpreter whose current namespace is
|
||||
Tcl_Interp *interp)/* Interpreter whose current namespace is
|
||||
* being queried. */
|
||||
{
|
||||
return TclGetCurrentNamespace(interp);
|
||||
@@ -249,7 +249,7 @@ Tcl_GetCurrentNamespace(
|
||||
|
||||
Tcl_Namespace *
|
||||
Tcl_GetGlobalNamespace(
|
||||
register Tcl_Interp *interp)/* Interpreter whose global namespace should
|
||||
Tcl_Interp *interp)/* Interpreter whose global namespace should
|
||||
* be returned. */
|
||||
{
|
||||
return TclGetGlobalNamespace(interp);
|
||||
@@ -301,8 +301,8 @@ Tcl_PushCallFrame(
|
||||
* variables. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register CallFrame *framePtr = (CallFrame *) callFramePtr;
|
||||
register Namespace *nsPtr;
|
||||
CallFrame *framePtr = (CallFrame *) callFramePtr;
|
||||
Namespace *nsPtr;
|
||||
|
||||
if (namespacePtr == NULL) {
|
||||
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
|
||||
@@ -378,8 +378,8 @@ void
|
||||
Tcl_PopCallFrame(
|
||||
Tcl_Interp *interp) /* Interpreter with call frame to pop. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
register CallFrame *framePtr = iPtr->framePtr;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
CallFrame *framePtr = iPtr->framePtr;
|
||||
Namespace *nsPtr;
|
||||
|
||||
/*
|
||||
@@ -664,7 +664,7 @@ Tcl_CreateNamespace(
|
||||
* function should be called. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Namespace *nsPtr, *ancestorPtr;
|
||||
Namespace *nsPtr, *ancestorPtr;
|
||||
Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
|
||||
Namespace *globalNsPtr = iPtr->globalNsPtr;
|
||||
const char *simpleName;
|
||||
@@ -833,7 +833,7 @@ Tcl_CreateNamespace(
|
||||
for (ancestorPtr = nsPtr; ancestorPtr != NULL;
|
||||
ancestorPtr = ancestorPtr->parentPtr) {
|
||||
if (ancestorPtr != globalNsPtr) {
|
||||
register Tcl_DString *tempPtr = namePtr;
|
||||
Tcl_DString *tempPtr = namePtr;
|
||||
|
||||
TclDStringAppendLiteral(buffPtr, "::");
|
||||
Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
|
||||
@@ -861,7 +861,7 @@ Tcl_CreateNamespace(
|
||||
name = Tcl_DStringValue(namePtr);
|
||||
nameLen = Tcl_DStringLength(namePtr);
|
||||
nsPtr->fullName = ckalloc(nameLen + 1);
|
||||
memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
|
||||
memcpy(nsPtr->fullName, name, nameLen + 1);
|
||||
|
||||
Tcl_DStringFree(&buffer1);
|
||||
Tcl_DStringFree(&buffer2);
|
||||
@@ -907,7 +907,7 @@ void
|
||||
Tcl_DeleteNamespace(
|
||||
Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
|
||||
{
|
||||
register Namespace *nsPtr = (Namespace *) namespacePtr;
|
||||
Namespace *nsPtr = (Namespace *) namespacePtr;
|
||||
Interp *iPtr = (Interp *) nsPtr->interp;
|
||||
Namespace *globalNsPtr = (Namespace *)
|
||||
TclGetGlobalNamespace((Tcl_Interp *) iPtr);
|
||||
@@ -1103,11 +1103,11 @@ TclNamespaceDeleted(
|
||||
|
||||
void
|
||||
TclTeardownNamespace(
|
||||
register Namespace *nsPtr) /* Points to the namespace to be dismantled
|
||||
Namespace *nsPtr) /* Points to the namespace to be dismantled
|
||||
* and unlinked from its parent. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) nsPtr->interp;
|
||||
register Tcl_HashEntry *entryPtr;
|
||||
Tcl_HashEntry *entryPtr;
|
||||
Tcl_HashSearch search;
|
||||
int i;
|
||||
|
||||
@@ -1296,7 +1296,7 @@ TclTeardownNamespace(
|
||||
|
||||
static void
|
||||
NamespaceFree(
|
||||
register Namespace *nsPtr) /* Points to the namespace to free. */
|
||||
Namespace *nsPtr) /* Points to the namespace to free. */
|
||||
{
|
||||
/*
|
||||
* Most of the namespace's contents are freed when the namespace is
|
||||
@@ -1455,7 +1455,7 @@ Tcl_Export(
|
||||
|
||||
len = strlen(pattern);
|
||||
patternCpy = ckalloc(len + 1);
|
||||
memcpy(patternCpy, pattern, (unsigned) len + 1);
|
||||
memcpy(patternCpy, pattern, len + 1);
|
||||
|
||||
nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
|
||||
nsPtr->numExportPatterns++;
|
||||
@@ -1572,7 +1572,7 @@ Tcl_Import(
|
||||
{
|
||||
Namespace *nsPtr, *importNsPtr, *dummyPtr;
|
||||
const char *simplePattern;
|
||||
register Tcl_HashEntry *hPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch search;
|
||||
|
||||
/*
|
||||
@@ -1851,7 +1851,7 @@ Tcl_ForgetImport(
|
||||
Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
|
||||
const char *simplePattern;
|
||||
char *cmdName;
|
||||
register Tcl_HashEntry *hPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch search;
|
||||
|
||||
/*
|
||||
@@ -1978,7 +1978,7 @@ TclGetOriginalCommand(
|
||||
Tcl_Command command) /* The imported command for which the original
|
||||
* command should be returned. */
|
||||
{
|
||||
register Command *cmdPtr = (Command *) command;
|
||||
Command *cmdPtr = (Command *) command;
|
||||
ImportedCmdData *dataPtr;
|
||||
|
||||
if (cmdPtr->deleteProc != DeleteImportedCmd) {
|
||||
@@ -2067,7 +2067,7 @@ DeleteImportedCmd(
|
||||
ImportedCmdData *dataPtr = clientData;
|
||||
Command *realCmdPtr = dataPtr->realCmdPtr;
|
||||
Command *selfPtr = dataPtr->selfPtr;
|
||||
register ImportRef *refPtr, *prevPtr;
|
||||
ImportRef *refPtr, *prevPtr;
|
||||
|
||||
prevPtr = NULL;
|
||||
for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
|
||||
@@ -2487,7 +2487,7 @@ Tcl_FindNamespace(
|
||||
* points to namespace in which to resolve
|
||||
* name; if NULL, look up name in the current
|
||||
* namespace. */
|
||||
register int flags) /* Flags controlling namespace lookup: an OR'd
|
||||
int flags) /* Flags controlling namespace lookup: an OR'd
|
||||
* combination of TCL_GLOBAL_ONLY and
|
||||
* TCL_LEAVE_ERR_MSG flags. */
|
||||
{
|
||||
@@ -2558,8 +2558,8 @@ Tcl_FindCommand(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Namespace *cxtNsPtr;
|
||||
register Tcl_HashEntry *entryPtr;
|
||||
register Command *cmdPtr;
|
||||
Tcl_HashEntry *entryPtr;
|
||||
Command *cmdPtr;
|
||||
const char *simpleName;
|
||||
int result;
|
||||
|
||||
@@ -2670,7 +2670,7 @@ Tcl_FindCommand(
|
||||
}
|
||||
} else {
|
||||
Namespace *nsPtr[2];
|
||||
register int search;
|
||||
int search;
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, cxtNsPtr,
|
||||
flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
|
||||
@@ -2744,7 +2744,7 @@ TclResetShadowedCmdRefs(
|
||||
{
|
||||
char *cmdName;
|
||||
Tcl_HashEntry *hPtr;
|
||||
register Namespace *nsPtr;
|
||||
Namespace *nsPtr;
|
||||
Namespace *trailNsPtr, *shadowNsPtr;
|
||||
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
|
||||
int found, i;
|
||||
@@ -2991,7 +2991,7 @@ NamespaceChildrenCmd(
|
||||
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
|
||||
const char *pattern = NULL;
|
||||
Tcl_DString buffer;
|
||||
register Tcl_HashEntry *entryPtr;
|
||||
Tcl_HashEntry *entryPtr;
|
||||
Tcl_HashSearch search;
|
||||
Tcl_Obj *listPtr, *elemPtr;
|
||||
|
||||
@@ -3117,7 +3117,7 @@ NamespaceCodeCmd(
|
||||
{
|
||||
Namespace *currNsPtr;
|
||||
Tcl_Obj *listPtr, *objPtr;
|
||||
register const char *arg;
|
||||
const char *arg;
|
||||
int length;
|
||||
|
||||
if (objc != 2) {
|
||||
@@ -3196,7 +3196,7 @@ NamespaceCurrentCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register Namespace *currNsPtr;
|
||||
Namespace *currNsPtr;
|
||||
|
||||
if (objc != 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, NULL);
|
||||
@@ -3261,7 +3261,7 @@ NamespaceDeleteCmd(
|
||||
{
|
||||
Tcl_Namespace *namespacePtr;
|
||||
const char *name;
|
||||
register int i;
|
||||
int i;
|
||||
|
||||
if (objc < 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
|
||||
@@ -3547,8 +3547,9 @@ NamespaceExportCmd(
|
||||
*/
|
||||
|
||||
if (objc == 1) {
|
||||
Tcl_Obj *listPtr = Tcl_NewObj();
|
||||
Tcl_Obj *listPtr;
|
||||
|
||||
TclNewObj(listPtr);
|
||||
(void) Tcl_AppendExportList(interp, NULL, listPtr);
|
||||
Tcl_SetObjResult(interp, listPtr);
|
||||
return TCL_OK;
|
||||
@@ -3616,7 +3617,7 @@ NamespaceForgetCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
const char *pattern;
|
||||
register int i, result;
|
||||
int i, result;
|
||||
|
||||
if (objc < 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
|
||||
@@ -3682,7 +3683,7 @@ NamespaceImportCmd(
|
||||
{
|
||||
int allowOverwrite = 0;
|
||||
const char *string, *pattern;
|
||||
register int i, result;
|
||||
int i, result;
|
||||
int firstArg;
|
||||
|
||||
if (objc < 1) {
|
||||
@@ -3835,7 +3836,7 @@ NRNamespaceInscopeCmd(
|
||||
cmdObjPtr = objv[2];
|
||||
} else {
|
||||
Tcl_Obj *concatObjv[2];
|
||||
register Tcl_Obj *listPtr;
|
||||
Tcl_Obj *listPtr;
|
||||
|
||||
listPtr = Tcl_NewListObj(0, NULL);
|
||||
for (i = 3; i < objc; i++) {
|
||||
@@ -4026,8 +4027,9 @@ NamespacePathCmd(
|
||||
*/
|
||||
|
||||
if (objc == 1) {
|
||||
Tcl_Obj *resultObj = Tcl_NewObj();
|
||||
Tcl_Obj *resultObj;
|
||||
|
||||
TclNewObj(resultObj);
|
||||
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
|
||||
if (nsPtr->commandPathArray[i].nsPtr != NULL) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
|
||||
@@ -4236,7 +4238,7 @@ NamespaceQualifiersCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register const char *name, *p;
|
||||
const char *name, *p;
|
||||
int length;
|
||||
|
||||
if (objc != 2) {
|
||||
@@ -4491,7 +4493,7 @@ NamespaceTailCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register const char *name, *p;
|
||||
const char *name, *p;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "string");
|
||||
@@ -4694,7 +4696,7 @@ NamespaceWhichCmd(
|
||||
|
||||
static void
|
||||
FreeNsNameInternalRep(
|
||||
register Tcl_Obj *objPtr) /* nsName object with internal representation
|
||||
Tcl_Obj *objPtr) /* nsName object with internal representation
|
||||
* to free. */
|
||||
{
|
||||
ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
@@ -4740,7 +4742,7 @@ FreeNsNameInternalRep(
|
||||
static void
|
||||
DupNsNameInternalRep(
|
||||
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
|
||||
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
|
||||
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
|
||||
{
|
||||
ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
@@ -4776,11 +4778,11 @@ SetNsNameFromAny(
|
||||
Tcl_Interp *interp, /* Points to the namespace in which to resolve
|
||||
* name. Also used for error reporting if not
|
||||
* NULL. */
|
||||
register Tcl_Obj *objPtr) /* The object to convert. */
|
||||
Tcl_Obj *objPtr) /* The object to convert. */
|
||||
{
|
||||
const char *dummy;
|
||||
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
|
||||
register ResolvedNsName *resNamePtr;
|
||||
ResolvedNsName *resNamePtr;
|
||||
const char *name;
|
||||
|
||||
if (interp == NULL) {
|
||||
@@ -4914,7 +4916,7 @@ TclLogCommandInfo(
|
||||
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
|
||||
* context */
|
||||
{
|
||||
register const char *p;
|
||||
const char *p;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int overflow, limit = 150;
|
||||
Var *varPtr, *arrayPtr;
|
||||
|
||||
+1
-1
@@ -132,7 +132,7 @@ static const Tcl_MethodType classConstructor = {
|
||||
};
|
||||
|
||||
/*
|
||||
* Scripted parts of TclOO. First, the master script (cannot be outside this
|
||||
* Scripted parts of TclOO. First, the main script (cannot be outside this
|
||||
* file).
|
||||
*/
|
||||
|
||||
|
||||
@@ -1155,7 +1155,7 @@ TclOOSelfObjCmd(
|
||||
}
|
||||
case SELF_CALL:
|
||||
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
|
||||
result[1] = Tcl_NewIntObj(contextPtr->index);
|
||||
TclNewIntObj(result[1], contextPtr->index);
|
||||
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+8
-8
@@ -105,7 +105,7 @@ void
|
||||
TclOODeleteContext(
|
||||
CallContext *contextPtr)
|
||||
{
|
||||
register Object *oPtr = contextPtr->oPtr;
|
||||
Object *oPtr = contextPtr->oPtr;
|
||||
|
||||
TclOODeleteChain(contextPtr->callPtr);
|
||||
if (oPtr != NULL) {
|
||||
@@ -215,7 +215,7 @@ DupMethodNameRep(
|
||||
Tcl_Obj *srcPtr,
|
||||
Tcl_Obj *dstPtr)
|
||||
{
|
||||
register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
dstPtr->typePtr = &methodNameType;
|
||||
dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
|
||||
@@ -226,7 +226,7 @@ static void
|
||||
FreeMethodNameRep(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
TclOODeleteChain(callPtr);
|
||||
objPtr->typePtr = NULL;
|
||||
@@ -255,7 +255,7 @@ TclOOInvokeContext(
|
||||
int objc, /* The number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* The arguments as actually seen. */
|
||||
{
|
||||
register CallContext *const contextPtr = clientData;
|
||||
CallContext *const contextPtr = clientData;
|
||||
Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
|
||||
const int isFilter =
|
||||
contextPtr->callPtr->chain[contextPtr->index].isFilter;
|
||||
@@ -487,7 +487,7 @@ TclOOGetSortedMethodList(
|
||||
|
||||
if (i > 0) {
|
||||
if (i > 1) {
|
||||
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
|
||||
qsort((void *) strings, i, sizeof(char *), CmpStr);
|
||||
}
|
||||
*stringsPtr = strings;
|
||||
} else {
|
||||
@@ -560,7 +560,7 @@ TclOOGetSortedClassMethodList(
|
||||
|
||||
if (i > 0) {
|
||||
if (i > 1) {
|
||||
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
|
||||
qsort((void *) strings, i, sizeof(char *), CmpStr);
|
||||
}
|
||||
*stringsPtr = strings;
|
||||
} else {
|
||||
@@ -792,7 +792,7 @@ AddMethodToCallChain(
|
||||
* looking to add things from a mixin and have
|
||||
* not passed a mixin. */
|
||||
{
|
||||
register CallChain *callPtr = cbPtr->callChainPtr;
|
||||
CallChain *callPtr = cbPtr->callChainPtr;
|
||||
int i;
|
||||
|
||||
/*
|
||||
@@ -1463,7 +1463,7 @@ AddSimpleClassChainToCallContext(
|
||||
(char *) methodNameObj);
|
||||
|
||||
if (hPtr != NULL) {
|
||||
register Method *mPtr = Tcl_GetHashValue(hPtr);
|
||||
Method *mPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (!(flags & KNOWN_STATE)) {
|
||||
if (flags & PUBLIC_METHOD) {
|
||||
|
||||
+1
-1
@@ -110,7 +110,7 @@ TclOOInitInfo(
|
||||
TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);
|
||||
|
||||
/*
|
||||
* Install into the master [info] ensemble.
|
||||
* Install into the [info] ensemble.
|
||||
*/
|
||||
|
||||
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
|
||||
|
||||
+2
-2
@@ -277,7 +277,7 @@ typedef struct Class {
|
||||
*/
|
||||
|
||||
typedef struct ThreadLocalData {
|
||||
int nsCount; /* Master epoch counter is used for keeping
|
||||
int nsCount; /* Epoch counter is used for keeping
|
||||
* the values used in Tcl_Obj internal
|
||||
* representations sane. Must be thread-local
|
||||
* because Tcl_Objs can cross interpreter
|
||||
@@ -289,7 +289,7 @@ typedef struct Foundation {
|
||||
Tcl_Interp *interp;
|
||||
Class *objectCls; /* The root of the object system. */
|
||||
Class *classCls; /* The class of all classes. */
|
||||
Tcl_Namespace *ooNs; /* Master ::oo namespace. */
|
||||
Tcl_Namespace *ooNs; /* ::oo namespace. */
|
||||
Tcl_Namespace *defineNs; /* Namespace containing special commands for
|
||||
* manipulating objects and classes. The
|
||||
* "oo::define" command acts as a special kind
|
||||
|
||||
+132
-132
@@ -145,12 +145,12 @@ typedef struct PendingObjData {
|
||||
#define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--)
|
||||
#define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0)
|
||||
#define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL)
|
||||
#define PushObjToDelete(contextPtr,objPtr) \
|
||||
#define PushObjToDelete(contextPtr,objPtr) \
|
||||
/* The string rep is already invalidated so we can use the bytes value \
|
||||
* for our pointer chain: push onto the head of the stack. */ \
|
||||
(objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
|
||||
(contextPtr)->deletionStack = (objPtr)
|
||||
#define PopObjToDelete(contextPtr,objPtrVar) \
|
||||
#define PopObjToDelete(contextPtr,objPtrVar) \
|
||||
(objPtrVar) = (contextPtr)->deletionStack; \
|
||||
(contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
|
||||
|
||||
@@ -161,14 +161,14 @@ typedef struct PendingObjData {
|
||||
static PendingObjData pendingObjData;
|
||||
#define ObjInitDeletionContext(contextPtr) \
|
||||
PendingObjData *const contextPtr = &pendingObjData
|
||||
#elif HAVE_FAST_TSD
|
||||
#elif defined(HAVE_FAST_TSD)
|
||||
static __thread PendingObjData pendingObjData;
|
||||
#define ObjInitDeletionContext(contextPtr) \
|
||||
PendingObjData *const contextPtr = &pendingObjData
|
||||
#else
|
||||
static Tcl_ThreadDataKey pendingObjDataKey;
|
||||
#define ObjInitDeletionContext(contextPtr) \
|
||||
PendingObjData *const contextPtr = \
|
||||
PendingObjData *const contextPtr = \
|
||||
Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
|
||||
#endif
|
||||
|
||||
@@ -177,27 +177,27 @@ static Tcl_ThreadDataKey pendingObjDataKey;
|
||||
*/
|
||||
|
||||
#define PACK_BIGNUM(bignum, objPtr) \
|
||||
if ((bignum).used > 0x7FFF) { \
|
||||
mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
|
||||
if ((bignum).used > 0x7FFF) { \
|
||||
mp_int *temp = (mp_int *)ckalloc(sizeof(mp_int)); \
|
||||
*temp = bignum; \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
|
||||
} else { \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
|
||||
} else { \
|
||||
if ((bignum).alloc > 0x7FFF) { \
|
||||
mp_shrink(&(bignum)); \
|
||||
} \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
|
||||
| ((bignum).alloc << 15) | ((bignum).used)); \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp; \
|
||||
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \
|
||||
| ((bignum).alloc << 15) | ((bignum).used)); \
|
||||
}
|
||||
|
||||
#define UNPACK_BIGNUM(objPtr, bignum) \
|
||||
if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
|
||||
(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
|
||||
if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
|
||||
(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
|
||||
} else { \
|
||||
(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \
|
||||
(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \
|
||||
(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
|
||||
(bignum).alloc = \
|
||||
(bignum).alloc = \
|
||||
(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7FFF; \
|
||||
(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7FFF; \
|
||||
}
|
||||
@@ -541,7 +541,7 @@ TclGetContLineTable(void)
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (!tsdPtr->lineCLPtr) {
|
||||
tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
|
||||
tsdPtr->lineCLPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
|
||||
Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
|
||||
}
|
||||
@@ -576,7 +576,7 @@ TclContinuationsEnter(
|
||||
ThreadSpecificData *tsdPtr = TclGetContLineTable();
|
||||
Tcl_HashEntry *hPtr =
|
||||
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
|
||||
ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
|
||||
ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(TclOffset(ContLineLoc, loc) + (num + 1) *sizeof(int));
|
||||
|
||||
if (!newEntry) {
|
||||
/*
|
||||
@@ -876,7 +876,7 @@ Tcl_AppendAllObjTypes(
|
||||
* name of each registered type is appended as
|
||||
* a list element. */
|
||||
{
|
||||
register Tcl_HashEntry *hPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch search;
|
||||
int numElems;
|
||||
|
||||
@@ -924,7 +924,7 @@ const Tcl_ObjType *
|
||||
Tcl_GetObjType(
|
||||
const char *typeName) /* Name of Tcl object type to look up. */
|
||||
{
|
||||
register Tcl_HashEntry *hPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
const Tcl_ObjType *typePtr = NULL;
|
||||
|
||||
Tcl_MutexLock(&tableMutex);
|
||||
@@ -1054,10 +1054,10 @@ TclDbDumpActiveObjects(
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
void
|
||||
TclDbInitNewObj(
|
||||
register Tcl_Obj *objPtr,
|
||||
register const char *file, /* The name of the source file calling this
|
||||
Tcl_Obj *objPtr,
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
register int line) /* Line number in the source file; used for
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
objPtr->refCount = 0;
|
||||
@@ -1079,7 +1079,7 @@ TclDbInitNewObj(
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (tsdPtr->objThreadMap == NULL) {
|
||||
tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
|
||||
tsdPtr->objThreadMap = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
|
||||
}
|
||||
tablePtr = tsdPtr->objThreadMap;
|
||||
@@ -1092,7 +1092,7 @@ TclDbInitNewObj(
|
||||
* Record the debugging information.
|
||||
*/
|
||||
|
||||
objData = ckalloc(sizeof(ObjData));
|
||||
objData = (ObjData *)ckalloc(sizeof(ObjData));
|
||||
objData->objPtr = objPtr;
|
||||
objData->file = file;
|
||||
objData->line = line;
|
||||
@@ -1142,7 +1142,7 @@ Tcl_NewObj(void)
|
||||
Tcl_Obj *
|
||||
Tcl_NewObj(void)
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
/*
|
||||
* Use the macro defined in tclInt.h - it will use the correct allocator.
|
||||
@@ -1184,12 +1184,12 @@ Tcl_NewObj(void)
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewObj(
|
||||
register const char *file, /* The name of the source file calling this
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
register int line) /* Line number in the source file; used for
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
/*
|
||||
* Use the macro defined in tclInt.h - it will use the correct allocator.
|
||||
@@ -1239,8 +1239,8 @@ TclAllocateFreeObjects(void)
|
||||
{
|
||||
size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
|
||||
char *basePtr;
|
||||
register Tcl_Obj *prevPtr, *objPtr;
|
||||
register int i;
|
||||
Tcl_Obj *prevPtr, *objPtr;
|
||||
int i;
|
||||
|
||||
/*
|
||||
* This has been noted by Purify to be a potential leak. The problem is
|
||||
@@ -1251,7 +1251,7 @@ TclAllocateFreeObjects(void)
|
||||
* Purify apparently can't figure that out, and fires a false alarm.
|
||||
*/
|
||||
|
||||
basePtr = ckalloc(bytesToAlloc);
|
||||
basePtr = (char *)ckalloc(bytesToAlloc);
|
||||
|
||||
prevPtr = NULL;
|
||||
objPtr = (Tcl_Obj *) basePtr;
|
||||
@@ -1291,9 +1291,9 @@ TclAllocateFreeObjects(void)
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
void
|
||||
TclFreeObj(
|
||||
register Tcl_Obj *objPtr) /* The object to be freed. */
|
||||
Tcl_Obj *objPtr) /* The object to be freed. */
|
||||
{
|
||||
register const Tcl_ObjType *typePtr = objPtr->typePtr;
|
||||
const Tcl_ObjType *typePtr = objPtr->typePtr;
|
||||
|
||||
/*
|
||||
* This macro declares a variable, so must come here...
|
||||
@@ -1416,7 +1416,7 @@ TclFreeObj(
|
||||
|
||||
void
|
||||
TclFreeObj(
|
||||
register Tcl_Obj *objPtr) /* The object to be freed. */
|
||||
Tcl_Obj *objPtr) /* The object to be freed. */
|
||||
{
|
||||
/*
|
||||
* Invalidate the string rep first so we can use the bytes value for our
|
||||
@@ -1625,7 +1625,7 @@ TclSetDuplicateObj(
|
||||
|
||||
char *
|
||||
Tcl_GetString(
|
||||
register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
|
||||
Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
|
||||
* be returned. */
|
||||
{
|
||||
if (objPtr->bytes != NULL) {
|
||||
@@ -1683,9 +1683,9 @@ Tcl_GetString(
|
||||
|
||||
char *
|
||||
Tcl_GetStringFromObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
|
||||
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
|
||||
* be returned. */
|
||||
register int *lengthPtr) /* If non-NULL, the location where the string
|
||||
int *lengthPtr) /* If non-NULL, the location where the string
|
||||
* rep's byte array length should * be stored.
|
||||
* If NULL, no length is stored. */
|
||||
{
|
||||
@@ -1717,7 +1717,7 @@ Tcl_GetStringFromObj(
|
||||
|
||||
void
|
||||
Tcl_InvalidateStringRep(
|
||||
register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
|
||||
Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
|
||||
* be freed. */
|
||||
{
|
||||
TclInvalidateStringRep(objPtr);
|
||||
@@ -1751,7 +1751,7 @@ Tcl_InvalidateStringRep(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewBooleanObj(
|
||||
register int boolValue) /* Boolean used to initialize new object. */
|
||||
int boolValue) /* Boolean used to initialize new object. */
|
||||
{
|
||||
return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
|
||||
}
|
||||
@@ -1760,9 +1760,9 @@ Tcl_NewBooleanObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewBooleanObj(
|
||||
register int boolValue) /* Boolean used to initialize new object. */
|
||||
int boolValue) /* Boolean used to initialize new object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewBooleanObj(objPtr, boolValue);
|
||||
return objPtr;
|
||||
@@ -1800,13 +1800,13 @@ Tcl_NewBooleanObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewBooleanObj(
|
||||
register int boolValue, /* Boolean used to initialize new object. */
|
||||
int boolValue, /* Boolean used to initialize new object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
@@ -1820,7 +1820,7 @@ Tcl_DbNewBooleanObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewBooleanObj(
|
||||
register int boolValue, /* Boolean used to initialize new object. */
|
||||
int boolValue, /* Boolean used to initialize new object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
@@ -1851,8 +1851,8 @@ Tcl_DbNewBooleanObj(
|
||||
#undef Tcl_SetBooleanObj
|
||||
void
|
||||
Tcl_SetBooleanObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register int boolValue) /* Boolean used to set object's value. */
|
||||
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
int boolValue) /* Boolean used to set object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
|
||||
@@ -1883,8 +1883,8 @@ Tcl_SetBooleanObj(
|
||||
int
|
||||
Tcl_GetBooleanFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr, /* The object from which to get boolean. */
|
||||
register int *boolPtr) /* Place to store resulting boolean. */
|
||||
Tcl_Obj *objPtr, /* The object from which to get boolean. */
|
||||
int *boolPtr) /* Place to store resulting boolean. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
@@ -1950,7 +1950,7 @@ Tcl_GetBooleanFromObj(
|
||||
int
|
||||
TclSetBooleanFromAny(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr) /* The object to convert. */
|
||||
Tcl_Obj *objPtr) /* The object to convert. */
|
||||
{
|
||||
/*
|
||||
* For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
|
||||
@@ -2003,7 +2003,7 @@ TclSetBooleanFromAny(
|
||||
|
||||
static int
|
||||
ParseBoolean(
|
||||
register Tcl_Obj *objPtr) /* The object to parse/convert. */
|
||||
Tcl_Obj *objPtr) /* The object to parse/convert. */
|
||||
{
|
||||
int i, length, newBool;
|
||||
char lowerCase[6];
|
||||
@@ -2059,25 +2059,25 @@ ParseBoolean(
|
||||
/*
|
||||
* Checking the 'y' is redundant, but makes the code clearer.
|
||||
*/
|
||||
if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
|
||||
if (strncmp(lowerCase, "yes", length) == 0) {
|
||||
newBool = 1;
|
||||
goto goodBoolean;
|
||||
}
|
||||
return TCL_ERROR;
|
||||
case 'n':
|
||||
if (strncmp(lowerCase, "no", (size_t) length) == 0) {
|
||||
if (strncmp(lowerCase, "no", length) == 0) {
|
||||
newBool = 0;
|
||||
goto goodBoolean;
|
||||
}
|
||||
return TCL_ERROR;
|
||||
case 't':
|
||||
if (strncmp(lowerCase, "true", (size_t) length) == 0) {
|
||||
if (strncmp(lowerCase, "true", length) == 0) {
|
||||
newBool = 1;
|
||||
goto goodBoolean;
|
||||
}
|
||||
return TCL_ERROR;
|
||||
case 'f':
|
||||
if (strncmp(lowerCase, "false", (size_t) length) == 0) {
|
||||
if (strncmp(lowerCase, "false", length) == 0) {
|
||||
newBool = 0;
|
||||
goto goodBoolean;
|
||||
}
|
||||
@@ -2086,10 +2086,10 @@ ParseBoolean(
|
||||
if (length < 2) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (strncmp(lowerCase, "on", (size_t) length) == 0) {
|
||||
if (strncmp(lowerCase, "on", length) == 0) {
|
||||
newBool = 1;
|
||||
goto goodBoolean;
|
||||
} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
|
||||
} else if (strncmp(lowerCase, "off", length) == 0) {
|
||||
newBool = 0;
|
||||
goto goodBoolean;
|
||||
}
|
||||
@@ -2144,7 +2144,7 @@ ParseBoolean(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewDoubleObj(
|
||||
register double dblValue) /* Double used to initialize the object. */
|
||||
double dblValue) /* Double used to initialize the object. */
|
||||
{
|
||||
return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
|
||||
}
|
||||
@@ -2153,9 +2153,9 @@ Tcl_NewDoubleObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewDoubleObj(
|
||||
register double dblValue) /* Double used to initialize the object. */
|
||||
double dblValue) /* Double used to initialize the object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewDoubleObj(objPtr, dblValue);
|
||||
return objPtr;
|
||||
@@ -2192,13 +2192,13 @@ Tcl_NewDoubleObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewDoubleObj(
|
||||
register double dblValue, /* Double used to initialize the object. */
|
||||
double dblValue, /* Double used to initialize the object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
@@ -2212,7 +2212,7 @@ Tcl_DbNewDoubleObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewDoubleObj(
|
||||
register double dblValue, /* Double used to initialize the object. */
|
||||
double dblValue, /* Double used to initialize the object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
@@ -2242,8 +2242,8 @@ Tcl_DbNewDoubleObj(
|
||||
|
||||
void
|
||||
Tcl_SetDoubleObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register double dblValue) /* Double used to set the object's value. */
|
||||
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
double dblValue) /* Double used to set the object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
|
||||
@@ -2275,8 +2275,8 @@ Tcl_SetDoubleObj(
|
||||
int
|
||||
Tcl_GetDoubleFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr, /* The object from which to get a double. */
|
||||
register double *dblPtr) /* Place to store resulting double. */
|
||||
Tcl_Obj *objPtr, /* The object from which to get a double. */
|
||||
double *dblPtr) /* Place to store resulting double. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
@@ -2336,7 +2336,7 @@ Tcl_GetDoubleFromObj(
|
||||
static int
|
||||
SetDoubleFromAny(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr) /* The object to convert. */
|
||||
Tcl_Obj *objPtr) /* The object to convert. */
|
||||
{
|
||||
return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
|
||||
NULL, 0);
|
||||
@@ -2365,16 +2365,16 @@ SetDoubleFromAny(
|
||||
|
||||
static void
|
||||
UpdateStringOfDouble(
|
||||
register Tcl_Obj *objPtr) /* Double obj with string rep to update. */
|
||||
Tcl_Obj *objPtr) /* Double obj with string rep to update. */
|
||||
{
|
||||
char buffer[TCL_DOUBLE_SPACE];
|
||||
register int len;
|
||||
int len;
|
||||
|
||||
Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
|
||||
len = strlen(buffer);
|
||||
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
|
||||
objPtr->bytes = (char *)ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
|
||||
@@ -2413,7 +2413,7 @@ UpdateStringOfDouble(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewIntObj(
|
||||
register int intValue) /* Int used to initialize the new object. */
|
||||
int intValue) /* Int used to initialize the new object. */
|
||||
{
|
||||
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
|
||||
}
|
||||
@@ -2422,9 +2422,9 @@ Tcl_NewIntObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewIntObj(
|
||||
register int intValue) /* Int used to initialize the new object. */
|
||||
int intValue) /* Int used to initialize the new object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, intValue);
|
||||
return objPtr;
|
||||
@@ -2452,8 +2452,8 @@ Tcl_NewIntObj(
|
||||
#undef Tcl_SetIntObj
|
||||
void
|
||||
Tcl_SetIntObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register int intValue) /* Integer used to set object's value. */
|
||||
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
int intValue) /* Integer used to set object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
|
||||
@@ -2494,8 +2494,8 @@ Tcl_SetIntObj(
|
||||
int
|
||||
Tcl_GetIntFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr, /* The object from which to get a int. */
|
||||
register int *intPtr) /* Place to store resulting int. */
|
||||
Tcl_Obj *objPtr, /* The object from which to get a int. */
|
||||
int *intPtr) /* Place to store resulting int. */
|
||||
{
|
||||
#if (LONG_MAX == INT_MAX)
|
||||
return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
|
||||
@@ -2566,15 +2566,15 @@ SetIntFromAny(
|
||||
|
||||
static void
|
||||
UpdateStringOfInt(
|
||||
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
{
|
||||
char buffer[TCL_INTEGER_SPACE];
|
||||
register int len;
|
||||
int len;
|
||||
|
||||
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
|
||||
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
|
||||
objPtr->bytes = (char *)ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
|
||||
@@ -2613,7 +2613,7 @@ UpdateStringOfInt(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewLongObj(
|
||||
register long longValue) /* Long integer used to initialize the
|
||||
long longValue) /* Long integer used to initialize the
|
||||
* new object. */
|
||||
{
|
||||
return Tcl_DbNewLongObj(longValue, "unknown", 0);
|
||||
@@ -2623,10 +2623,10 @@ Tcl_NewLongObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewLongObj(
|
||||
register long longValue) /* Long integer used to initialize the
|
||||
long longValue) /* Long integer used to initialize the
|
||||
* new object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewLongObj(objPtr, longValue);
|
||||
return objPtr;
|
||||
@@ -2669,14 +2669,14 @@ Tcl_NewLongObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewLongObj(
|
||||
register long longValue, /* Long integer used to initialize the new
|
||||
long longValue, /* Long integer used to initialize the new
|
||||
* object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
@@ -2690,7 +2690,7 @@ Tcl_DbNewLongObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewLongObj(
|
||||
register long longValue, /* Long integer used to initialize the new
|
||||
long longValue, /* Long integer used to initialize the new
|
||||
* object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
@@ -2721,8 +2721,8 @@ Tcl_DbNewLongObj(
|
||||
|
||||
void
|
||||
Tcl_SetLongObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register long longValue) /* Long integer used to initialize the
|
||||
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
long longValue) /* Long integer used to initialize the
|
||||
* object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
@@ -2756,8 +2756,8 @@ Tcl_SetLongObj(
|
||||
int
|
||||
Tcl_GetLongFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr, /* The object from which to get a long. */
|
||||
register long *longPtr) /* Place to store resulting long. */
|
||||
Tcl_Obj *objPtr, /* The object from which to get a long. */
|
||||
long *longPtr) /* Place to store resulting long. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
@@ -2862,11 +2862,11 @@ Tcl_GetLongFromObj(
|
||||
|
||||
static void
|
||||
UpdateStringOfWideInt(
|
||||
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
{
|
||||
char buffer[TCL_INTEGER_SPACE+2];
|
||||
register unsigned len;
|
||||
register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
|
||||
unsigned len;
|
||||
Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
|
||||
|
||||
/*
|
||||
* Note that sprintf will generate a compiler warning under Mingw claiming
|
||||
@@ -2877,7 +2877,7 @@ UpdateStringOfWideInt(
|
||||
|
||||
sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
|
||||
len = strlen(buffer);
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
objPtr->bytes = (char *)ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
@@ -2913,7 +2913,7 @@ UpdateStringOfWideInt(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewWideIntObj(
|
||||
register Tcl_WideInt wideValue)
|
||||
Tcl_WideInt wideValue)
|
||||
/* Wide integer used to initialize the new
|
||||
* object. */
|
||||
{
|
||||
@@ -2924,11 +2924,11 @@ Tcl_NewWideIntObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewWideIntObj(
|
||||
register Tcl_WideInt wideValue)
|
||||
Tcl_WideInt wideValue)
|
||||
/* Wide integer used to initialize the new
|
||||
* object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewObj(objPtr);
|
||||
Tcl_SetWideIntObj(objPtr, wideValue);
|
||||
@@ -2972,7 +2972,7 @@ Tcl_NewWideIntObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewWideIntObj(
|
||||
register Tcl_WideInt wideValue,
|
||||
Tcl_WideInt wideValue,
|
||||
/* Wide integer used to initialize the new
|
||||
* object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
@@ -2980,7 +2980,7 @@ Tcl_DbNewWideIntObj(
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
Tcl_SetWideIntObj(objPtr, wideValue);
|
||||
@@ -2991,7 +2991,7 @@ Tcl_DbNewWideIntObj(
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewWideIntObj(
|
||||
register Tcl_WideInt wideValue,
|
||||
Tcl_WideInt wideValue,
|
||||
/* Long integer used to initialize the new
|
||||
* object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
@@ -3023,8 +3023,8 @@ Tcl_DbNewWideIntObj(
|
||||
|
||||
void
|
||||
Tcl_SetWideIntObj(
|
||||
register Tcl_Obj *objPtr, /* Object w. internal rep to init. */
|
||||
register Tcl_WideInt wideValue)
|
||||
Tcl_Obj *objPtr, /* Object w. internal rep to init. */
|
||||
Tcl_WideInt wideValue)
|
||||
/* Wide integer used to initialize the
|
||||
* object's value. */
|
||||
{
|
||||
@@ -3071,8 +3071,8 @@ Tcl_SetWideIntObj(
|
||||
int
|
||||
Tcl_GetWideIntFromObj(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr, /* Object from which to get a wide int. */
|
||||
register Tcl_WideInt *wideIntPtr)
|
||||
Tcl_Obj *objPtr, /* Object from which to get a wide int. */
|
||||
Tcl_WideInt *wideIntPtr)
|
||||
/* Place to store resulting long. */
|
||||
{
|
||||
do {
|
||||
@@ -3269,7 +3269,7 @@ UpdateStringOfBignum(
|
||||
|
||||
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
|
||||
}
|
||||
stringVal = ckalloc(size);
|
||||
stringVal = (char *)ckalloc(size);
|
||||
status = mp_to_radix(&bignumVal, stringVal, size, NULL, 10);
|
||||
if (status != MP_OKAY) {
|
||||
Tcl_Panic("conversion failure in UpdateStringOfBignum");
|
||||
@@ -3712,7 +3712,7 @@ TclGetNumberFromObj(
|
||||
|
||||
void
|
||||
Tcl_DbIncrRefCount(
|
||||
register Tcl_Obj *objPtr, /* The object we are registering a reference
|
||||
Tcl_Obj *objPtr, /* The object we are registering a reference
|
||||
* to. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
@@ -3775,7 +3775,7 @@ Tcl_DbIncrRefCount(
|
||||
|
||||
void
|
||||
Tcl_DbDecrRefCount(
|
||||
register Tcl_Obj *objPtr, /* The object we are releasing a reference
|
||||
Tcl_Obj *objPtr, /* The object we are releasing a reference
|
||||
* to. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
@@ -3841,7 +3841,7 @@ Tcl_DbDecrRefCount(
|
||||
|
||||
int
|
||||
Tcl_DbIsShared(
|
||||
register Tcl_Obj *objPtr, /* The object to test for being shared. */
|
||||
Tcl_Obj *objPtr, /* The object to test for being shared. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
@@ -3913,7 +3913,7 @@ Tcl_DbIsShared(
|
||||
|
||||
void
|
||||
Tcl_InitObjHashTable(
|
||||
register Tcl_HashTable *tablePtr)
|
||||
Tcl_HashTable *tablePtr)
|
||||
/* Pointer to table record, which is supplied
|
||||
* by the caller. */
|
||||
{
|
||||
@@ -3942,8 +3942,8 @@ AllocObjEntry(
|
||||
Tcl_HashTable *tablePtr, /* Hash table. */
|
||||
void *keyPtr) /* Key to store in the hash table entry. */
|
||||
{
|
||||
Tcl_Obj *objPtr = keyPtr;
|
||||
Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
|
||||
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
|
||||
Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
|
||||
|
||||
hPtr->key.objPtr = objPtr;
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
@@ -3976,8 +3976,8 @@ TclCompareObjKeys(
|
||||
{
|
||||
Tcl_Obj *objPtr1 = keyPtr;
|
||||
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
|
||||
register const char *p1, *p2;
|
||||
register size_t l1, l2;
|
||||
const char *p1, *p2;
|
||||
size_t l1, l2;
|
||||
|
||||
/*
|
||||
* If the object pointers are the same then they match.
|
||||
@@ -4134,13 +4134,13 @@ Tcl_Command
|
||||
Tcl_GetCommandFromObj(
|
||||
Tcl_Interp *interp, /* The interpreter in which to resolve the
|
||||
* command and to report errors. */
|
||||
register Tcl_Obj *objPtr) /* The object containing the command's name.
|
||||
Tcl_Obj *objPtr) /* The object containing the command's name.
|
||||
* If the name starts with "::", will be
|
||||
* looked up in global namespace. Else, looked
|
||||
* up first in the current namespace, then in
|
||||
* global namespace. */
|
||||
{
|
||||
register ResolvedCmdName *resPtr;
|
||||
ResolvedCmdName *resPtr;
|
||||
|
||||
/*
|
||||
* Get the internal representation, converting to a command type if
|
||||
@@ -4163,13 +4163,13 @@ Tcl_GetCommandFromObj(
|
||||
|
||||
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
|
||||
register Command *cmdPtr = resPtr->cmdPtr;
|
||||
Command *cmdPtr = resPtr->cmdPtr;
|
||||
|
||||
if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
|
||||
&& !(cmdPtr->flags & CMD_IS_DELETED)
|
||||
&& (interp == cmdPtr->nsPtr->interp)
|
||||
&& !(cmdPtr->nsPtr->flags & NS_DYING)) {
|
||||
register Namespace *refNsPtr = (Namespace *)
|
||||
Namespace *refNsPtr = (Namespace *)
|
||||
TclGetCurrentNamespace(interp);
|
||||
|
||||
if ((resPtr->refNsPtr == NULL)
|
||||
@@ -4218,14 +4218,14 @@ void
|
||||
TclSetCmdNameObj(
|
||||
Tcl_Interp *interp, /* Points to interpreter containing command
|
||||
* that should be cached in objPtr. */
|
||||
register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
|
||||
Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
|
||||
* CmdName object. */
|
||||
Command *cmdPtr) /* Points to Command structure that the
|
||||
* CmdName object should refer to. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register ResolvedCmdName *resPtr;
|
||||
register Namespace *currNsPtr;
|
||||
ResolvedCmdName *resPtr;
|
||||
Namespace *currNsPtr;
|
||||
const char *name;
|
||||
|
||||
if (objPtr->typePtr == &tclCmdNameType) {
|
||||
@@ -4236,7 +4236,7 @@ TclSetCmdNameObj(
|
||||
}
|
||||
|
||||
cmdPtr->refCount++;
|
||||
resPtr = ckalloc(sizeof(ResolvedCmdName));
|
||||
resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName));
|
||||
resPtr->cmdPtr = cmdPtr;
|
||||
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
|
||||
resPtr->refCount = 1;
|
||||
@@ -4290,10 +4290,10 @@ TclSetCmdNameObj(
|
||||
|
||||
static void
|
||||
FreeCmdNameInternalRep(
|
||||
register Tcl_Obj *objPtr) /* CmdName object with internal
|
||||
Tcl_Obj *objPtr) /* CmdName object with internal
|
||||
* representation to free. */
|
||||
{
|
||||
register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
if (resPtr != NULL) {
|
||||
/*
|
||||
@@ -4340,9 +4340,9 @@ FreeCmdNameInternalRep(
|
||||
static void
|
||||
DupCmdNameInternalRep(
|
||||
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
|
||||
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
|
||||
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
|
||||
{
|
||||
register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
|
||||
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
|
||||
@@ -4376,13 +4376,13 @@ DupCmdNameInternalRep(
|
||||
static int
|
||||
SetCmdNameFromAny(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr) /* The object to convert. */
|
||||
Tcl_Obj *objPtr) /* The object to convert. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
const char *name;
|
||||
register Command *cmdPtr;
|
||||
Command *cmdPtr;
|
||||
Namespace *currNsPtr;
|
||||
register ResolvedCmdName *resPtr;
|
||||
ResolvedCmdName *resPtr;
|
||||
|
||||
if (interp == NULL) {
|
||||
return TCL_ERROR;
|
||||
@@ -4422,7 +4422,7 @@ SetCmdNameFromAny(
|
||||
}
|
||||
} else {
|
||||
TclFreeIntRep(objPtr);
|
||||
resPtr = ckalloc(sizeof(ResolvedCmdName));
|
||||
resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName));
|
||||
resPtr->refCount = 1;
|
||||
objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
|
||||
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
|
||||
|
||||
+1
-1
@@ -2172,7 +2172,7 @@ TclSubstTokens(
|
||||
* command, which is refered to by 'script'.
|
||||
* The 'clNextOuter' refers to the current
|
||||
* entry in the table of continuation lines in
|
||||
* this "master script", and the character
|
||||
* this "main script", and the character
|
||||
* offsets are relative to the 'outerScript'
|
||||
* as well.
|
||||
*
|
||||
|
||||
@@ -1745,7 +1745,7 @@ Tcl_FSGetTranslatedStringPath(
|
||||
const char *orig = Tcl_GetStringFromObj(transPtr, &len);
|
||||
char *result = ckalloc(len+1);
|
||||
|
||||
memcpy(result, orig, (size_t) len+1);
|
||||
memcpy(result, orig, len+1);
|
||||
TclDecrRefCount(transPtr);
|
||||
return result;
|
||||
}
|
||||
@@ -2617,7 +2617,7 @@ DupFsPathInternalRep(
|
||||
|
||||
static void
|
||||
UpdateStringOfFsPath(
|
||||
register Tcl_Obj *pathPtr) /* path obj with string rep to update. */
|
||||
Tcl_Obj *pathPtr) /* path obj with string rep to update. */
|
||||
{
|
||||
FsPath *fsPathPtr = PATHOBJ(pathPtr);
|
||||
int cwdLen;
|
||||
|
||||
+5
-3
@@ -718,8 +718,9 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
}
|
||||
}
|
||||
} else if (result != TCL_ERROR) {
|
||||
Tcl_Obj *codePtr = Tcl_NewIntObj(result);
|
||||
Tcl_Obj *codePtr;
|
||||
|
||||
TclNewIntObj(codePtr, result);
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" bad return code: %s",
|
||||
@@ -1137,9 +1138,10 @@ TclNRPackageObjCmd(
|
||||
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL);
|
||||
return TCL_OK;
|
||||
} else {
|
||||
int i, newobjc = objc-3;
|
||||
Tcl_Obj *const *newobjv = objv + 3;
|
||||
if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
|
||||
newobjc = objc - 3;
|
||||
|
||||
if (CheckAllRequirements(interp, objc - 3, objv + 3) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
objvListPtr = Tcl_NewListObj(0, NULL);
|
||||
|
||||
@@ -35,6 +35,14 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#ifndef TCL_CFGVAL_ENCODING
|
||||
# ifdef _WIN32
|
||||
# define TCL_CFGVAL_ENCODING "cp1252"
|
||||
# else
|
||||
# define TCL_CFGVAL_ENCODING "iso8859-1"
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Use C preprocessor statements to define the various values for the embedded
|
||||
* configuration information.
|
||||
|
||||
+26
-5
@@ -600,7 +600,7 @@ TclCreateProc(
|
||||
*/
|
||||
|
||||
localPtr = (CompiledLocal *)ckalloc(
|
||||
TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
|
||||
TclOffset(CompiledLocal, name) + fieldValues[0]->length + 1);
|
||||
if (procPtr->firstLocalPtr == NULL) {
|
||||
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
|
||||
} else {
|
||||
@@ -903,9 +903,28 @@ TclNRUplevelObjCmd(
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
if (objc < 2) {
|
||||
/* to do
|
||||
* simplify things by interpreting the argument as a command when there
|
||||
* is only one argument. This requires a TIP since currently a single
|
||||
* argument is interpreted as a level indicator if possible.
|
||||
*/
|
||||
uplevelSyntax:
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
|
||||
return TCL_ERROR;
|
||||
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
|
||||
int status ,llength;
|
||||
status = Tcl_ListObjLength(interp, objv[1], &llength);
|
||||
if (status == TCL_OK && llength > 1) {
|
||||
/* the first argument can't interpreted as a level. Avoid
|
||||
* generating a string representation of the script. */
|
||||
result = TclGetFrame(interp, "1", &framePtr);
|
||||
if (result == -1) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
objc -= 1;
|
||||
objv += 1;
|
||||
goto havelevel;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -922,6 +941,8 @@ TclNRUplevelObjCmd(
|
||||
}
|
||||
objv += result + 1;
|
||||
|
||||
havelevel:
|
||||
|
||||
/*
|
||||
* Modify the interpreter state to execute in the given frame.
|
||||
*/
|
||||
@@ -1305,8 +1326,8 @@ InitLocalCache(
|
||||
* for future calls.
|
||||
*/
|
||||
|
||||
localCachePtr = ckalloc(sizeof(LocalCache)
|
||||
+ (localCt - 1) * sizeof(Tcl_Obj *)
|
||||
localCachePtr = (LocalCache *)ckalloc(TclOffset(LocalCache, varName0)
|
||||
+ localCt * sizeof(Tcl_Obj *)
|
||||
+ numArgs * sizeof(Var));
|
||||
|
||||
namePtr = &localCachePtr->varName0;
|
||||
@@ -2499,12 +2520,12 @@ SetLambdaFromAny(
|
||||
* location (line of 2nd list element).
|
||||
*/
|
||||
|
||||
cfPtr = ckalloc(sizeof(CmdFrame));
|
||||
cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
|
||||
TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
|
||||
|
||||
cfPtr->level = -1;
|
||||
cfPtr->type = contextPtr->type;
|
||||
cfPtr->line = ckalloc(sizeof(int));
|
||||
cfPtr->line = (int *)ckalloc(sizeof(int));
|
||||
cfPtr->line[0] = buf[1];
|
||||
cfPtr->nline = 1;
|
||||
cfPtr->framePtr = NULL;
|
||||
|
||||
+9
-9
@@ -64,7 +64,7 @@
|
||||
|
||||
#define NUM_REGEXPS 30
|
||||
|
||||
typedef struct ThreadSpecificData {
|
||||
typedef struct {
|
||||
int initialized; /* Set to 1 when the module is initialized. */
|
||||
char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
|
||||
* expression patterns. NULL means that this
|
||||
@@ -245,7 +245,7 @@ Tcl_RegExpRange(
|
||||
|
||||
if ((size_t) index > regexpPtr->re.re_nsub) {
|
||||
*startPtr = *endPtr = NULL;
|
||||
} else if (regexpPtr->matches[index].rm_so < 0) {
|
||||
} else if (regexpPtr->matches[index].rm_so == -1) {
|
||||
*startPtr = *endPtr = NULL;
|
||||
} else {
|
||||
if (regexpPtr->objPtr) {
|
||||
@@ -355,7 +355,7 @@ TclRegExpRangeUniChar(
|
||||
{
|
||||
TclRegexp *regexpPtr = (TclRegexp *) re;
|
||||
|
||||
if ((regexpPtr->flags®_EXPECT) && index == -1) {
|
||||
if ((regexpPtr->flags®_EXPECT) && (index == -1)) {
|
||||
*startPtr = regexpPtr->details.rm_extend.rm_so;
|
||||
*endPtr = regexpPtr->details.rm_extend.rm_eo;
|
||||
} else if ((size_t) index > regexpPtr->re.re_nsub) {
|
||||
@@ -510,9 +510,9 @@ Tcl_RegExpMatchObj(
|
||||
*/
|
||||
|
||||
if (!(re = Tcl_GetRegExpFromObj(interp, patternObj,
|
||||
TCL_REG_ADVANCED | TCL_REG_NOSUB))
|
||||
TCL_REG_ADVANCED | TCL_REG_NOSUB))
|
||||
&& !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) {
|
||||
return -1;
|
||||
return -1;
|
||||
}
|
||||
return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
|
||||
0 /* nmatches */, 0 /* flags */);
|
||||
@@ -912,7 +912,7 @@ CompileRegexp(
|
||||
* This is a new expression, so compile it and add it to the cache.
|
||||
*/
|
||||
|
||||
regexpPtr = ckalloc(sizeof(TclRegexp));
|
||||
regexpPtr = (TclRegexp*)ckalloc(sizeof(TclRegexp));
|
||||
regexpPtr->objPtr = NULL;
|
||||
regexpPtr->string = NULL;
|
||||
regexpPtr->details.rm_extend.rm_so = -1;
|
||||
@@ -967,7 +967,7 @@ CompileRegexp(
|
||||
*/
|
||||
|
||||
regexpPtr->matches =
|
||||
ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
|
||||
(regmatch_t*)ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
|
||||
|
||||
/*
|
||||
* Initialize the refcount to one initially, since it is in the cache.
|
||||
@@ -993,8 +993,8 @@ CompileRegexp(
|
||||
tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
|
||||
tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
|
||||
}
|
||||
tsdPtr->patterns[0] = ckalloc(length + 1);
|
||||
memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
|
||||
tsdPtr->patterns[0] = (char *)ckalloc(length + 1);
|
||||
memcpy(tsdPtr->patterns[0], string, length + 1);
|
||||
tsdPtr->patLengths[0] = length;
|
||||
tsdPtr->regexps[0] = regexpPtr;
|
||||
|
||||
|
||||
+14
-14
@@ -411,14 +411,14 @@ void
|
||||
Tcl_SetResult(
|
||||
Tcl_Interp *interp, /* Interpreter with which to associate the
|
||||
* return value. */
|
||||
register char *result, /* Value to be returned. If NULL, the result
|
||||
char *result, /* Value to be returned. If NULL, the result
|
||||
* is set to an empty string. */
|
||||
Tcl_FreeProc *freeProc) /* Gives information about the string:
|
||||
* TCL_STATIC, TCL_VOLATILE, or the address of
|
||||
* a Tcl_FreeProc such as free. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
|
||||
Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
|
||||
char *oldResult = iPtr->result;
|
||||
|
||||
if (result == NULL) {
|
||||
@@ -435,7 +435,7 @@ Tcl_SetResult(
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
memcpy(iPtr->result, result, (unsigned) length+1);
|
||||
memcpy(iPtr->result, result, length+1);
|
||||
} else {
|
||||
iPtr->result = (char *) result;
|
||||
iPtr->freeProc = freeProc;
|
||||
@@ -481,7 +481,7 @@ Tcl_SetResult(
|
||||
|
||||
const char *
|
||||
Tcl_GetStringResult(
|
||||
register Tcl_Interp *interp)/* Interpreter whose result to return. */
|
||||
Tcl_Interp *interp)/* Interpreter whose result to return. */
|
||||
{
|
||||
/*
|
||||
* If the string result is empty, move the object result to the string
|
||||
@@ -520,11 +520,11 @@ void
|
||||
Tcl_SetObjResult(
|
||||
Tcl_Interp *interp, /* Interpreter with which to associate the
|
||||
* return object value. */
|
||||
register Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj
|
||||
Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj
|
||||
* result is made an empty string object. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
register Tcl_Obj *oldObjResult = iPtr->objResultPtr;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *oldObjResult = iPtr->objResultPtr;
|
||||
|
||||
iPtr->objResultPtr = objPtr;
|
||||
Tcl_IncrRefCount(objPtr); /* since interp result is a reference */
|
||||
@@ -577,7 +577,7 @@ Tcl_Obj *
|
||||
Tcl_GetObjResult(
|
||||
Tcl_Interp *interp) /* Interpreter whose result to return. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *objResultPtr;
|
||||
int length;
|
||||
|
||||
@@ -880,9 +880,9 @@ SetupAppendBuffer(
|
||||
|
||||
void
|
||||
Tcl_FreeResult(
|
||||
register Tcl_Interp *interp)/* Interpreter for which to free result. */
|
||||
Tcl_Interp *interp)/* Interpreter for which to free result. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
@@ -917,9 +917,9 @@ Tcl_FreeResult(
|
||||
|
||||
void
|
||||
Tcl_ResetResult(
|
||||
register Tcl_Interp *interp)/* Interpreter for which to clear result. */
|
||||
Tcl_Interp *interp)/* Interpreter for which to clear result. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
ResetObjResult(iPtr);
|
||||
if (iPtr->freeProc != NULL) {
|
||||
@@ -980,10 +980,10 @@ Tcl_ResetResult(
|
||||
|
||||
static void
|
||||
ResetObjResult(
|
||||
register Interp *iPtr) /* Points to the interpreter whose result
|
||||
Interp *iPtr) /* Points to the interpreter whose result
|
||||
* object should be reset. */
|
||||
{
|
||||
register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
|
||||
Tcl_Obj *objResultPtr = iPtr->objResultPtr;
|
||||
|
||||
if (Tcl_IsShared(objResultPtr)) {
|
||||
TclDecrRefCount(objResultPtr);
|
||||
|
||||
+6
-6
@@ -721,7 +721,7 @@ Tcl_ScanObjCmd(
|
||||
switch (ch) {
|
||||
case 'n':
|
||||
if (!(flags & SCAN_SUPPRESS)) {
|
||||
objPtr = Tcl_NewIntObj(string - baseString);
|
||||
TclNewIntObj(objPtr, string - baseString);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
CLANG_ASSERT(objs);
|
||||
objs[objIndex++] = objPtr;
|
||||
@@ -884,7 +884,7 @@ Tcl_ScanObjCmd(
|
||||
offset = TclUtfToUCS4(string, &i);
|
||||
string += offset;
|
||||
if (!(flags & SCAN_SUPPRESS)) {
|
||||
objPtr = Tcl_NewIntObj(i);
|
||||
TclNewIntObj(objPtr, i);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
CLANG_ASSERT(objs);
|
||||
objs[objIndex++] = objPtr;
|
||||
@@ -1035,7 +1035,7 @@ Tcl_ScanObjCmd(
|
||||
* Here no vars were specified, we want a list returned (inline scan)
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
TclNewObj(objPtr);
|
||||
for (i = 0; i < totalVars; i++) {
|
||||
if (objs[i] != NULL) {
|
||||
Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
|
||||
@@ -1056,16 +1056,16 @@ Tcl_ScanObjCmd(
|
||||
if (code == TCL_OK) {
|
||||
if (underflow && (nconversions == 0)) {
|
||||
if (numVars) {
|
||||
objPtr = Tcl_NewIntObj(-1);
|
||||
TclNewIntObj(objPtr, -1);
|
||||
} else {
|
||||
if (objPtr) {
|
||||
Tcl_SetListObj(objPtr, 0, NULL);
|
||||
} else {
|
||||
objPtr = Tcl_NewObj();
|
||||
TclNewObj(objPtr);
|
||||
}
|
||||
}
|
||||
} else if (numVars) {
|
||||
objPtr = Tcl_NewIntObj(result);
|
||||
TclNewIntObj(objPtr, result);
|
||||
}
|
||||
Tcl_SetObjResult(interp, objPtr);
|
||||
}
|
||||
|
||||
+11
-8
@@ -2209,7 +2209,7 @@ Tcl_AppendFormatToObj(
|
||||
isNegative = (l < (long) 0);
|
||||
}
|
||||
|
||||
segment = Tcl_NewObj();
|
||||
TclNewObj(segment);
|
||||
allocSegment = 1;
|
||||
segmentLimit = INT_MAX;
|
||||
Tcl_IncrRefCount(segment);
|
||||
@@ -2249,7 +2249,7 @@ Tcl_AppendFormatToObj(
|
||||
const char *bytes;
|
||||
|
||||
if (useShort) {
|
||||
pure = Tcl_NewIntObj((int) s);
|
||||
TclNewIntObj(pure, (int) s);
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
} else if (useWide) {
|
||||
pure = Tcl_NewWideIntObj(w);
|
||||
@@ -2378,7 +2378,7 @@ Tcl_AppendFormatToObj(
|
||||
if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
|
||||
numDigits = 1;
|
||||
}
|
||||
pure = Tcl_NewObj();
|
||||
TclNewObj(pure);
|
||||
Tcl_SetObjLength(pure, (int) numDigits);
|
||||
bytes = TclGetString(pure);
|
||||
toAppend = length = (int) numDigits;
|
||||
@@ -2497,7 +2497,7 @@ Tcl_AppendFormatToObj(
|
||||
*p++ = (char) ch;
|
||||
*p = '\0';
|
||||
|
||||
segment = Tcl_NewObj();
|
||||
TclNewObj(segment);
|
||||
allocSegment = 1;
|
||||
if (!Tcl_AttemptSetObjLength(segment, length)) {
|
||||
msg = overflow;
|
||||
@@ -2605,8 +2605,9 @@ Tcl_Format(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
int result;
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewObj(objPtr);
|
||||
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
|
||||
if (result != TCL_OK) {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
@@ -2634,9 +2635,10 @@ AppendPrintfToObjVA(
|
||||
va_list argList)
|
||||
{
|
||||
int code, objc;
|
||||
Tcl_Obj **objv, *list = Tcl_NewObj();
|
||||
Tcl_Obj **objv, *list;
|
||||
const char *p;
|
||||
|
||||
TclNewObj(list);
|
||||
p = format;
|
||||
Tcl_IncrRefCount(list);
|
||||
while (*p != '\0') {
|
||||
@@ -2808,8 +2810,9 @@ Tcl_ObjPrintf(
|
||||
...)
|
||||
{
|
||||
va_list argList;
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
TclNewObj(objPtr);
|
||||
va_start(argList, format);
|
||||
AppendPrintfToObjVA(objPtr, format, argList);
|
||||
va_end(argList);
|
||||
@@ -2948,7 +2951,7 @@ TclStringReverse(
|
||||
char *to, *from = objPtr->bytes;
|
||||
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
objPtr = Tcl_NewObj();
|
||||
TclNewObj(objPtr);
|
||||
Tcl_SetObjLength(objPtr, numBytes);
|
||||
}
|
||||
to = objPtr->bytes;
|
||||
|
||||
@@ -59,15 +59,15 @@ typedef struct String {
|
||||
* space allocated for the unicode array. */
|
||||
int hasUnicode; /* Boolean determining whether the string has
|
||||
* a Unicode representation. */
|
||||
Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
|
||||
Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
|
||||
* of this field depends on the 'maxChars'
|
||||
* field above. */
|
||||
} String;
|
||||
|
||||
#define STRING_MAXCHARS \
|
||||
(int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
|
||||
(int)(((size_t)UINT_MAX - 1 - TclOffset(String, unicode))/sizeof(Tcl_UniChar))
|
||||
#define STRING_SIZE(numChars) \
|
||||
(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
|
||||
(TclOffset(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar)))
|
||||
#define stringCheckLimits(numChars) \
|
||||
do { \
|
||||
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
|
||||
|
||||
@@ -465,7 +465,7 @@ mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
|
||||
if (maxlen < 0) {
|
||||
return MP_VAL;
|
||||
}
|
||||
return mp_to_radix(a, str, (size_t)maxlen, NULL, radix);
|
||||
return mp_to_radix(a, str, maxlen, NULL, radix);
|
||||
}
|
||||
|
||||
void bn_reverse(unsigned char *s, int len)
|
||||
|
||||
+71
-26
@@ -307,7 +307,7 @@ static Tcl_FSNormalizePathProc TestReportNormalizePath;
|
||||
static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
|
||||
static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
|
||||
static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
|
||||
|
||||
static Tcl_CmdProc TestServiceModeCmd;
|
||||
static Tcl_FSStatProc SimpleStat;
|
||||
static Tcl_FSAccessProc SimpleAccess;
|
||||
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
|
||||
@@ -561,6 +561,8 @@ Tcltest_Init(
|
||||
NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
|
||||
@@ -1506,15 +1508,15 @@ TestdelCmd(
|
||||
const char **argv) /* Argument strings. */
|
||||
{
|
||||
DelCmd *dPtr;
|
||||
Tcl_Interp *slave;
|
||||
Tcl_Interp *child;
|
||||
|
||||
if (argc != 4) {
|
||||
Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
slave = Tcl_GetSlave(interp, argv[1]);
|
||||
if (slave == NULL) {
|
||||
child = Tcl_GetChild(interp, argv[1]);
|
||||
if (child == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1523,7 +1525,7 @@ TestdelCmd(
|
||||
dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
|
||||
strcpy(dPtr->deleteCmd, argv[3]);
|
||||
|
||||
Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
|
||||
Tcl_CreateCommand(child, argv[2], DelCmdProc, (ClientData) dPtr,
|
||||
DelDeleteProc);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1863,11 +1865,11 @@ TestencodingObjCmd(
|
||||
|
||||
string = Tcl_GetStringFromObj(objv[3], &length);
|
||||
encodingPtr->toUtfCmd = (char *)ckalloc(length + 1);
|
||||
memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
|
||||
memcpy(encodingPtr->toUtfCmd, string, length + 1);
|
||||
|
||||
string = Tcl_GetStringFromObj(objv[4], &length);
|
||||
encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1);
|
||||
memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
|
||||
memcpy(encodingPtr->fromUtfCmd, string, length + 1);
|
||||
|
||||
string = Tcl_GetStringFromObj(objv[2], &length);
|
||||
|
||||
@@ -1916,7 +1918,7 @@ EncodingToUtfProc(
|
||||
if (len > dstLen) {
|
||||
len = dstLen;
|
||||
}
|
||||
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
|
||||
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
|
||||
Tcl_ResetResult(encodingPtr->interp);
|
||||
|
||||
*srcReadPtr = srcLen;
|
||||
@@ -1948,7 +1950,7 @@ EncodingFromUtfProc(
|
||||
if (len > dstLen) {
|
||||
len = dstLen;
|
||||
}
|
||||
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
|
||||
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
|
||||
Tcl_ResetResult(encodingPtr->interp);
|
||||
|
||||
*srcReadPtr = srcLen;
|
||||
@@ -2689,18 +2691,18 @@ TestinterpdeleteCmd(
|
||||
int argc, /* Number of arguments. */
|
||||
const char **argv) /* Argument strings. */
|
||||
{
|
||||
Tcl_Interp *slaveToDelete;
|
||||
Tcl_Interp *childToDelete;
|
||||
|
||||
if (argc != 2) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" path\"", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
slaveToDelete = Tcl_GetSlave(interp, argv[1]);
|
||||
if (slaveToDelete == NULL) {
|
||||
childToDelete = Tcl_GetChild(interp, argv[1]);
|
||||
if (childToDelete == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_DeleteInterp(slaveToDelete);
|
||||
Tcl_DeleteInterp(childToDelete);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -5877,7 +5879,7 @@ TestChannelEventCmd(
|
||||
|
||||
cmd = argv[2];
|
||||
len = strlen(cmd);
|
||||
if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
|
||||
if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) {
|
||||
if (argc != 5) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" channelName add eventSpec script\"", NULL);
|
||||
@@ -5912,7 +5914,7 @@ TestChannelEventCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
|
||||
if ((cmd[0] == 'd') && (strncmp(cmd, "delete", len) == 0)) {
|
||||
if (argc != 4) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" channelName delete index\"", NULL);
|
||||
@@ -5958,7 +5960,7 @@ TestChannelEventCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
|
||||
if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) {
|
||||
if (argc != 3) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" channelName list\"", NULL);
|
||||
@@ -5981,7 +5983,7 @@ TestChannelEventCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
|
||||
if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", len) == 0)) {
|
||||
if (argc != 3) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" channelName removeall\"", NULL);
|
||||
@@ -6000,7 +6002,7 @@ TestChannelEventCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
|
||||
if ((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) {
|
||||
if (argc != 5) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" channelName delete index event\"", NULL);
|
||||
@@ -6046,6 +6048,54 @@ TestChannelEventCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TestServiceModeCmd --
|
||||
*
|
||||
* This procedure implements the "testservicemode" command which gets or
|
||||
* sets the current Tcl ServiceMode. There are several tests which open
|
||||
* a file and assign various handlers to it. For these tests to be
|
||||
* deterministic it is important that file events not be processed until
|
||||
* all of the handlers are in place.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* May change the ServiceMode setting.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
TestServiceModeCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int argc, /* Number of arguments. */
|
||||
const char **argv) /* Argument strings. */
|
||||
{
|
||||
int newmode, oldmode;
|
||||
if (argc > 2) {
|
||||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||||
" ?newmode?\"", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE);
|
||||
if (argc == 2) {
|
||||
if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (newmode == 0) {
|
||||
Tcl_SetServiceMode(TCL_SERVICE_NONE);
|
||||
} else {
|
||||
Tcl_SetServiceMode(TCL_SERVICE_ALL);
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -7348,8 +7398,6 @@ TestconcatobjCmd(
|
||||
"\n\t* (e) concatObj does not have refCount 0", NULL);
|
||||
}
|
||||
if (concatPtr == tmpPtr) {
|
||||
int len;
|
||||
|
||||
result = TCL_ERROR;
|
||||
Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ",
|
||||
NULL);
|
||||
@@ -7380,8 +7428,6 @@ TestconcatobjCmd(
|
||||
"\n\t* (f) concatObj does not have refCount 0", NULL);
|
||||
}
|
||||
if (concatPtr == tmpPtr) {
|
||||
int len;
|
||||
|
||||
result = TCL_ERROR;
|
||||
Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ",
|
||||
NULL);
|
||||
@@ -7413,8 +7459,6 @@ TestconcatobjCmd(
|
||||
"\n\t* (g) concatObj does not have refCount 0", NULL);
|
||||
}
|
||||
if (concatPtr == tmpPtr) {
|
||||
int len;
|
||||
|
||||
result = TCL_ERROR;
|
||||
Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ",
|
||||
NULL);
|
||||
@@ -7509,7 +7553,7 @@ static int
|
||||
InterpCmdResolver(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *context,
|
||||
Tcl_Namespace *dummy,
|
||||
int flags,
|
||||
Tcl_Command *rPtr)
|
||||
{
|
||||
@@ -7519,6 +7563,7 @@ InterpCmdResolver(
|
||||
varFramePtr->procPtr : NULL;
|
||||
Namespace *callerNsPtr = varFramePtr->nsPtr;
|
||||
Tcl_Command resolvedCmdPtr = NULL;
|
||||
(void)dummy;
|
||||
|
||||
/*
|
||||
* Just do something special on a cmd literal "z" in two cases:
|
||||
@@ -7731,7 +7776,7 @@ TestInterpResolverCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 3) {
|
||||
interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
|
||||
interp = Tcl_GetChild(interp, Tcl_GetString(objv[2]));
|
||||
if (interp == NULL) {
|
||||
Tcl_AppendResult(interp, "provided interpreter not found", NULL);
|
||||
return TCL_ERROR;
|
||||
|
||||
@@ -53,7 +53,7 @@ static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
|
||||
static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
|
||||
{
|
||||
register int i;
|
||||
int i;
|
||||
Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
|
||||
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
|
||||
if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
|
||||
@@ -91,7 +91,7 @@ int
|
||||
TclObjTest_Init(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
register int i;
|
||||
int i;
|
||||
/*
|
||||
* An array of Tcl_Obj pointers used in the commands that operate on or get
|
||||
* the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
|
||||
|
||||
+13
-13
@@ -88,13 +88,13 @@ Tcl_GetThreadData(
|
||||
|
||||
if (result == NULL) {
|
||||
result = ckalloc(size);
|
||||
memset(result, 0, (size_t) size);
|
||||
memset(result, 0, size);
|
||||
TclThreadStorageKeySet(keyPtr, result);
|
||||
}
|
||||
#else /* TCL_THREADS */
|
||||
if (*keyPtr == NULL) {
|
||||
result = ckalloc(size);
|
||||
memset(result, 0, (size_t)size);
|
||||
memset(result, 0, size);
|
||||
*keyPtr = result;
|
||||
RememberSyncObject(keyPtr, &keyRecord);
|
||||
} else {
|
||||
@@ -141,7 +141,7 @@ TclThreadDataKeyGet(
|
||||
* Keep a list of (mutexes/condition variable/data key) used during
|
||||
* finalization.
|
||||
*
|
||||
* Assume master lock is held.
|
||||
* Assume global lock is held.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -202,7 +202,7 @@ RememberSyncObject(
|
||||
* ForgetSyncObject
|
||||
*
|
||||
* Remove a single object from the list.
|
||||
* Assume master lock is held.
|
||||
* Assume global lock is held.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -234,7 +234,7 @@ ForgetSyncObject(
|
||||
* TclRememberMutex
|
||||
*
|
||||
* Keep a list of mutexes used during finalization.
|
||||
* Assume master lock is held.
|
||||
* Assume global lock is held.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -276,9 +276,9 @@ Tcl_MutexFinalize(
|
||||
#ifdef TCL_THREADS
|
||||
TclpFinalizeMutex(mutexPtr);
|
||||
#endif
|
||||
TclpMasterLock();
|
||||
TclpGlobalLock();
|
||||
ForgetSyncObject(mutexPtr, &mutexRecord);
|
||||
TclpMasterUnlock();
|
||||
TclpGlobalUnlock();
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -287,7 +287,7 @@ Tcl_MutexFinalize(
|
||||
* TclRememberCondition
|
||||
*
|
||||
* Keep a list of condition variables used during finalization.
|
||||
* Assume master lock is held.
|
||||
* Assume global lock is held.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -329,9 +329,9 @@ Tcl_ConditionFinalize(
|
||||
#ifdef TCL_THREADS
|
||||
TclpFinalizeCondition(condPtr);
|
||||
#endif
|
||||
TclpMasterLock();
|
||||
TclpGlobalLock();
|
||||
ForgetSyncObject(condPtr, &condRecord);
|
||||
TclpMasterUnlock();
|
||||
TclpGlobalUnlock();
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -393,7 +393,7 @@ TclFinalizeSynchronization(void)
|
||||
Tcl_Mutex *mutexPtr;
|
||||
Tcl_Condition *condPtr;
|
||||
|
||||
TclpMasterLock();
|
||||
TclpGlobalLock();
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -415,7 +415,7 @@ TclFinalizeSynchronization(void)
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
/*
|
||||
* Call thread storage master cleanup.
|
||||
* Call thread storage global cleanup.
|
||||
*/
|
||||
|
||||
TclFinalizeThreadStorage();
|
||||
@@ -446,7 +446,7 @@ TclFinalizeSynchronization(void)
|
||||
condRecord.max = 0;
|
||||
condRecord.num = 0;
|
||||
|
||||
TclpMasterUnlock();
|
||||
TclpGlobalUnlock();
|
||||
#endif /* TCL_THREADS */
|
||||
}
|
||||
|
||||
|
||||
+16
-16
@@ -27,11 +27,11 @@
|
||||
*/
|
||||
|
||||
/*
|
||||
* The master collection of information about TSDs. This is shared across the
|
||||
* The global collection of information about TSDs. This is shared across the
|
||||
* whole process, and includes the mutex used to protect it.
|
||||
*/
|
||||
|
||||
static struct TSDMaster {
|
||||
static struct {
|
||||
void *key; /* Key into the system TSD structure. The
|
||||
* collection of Tcl TSD values for a
|
||||
* particular thread will hang off the
|
||||
@@ -41,13 +41,13 @@ static struct TSDMaster {
|
||||
* increasing value. */
|
||||
Tcl_Mutex mutex; /* Protection for the rest of this structure,
|
||||
* which holds per-process data. */
|
||||
} tsdMaster = { NULL, 0, NULL };
|
||||
} tsdGlobal = { NULL, 0, NULL };
|
||||
|
||||
/*
|
||||
* The type of the data held per thread in a system TSD.
|
||||
*/
|
||||
|
||||
typedef struct TSDTable {
|
||||
typedef struct {
|
||||
ClientData *tablePtr; /* The table of Tcl TSDs. */
|
||||
sig_atomic_t allocated; /* The size of the table in the current
|
||||
* thread. */
|
||||
@@ -57,7 +57,7 @@ typedef struct TSDTable {
|
||||
* The actual type of Tcl_ThreadDataKey.
|
||||
*/
|
||||
|
||||
typedef union TSDUnion {
|
||||
typedef union {
|
||||
volatile sig_atomic_t offset;
|
||||
/* The type is really an offset into the
|
||||
* thread-local table of TSDs, which is this
|
||||
@@ -189,7 +189,7 @@ void *
|
||||
TclThreadStorageKeyGet(
|
||||
Tcl_ThreadDataKey *dataKeyPtr)
|
||||
{
|
||||
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
|
||||
TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
|
||||
ClientData resultPtr = NULL;
|
||||
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
|
||||
sig_atomic_t offset = keyPtr->offset;
|
||||
@@ -223,12 +223,12 @@ TclThreadStorageKeySet(
|
||||
Tcl_ThreadDataKey *dataKeyPtr,
|
||||
void *value)
|
||||
{
|
||||
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
|
||||
TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
|
||||
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
|
||||
|
||||
if (tsdTablePtr == NULL) {
|
||||
tsdTablePtr = TSDTableCreate();
|
||||
TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
|
||||
TclpThreadSetGlobalTSD(tsdGlobal.key, tsdTablePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -240,15 +240,15 @@ TclThreadStorageKeySet(
|
||||
*/
|
||||
|
||||
if (keyPtr->offset == 0) {
|
||||
Tcl_MutexLock(&tsdMaster.mutex);
|
||||
Tcl_MutexLock(&tsdGlobal.mutex);
|
||||
if (keyPtr->offset == 0) {
|
||||
/*
|
||||
* The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
|
||||
*/
|
||||
|
||||
keyPtr->offset = ++tsdMaster.counter;
|
||||
keyPtr->offset = ++tsdGlobal.counter;
|
||||
}
|
||||
Tcl_MutexUnlock(&tsdMaster.mutex);
|
||||
Tcl_MutexUnlock(&tsdGlobal.mutex);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -288,11 +288,11 @@ TclThreadStorageKeySet(
|
||||
void
|
||||
TclFinalizeThreadDataThread(void)
|
||||
{
|
||||
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
|
||||
TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
|
||||
|
||||
if (tsdTablePtr != NULL) {
|
||||
TSDTableDelete(tsdTablePtr);
|
||||
TclpThreadSetMasterTSD(tsdMaster.key, NULL);
|
||||
TclpThreadSetGlobalTSD(tsdGlobal.key, NULL);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -316,7 +316,7 @@ TclFinalizeThreadDataThread(void)
|
||||
void
|
||||
TclInitThreadStorage(void)
|
||||
{
|
||||
tsdMaster.key = TclpThreadCreateKey();
|
||||
tsdGlobal.key = TclpThreadCreateKey();
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -339,8 +339,8 @@ TclInitThreadStorage(void)
|
||||
void
|
||||
TclFinalizeThreadStorage(void)
|
||||
{
|
||||
TclpThreadDeleteKey(tsdMaster.key);
|
||||
tsdMaster.key = NULL;
|
||||
TclpThreadDeleteKey(tsdGlobal.key);
|
||||
tsdGlobal.key = NULL;
|
||||
}
|
||||
|
||||
#else /* !TCL_THREADS */
|
||||
|
||||
@@ -294,7 +294,7 @@ ThreadObjCmd(
|
||||
script = Tcl_GetStringFromObj(objv[2], &len);
|
||||
|
||||
if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
|
||||
(0 == strncmp(script, "-joinable", (size_t) len))) {
|
||||
(0 == strncmp(script, "-joinable", len))) {
|
||||
joinable = 1;
|
||||
script = "testthread wait"; /* Just enter event loop */
|
||||
} else {
|
||||
@@ -311,7 +311,7 @@ ThreadObjCmd(
|
||||
|
||||
script = Tcl_GetStringFromObj(objv[2], &len);
|
||||
joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
|
||||
&& (0 == strncmp(script, "-joinable", (size_t) len)));
|
||||
&& (0 == strncmp(script, "-joinable", len)));
|
||||
script = Tcl_GetString(objv[3]);
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
|
||||
|
||||
+6
-6
@@ -217,7 +217,7 @@ TimerExitProc(
|
||||
|
||||
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
|
||||
if (tsdPtr != NULL) {
|
||||
register TimerHandler *timerHandlerPtr;
|
||||
TimerHandler *timerHandlerPtr;
|
||||
|
||||
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
|
||||
while (timerHandlerPtr != NULL) {
|
||||
@@ -294,7 +294,7 @@ TclCreateAbsoluteTimerHandler(
|
||||
Tcl_TimerProc *proc,
|
||||
ClientData clientData)
|
||||
{
|
||||
register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
|
||||
TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
|
||||
ThreadSpecificData *tsdPtr = InitTimer();
|
||||
|
||||
timerHandlerPtr = ckalloc(sizeof(TimerHandler));
|
||||
@@ -355,7 +355,7 @@ Tcl_DeleteTimerHandler(
|
||||
Tcl_TimerToken token) /* Result previously returned by
|
||||
* Tcl_DeleteTimerHandler. */
|
||||
{
|
||||
register TimerHandler *timerHandlerPtr, *prevPtr;
|
||||
TimerHandler *timerHandlerPtr, *prevPtr;
|
||||
ThreadSpecificData *tsdPtr = InitTimer();
|
||||
|
||||
if (token == NULL) {
|
||||
@@ -621,7 +621,7 @@ Tcl_DoWhenIdle(
|
||||
Tcl_IdleProc *proc, /* Function to invoke. */
|
||||
ClientData clientData) /* Arbitrary value to pass to proc. */
|
||||
{
|
||||
register IdleHandler *idlePtr;
|
||||
IdleHandler *idlePtr;
|
||||
Tcl_Time blockTime;
|
||||
ThreadSpecificData *tsdPtr = InitTimer();
|
||||
|
||||
@@ -665,7 +665,7 @@ Tcl_CancelIdleCall(
|
||||
Tcl_IdleProc *proc, /* Function that was previously registered. */
|
||||
ClientData clientData) /* Arbitrary value to pass to proc. */
|
||||
{
|
||||
register IdleHandler *idlePtr, *prevPtr;
|
||||
IdleHandler *idlePtr, *prevPtr;
|
||||
IdleHandler *nextPtr;
|
||||
ThreadSpecificData *tsdPtr = InitTimer();
|
||||
|
||||
@@ -906,7 +906,7 @@ Tcl_AfterObjCmd(
|
||||
tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
|
||||
&tempLength);
|
||||
if ((length == tempLength)
|
||||
&& !memcmp(command, tempCommand, (unsigned) length)) {
|
||||
&& !memcmp(command, tempCommand, length)) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
+25
-26
@@ -136,7 +136,7 @@ static int StringTraceProc(ClientData clientData,
|
||||
static void StringTraceDeleteProc(ClientData clientData);
|
||||
static void DisposeTraceResult(int flags, char *result);
|
||||
static int TraceVarEx(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, register VarTrace *tracePtr);
|
||||
const char *part2, VarTrace *tracePtr);
|
||||
|
||||
/*
|
||||
* The following structure holds the client data for string-based
|
||||
@@ -278,7 +278,7 @@ Tcl_TraceObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
opsList = Tcl_NewObj();
|
||||
TclNewObj(opsList);
|
||||
Tcl_IncrRefCount(opsList);
|
||||
flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
|
||||
if (numFlags == 0) {
|
||||
@@ -322,7 +322,7 @@ Tcl_TraceObjCmd(
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "name");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
resultListPtr = Tcl_NewObj();
|
||||
TclNewObj(resultListPtr);
|
||||
name = Tcl_GetString(objv[2]);
|
||||
FOREACH_VAR_TRACE(interp, name, clientData) {
|
||||
TraceVarInfo *tvarPtr = clientData;
|
||||
@@ -967,7 +967,7 @@ TraceVariableObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resultListPtr = Tcl_NewObj();
|
||||
TclNewObj(resultListPtr);
|
||||
name = Tcl_GetString(objv[3]);
|
||||
FOREACH_VAR_TRACE(interp, name, clientData) {
|
||||
Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
|
||||
@@ -1049,7 +1049,7 @@ Tcl_CommandTraceInfo(
|
||||
* call will return the first trace. */
|
||||
{
|
||||
Command *cmdPtr;
|
||||
register CommandTrace *tracePtr;
|
||||
CommandTrace *tracePtr;
|
||||
|
||||
cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
|
||||
TCL_LEAVE_ERR_MSG);
|
||||
@@ -1114,7 +1114,7 @@ Tcl_TraceCommand(
|
||||
ClientData clientData) /* Arbitrary argument to pass to proc. */
|
||||
{
|
||||
Command *cmdPtr;
|
||||
register CommandTrace *tracePtr;
|
||||
CommandTrace *tracePtr;
|
||||
|
||||
cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
|
||||
TCL_LEAVE_ERR_MSG);
|
||||
@@ -1177,10 +1177,10 @@ Tcl_UntraceCommand(
|
||||
Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
|
||||
ClientData clientData) /* Arbitrary argument to pass to proc. */
|
||||
{
|
||||
register CommandTrace *tracePtr;
|
||||
CommandTrace *tracePtr;
|
||||
CommandTrace *prevPtr;
|
||||
Command *cmdPtr;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Interp *iPtr = (Interp *)interp;
|
||||
ActiveCommandTrace *activePtr;
|
||||
int hasExecTraces = 0;
|
||||
|
||||
@@ -1255,7 +1255,6 @@ Tcl_UntraceCommand(
|
||||
*/
|
||||
|
||||
if (cmdPtr->compileProc != NULL) {
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
iPtr->compileEpoch++;
|
||||
}
|
||||
}
|
||||
@@ -1672,13 +1671,13 @@ TclCheckInterpTraces(
|
||||
static int
|
||||
CallTraceFunction(
|
||||
Tcl_Interp *interp, /* The current interpreter. */
|
||||
register Trace *tracePtr, /* Describes the trace function to call. */
|
||||
Trace *tracePtr, /* Describes the trace function to call. */
|
||||
Command *cmdPtr, /* Points to command's Command struct. */
|
||||
const char *command, /* Points to the first character of the
|
||||
* command's source before substitutions. */
|
||||
int numChars, /* The number of characters in the command's
|
||||
* source. */
|
||||
register int objc, /* Number of arguments for the command. */
|
||||
int objc, /* Number of arguments for the command. */
|
||||
Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
@@ -1689,8 +1688,8 @@ CallTraceFunction(
|
||||
* Copy the command characters into a new string.
|
||||
*/
|
||||
|
||||
commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1);
|
||||
memcpy(commandCopy, command, (size_t) numChars);
|
||||
commandCopy = TclStackAlloc(interp, numChars + 1);
|
||||
memcpy(commandCopy, command, numChars);
|
||||
commandCopy[numChars] = '\0';
|
||||
|
||||
/*
|
||||
@@ -1853,7 +1852,7 @@ TraceExecutionProc(
|
||||
* Append result code.
|
||||
*/
|
||||
|
||||
resultCode = Tcl_NewIntObj(code);
|
||||
TclNewIntObj(resultCode, code);
|
||||
resultCodeStr = Tcl_GetString(resultCode);
|
||||
Tcl_DStringAppendElement(&cmd, resultCodeStr);
|
||||
Tcl_DecrRefCount(resultCode);
|
||||
@@ -1920,7 +1919,7 @@ TraceExecutionProc(
|
||||
if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
|
||||
&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
|
||||
TCL_TRACE_LEAVE_DURING_EXEC))) {
|
||||
register unsigned len = strlen(command) + 1;
|
||||
unsigned len = strlen(command) + 1;
|
||||
|
||||
tcmdPtr->startLevel = level;
|
||||
tcmdPtr->startCmd = ckalloc(len);
|
||||
@@ -2065,7 +2064,7 @@ TraceVarProc(
|
||||
}
|
||||
}
|
||||
if (destroy && result != NULL) {
|
||||
register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
|
||||
Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
|
||||
|
||||
Tcl_DecrRefCount(errMsgObj);
|
||||
result = NULL;
|
||||
@@ -2142,8 +2141,8 @@ Tcl_CreateObjTrace(
|
||||
Tcl_CmdObjTraceDeleteProc *delProc)
|
||||
/* Function to call when trace is deleted */
|
||||
{
|
||||
register Trace *tracePtr;
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Trace *tracePtr;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Test if this trace allows inline compilation of commands.
|
||||
@@ -2342,7 +2341,7 @@ Tcl_DeleteTrace(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Trace *prevPtr, *tracePtr = (Trace *) trace;
|
||||
register Trace **tracePtr2 = &iPtr->tracePtr;
|
||||
Trace **tracePtr2 = &iPtr->tracePtr;
|
||||
ActiveInterpTrace *activePtr;
|
||||
|
||||
/*
|
||||
@@ -2534,7 +2533,7 @@ TclCheckArrayTraces(
|
||||
int
|
||||
TclObjCallVarTraces(
|
||||
Interp *iPtr, /* Interpreter containing variable. */
|
||||
register Var *arrayPtr, /* Pointer to array variable that contains the
|
||||
Var *arrayPtr, /* Pointer to array variable that contains the
|
||||
* variable, or NULL if the variable isn't an
|
||||
* element of an array. */
|
||||
Var *varPtr, /* Variable whose traces are to be invoked. */
|
||||
@@ -2568,7 +2567,7 @@ TclObjCallVarTraces(
|
||||
int
|
||||
TclCallVarTraces(
|
||||
Interp *iPtr, /* Interpreter containing variable. */
|
||||
register Var *arrayPtr, /* Pointer to array variable that contains the
|
||||
Var *arrayPtr, /* Pointer to array variable that contains the
|
||||
* variable, or NULL if the variable isn't an
|
||||
* element of an array. */
|
||||
Var *varPtr, /* Variable whose traces are to be invoked. */
|
||||
@@ -2581,7 +2580,7 @@ TclCallVarTraces(
|
||||
* error, then leave an error message and
|
||||
* stack trace information in *iPTr. */
|
||||
{
|
||||
register VarTrace *tracePtr;
|
||||
VarTrace *tracePtr;
|
||||
ActiveVarTrace active;
|
||||
char *result;
|
||||
const char *openParen, *p;
|
||||
@@ -2909,7 +2908,7 @@ Tcl_UntraceVar2(
|
||||
Tcl_VarTraceProc *proc, /* Function assocated with trace. */
|
||||
ClientData clientData) /* Arbitrary argument to pass to proc. */
|
||||
{
|
||||
register VarTrace *tracePtr;
|
||||
VarTrace *tracePtr;
|
||||
VarTrace *prevPtr, *nextPtr;
|
||||
Var *varPtr, *arrayPtr;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
@@ -3099,7 +3098,7 @@ Tcl_VarTraceInfo2(
|
||||
hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
|
||||
|
||||
if (hPtr) {
|
||||
register VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
|
||||
VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (prevClientData != NULL) {
|
||||
for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
|
||||
@@ -3195,7 +3194,7 @@ Tcl_TraceVar2(
|
||||
* invoked upon varName. */
|
||||
ClientData clientData) /* Arbitrary argument to pass to proc. */
|
||||
{
|
||||
register VarTrace *tracePtr;
|
||||
VarTrace *tracePtr;
|
||||
int result;
|
||||
|
||||
tracePtr = ckalloc(sizeof(VarTrace));
|
||||
@@ -3240,7 +3239,7 @@ TraceVarEx(
|
||||
const char *part2, /* Name of element within array; NULL means
|
||||
* trace applies to scalar variable or array
|
||||
* as-a-whole. */
|
||||
register VarTrace *tracePtr)/* Structure containing flags, traceProc and
|
||||
VarTrace *tracePtr)/* Structure containing flags, traceProc and
|
||||
* clientData fields. Others should be left
|
||||
* blank. Will be ckfree()d (eventually) if
|
||||
* this function returns TCL_OK, and up to
|
||||
|
||||
+3
-3
@@ -2036,7 +2036,7 @@ Tcl_ConcatObj(
|
||||
}
|
||||
}
|
||||
if (!resPtr) {
|
||||
resPtr = Tcl_NewObj();
|
||||
TclNewObj(resPtr);
|
||||
}
|
||||
return resPtr;
|
||||
}
|
||||
@@ -4263,8 +4263,8 @@ TclGetProcessGlobalValue(
|
||||
|
||||
if (pgvPtr->encoding != current) {
|
||||
/*
|
||||
* The system encoding has changed since the master string value
|
||||
* was saved. Convert the master value to be based on the new
|
||||
* The system encoding has changed since the global string value
|
||||
* was saved. Convert the global value to be based on the new
|
||||
* system encoding.
|
||||
*/
|
||||
|
||||
|
||||
+69
-68
@@ -123,17 +123,17 @@ VarHashNextVar(
|
||||
* access is denied.
|
||||
*/
|
||||
|
||||
static const char *noSuchVar = "no such variable";
|
||||
static const char *isArray = "variable is array";
|
||||
static const char *needArray = "variable isn't array";
|
||||
static const char *noSuchElement = "no such element in array";
|
||||
static const char *danglingElement =
|
||||
static const char NOSUCHVAR[] = "no such variable";
|
||||
static const char ISARRAY[] = "variable is array";
|
||||
static const char NEEDARRAY[] = "variable isn't array";
|
||||
static const char NOSUCHELEMENT[] = "no such element in array";
|
||||
static const char DANGLINGELEMENT[] =
|
||||
"upvar refers to element in deleted array";
|
||||
static const char *danglingVar =
|
||||
static const char DANGLINGVAR[] =
|
||||
"upvar refers to variable in deleted namespace";
|
||||
static const char *badNamespace = "parent namespace doesn't exist";
|
||||
static const char *missingName = "missing variable name";
|
||||
static const char *isArrayElement =
|
||||
static const char BADNAMESPACE[] = "parent namespace doesn't exist";
|
||||
static const char MISSINGNAME[] = "missing variable name";
|
||||
static const char ISARRAYELEMENT[] =
|
||||
"name refers to an element in an array";
|
||||
|
||||
/*
|
||||
@@ -489,7 +489,7 @@ TclLookupVar(
|
||||
Var *
|
||||
TclObjLookupVar(
|
||||
Tcl_Interp *interp, /* Interpreter to use for lookup. */
|
||||
register Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an
|
||||
Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an
|
||||
* array. Otherwise, this is a full variable
|
||||
* name that could include a parenthesized
|
||||
* array element. */
|
||||
@@ -561,7 +561,7 @@ TclObjLookupVarEx(
|
||||
* is set to NULL. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Var *varPtr; /* Points to the variable's in-frame Var
|
||||
Var *varPtr; /* Points to the variable's in-frame Var
|
||||
* structure. */
|
||||
const char *part1;
|
||||
int index, len1, len2;
|
||||
@@ -613,7 +613,7 @@ TclObjLookupVarEx(
|
||||
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
|
||||
noSuchVar, -1);
|
||||
NOSUCHVAR, -1);
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
|
||||
}
|
||||
return NULL;
|
||||
@@ -640,7 +640,7 @@ TclObjLookupVarEx(
|
||||
* part1Ptr is possibly an unparsed array element.
|
||||
*/
|
||||
|
||||
register int i;
|
||||
int i;
|
||||
|
||||
len2 = -1;
|
||||
for (i = 0; i < len1; i++) {
|
||||
@@ -648,7 +648,7 @@ TclObjLookupVarEx(
|
||||
if (part2Ptr != NULL) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
|
||||
needArray, -1);
|
||||
NEEDARRAY, -1);
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
|
||||
NULL);
|
||||
}
|
||||
@@ -665,7 +665,7 @@ TclObjLookupVarEx(
|
||||
len1 = i;
|
||||
|
||||
newPart2 = ckalloc(len2 + 1);
|
||||
memcpy(newPart2, part2, (unsigned) len2);
|
||||
memcpy(newPart2, part2, len2);
|
||||
*(newPart2+len2) = '\0';
|
||||
part2 = newPart2;
|
||||
part2Ptr = Tcl_NewStringObj(newPart2, -1);
|
||||
@@ -942,10 +942,10 @@ TclLookupSimpleVar(
|
||||
TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
|
||||
flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
|
||||
if (varNsPtr == NULL) {
|
||||
*errMsgPtr = badNamespace;
|
||||
*errMsgPtr = BADNAMESPACE;
|
||||
return NULL;
|
||||
} else if (tail == NULL) {
|
||||
*errMsgPtr = missingName;
|
||||
*errMsgPtr = MISSINGNAME;
|
||||
return NULL;
|
||||
}
|
||||
if (tail != varName) {
|
||||
@@ -967,7 +967,7 @@ TclLookupSimpleVar(
|
||||
*indexPtr = -2;
|
||||
}
|
||||
} else { /* Var wasn't found and not to create it. */
|
||||
*errMsgPtr = noSuchVar;
|
||||
*errMsgPtr = NOSUCHVAR;
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
@@ -980,7 +980,7 @@ TclLookupSimpleVar(
|
||||
int localLen;
|
||||
|
||||
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
|
||||
register Tcl_Obj *objPtr = *objPtrPtr;
|
||||
Tcl_Obj *objPtr = *objPtrPtr;
|
||||
|
||||
if (objPtr) {
|
||||
localNameStr = TclGetStringFromObj(objPtr, &localLen);
|
||||
@@ -1007,7 +1007,7 @@ TclLookupSimpleVar(
|
||||
varPtr = VarHashFindVar(tablePtr, varNamePtr);
|
||||
}
|
||||
if (varPtr == NULL) {
|
||||
*errMsgPtr = noSuchVar;
|
||||
*errMsgPtr = NOSUCHVAR;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1087,7 +1087,7 @@ TclLookupArrayElement(
|
||||
if (!createArray) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
|
||||
noSuchVar, index);
|
||||
NOSUCHVAR, index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
|
||||
arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
|
||||
}
|
||||
@@ -1102,7 +1102,7 @@ TclLookupArrayElement(
|
||||
if (TclIsVarDeadHash(arrayPtr)) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
|
||||
danglingVar, index);
|
||||
DANGLINGVAR, index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
|
||||
arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
|
||||
}
|
||||
@@ -1121,7 +1121,7 @@ TclLookupArrayElement(
|
||||
TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
|
||||
} else if (!TclIsVarArray(arrayPtr)) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
|
||||
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY,
|
||||
index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
|
||||
arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
|
||||
@@ -1143,7 +1143,7 @@ TclLookupArrayElement(
|
||||
if (varPtr == NULL) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
|
||||
noSuchElement, index);
|
||||
NOSUCHELEMENT, index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
|
||||
TclGetString(elNamePtr), NULL);
|
||||
}
|
||||
@@ -1330,10 +1330,10 @@ Tcl_Obj *
|
||||
Tcl_ObjGetVar2(
|
||||
Tcl_Interp *interp, /* Command interpreter in which variable is to
|
||||
* be looked up. */
|
||||
register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
|
||||
Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
|
||||
* array (if part2 is non-NULL) or the name of
|
||||
* a variable. */
|
||||
register Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
|
||||
Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
|
||||
* the name of an element in the array
|
||||
* part1Ptr. */
|
||||
int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and
|
||||
@@ -1428,7 +1428,7 @@ Tcl_Obj *
|
||||
TclPtrGetVarIdx(
|
||||
Tcl_Interp *interp, /* Command interpreter in which variable is to
|
||||
* be looked up. */
|
||||
register Var *varPtr, /* The variable to be read.*/
|
||||
Var *varPtr, /* The variable to be read.*/
|
||||
Var *arrayPtr, /* NULL for scalar variables, pointer to the
|
||||
* containing array otherwise. */
|
||||
Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
|
||||
@@ -1469,11 +1469,11 @@ TclPtrGetVarIdx(
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
if (TclIsVarUndefined(varPtr) && arrayPtr
|
||||
&& !TclIsVarUndefined(arrayPtr)) {
|
||||
msg = noSuchElement;
|
||||
msg = NOSUCHELEMENT;
|
||||
} else if (TclIsVarArray(varPtr)) {
|
||||
msg = isArray;
|
||||
msg = ISARRAY;
|
||||
} else {
|
||||
msg = noSuchVar;
|
||||
msg = NOSUCHVAR;
|
||||
}
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
|
||||
}
|
||||
@@ -1512,7 +1512,7 @@ TclPtrGetVarIdx(
|
||||
int
|
||||
Tcl_SetObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
register Tcl_Interp *interp,/* Current interpreter. */
|
||||
Tcl_Interp *interp,/* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
@@ -1738,10 +1738,10 @@ Tcl_Obj *
|
||||
Tcl_ObjSetVar2(
|
||||
Tcl_Interp *interp, /* Command interpreter in which variable is to
|
||||
* be found. */
|
||||
register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
|
||||
Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
|
||||
* array (if part2 is non-NULL) or the name of
|
||||
* a variable. */
|
||||
register Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding
|
||||
Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding
|
||||
* the name of an element in the array
|
||||
* part1Ptr. */
|
||||
Tcl_Obj *newValuePtr, /* New value for variable. */
|
||||
@@ -1854,7 +1854,7 @@ Tcl_Obj *
|
||||
TclPtrSetVarIdx(
|
||||
Tcl_Interp *interp, /* Command interpreter in which variable is to
|
||||
* be looked up. */
|
||||
register Var *varPtr, /* Reference to the variable to set. */
|
||||
Var *varPtr, /* Reference to the variable to set. */
|
||||
Var *arrayPtr, /* Reference to the array containing the
|
||||
* variable, or NULL if the variable is a
|
||||
* scalar. */
|
||||
@@ -1887,11 +1887,11 @@ TclPtrSetVarIdx(
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
if (TclIsVarArrayElement(varPtr)) {
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
|
||||
danglingElement, index);
|
||||
DANGLINGELEMENT, index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
|
||||
} else {
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
|
||||
danglingVar, index);
|
||||
DANGLINGVAR, index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
|
||||
}
|
||||
}
|
||||
@@ -1904,7 +1904,7 @@ TclPtrSetVarIdx(
|
||||
|
||||
if (TclIsVarArray(varPtr)) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
|
||||
}
|
||||
goto earlyError;
|
||||
@@ -2205,7 +2205,7 @@ TclPtrIncrObjVarIdx(
|
||||
* variable, or -1. Only used when part1Ptr is
|
||||
* NULL. */
|
||||
{
|
||||
register Tcl_Obj *varValuePtr;
|
||||
Tcl_Obj *varValuePtr;
|
||||
|
||||
if (TclIsVarInHash(varPtr)) {
|
||||
VarHashRefCount(varPtr)++;
|
||||
@@ -2216,7 +2216,7 @@ TclPtrIncrObjVarIdx(
|
||||
VarHashRefCount(varPtr)--;
|
||||
}
|
||||
if (varValuePtr == NULL) {
|
||||
varValuePtr = Tcl_NewIntObj(0);
|
||||
TclNewIntObj(varValuePtr, 0);
|
||||
}
|
||||
if (Tcl_IsShared(varValuePtr)) {
|
||||
/* Copy on write */
|
||||
@@ -2465,7 +2465,7 @@ int
|
||||
TclPtrUnsetVarIdx(
|
||||
Tcl_Interp *interp, /* Command interpreter in which varName is to
|
||||
* be looked up. */
|
||||
register Var *varPtr, /* The variable to be unset. */
|
||||
Var *varPtr, /* The variable to be unset. */
|
||||
Var *arrayPtr, /* NULL for scalar variables, pointer to the
|
||||
* containing array otherwise. */
|
||||
Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
|
||||
@@ -2502,7 +2502,7 @@ TclPtrUnsetVarIdx(
|
||||
if (result != TCL_OK) {
|
||||
if (flags & TCL_LEAVE_ERR_MSG) {
|
||||
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
|
||||
((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
|
||||
((arrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
|
||||
Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
|
||||
}
|
||||
}
|
||||
@@ -2719,8 +2719,8 @@ Tcl_UnsetObjCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register int i, flags = TCL_LEAVE_ERR_MSG;
|
||||
register const char *name;
|
||||
int i, flags = TCL_LEAVE_ERR_MSG;
|
||||
const char *name;
|
||||
|
||||
if (objc == 1) {
|
||||
/*
|
||||
@@ -2788,7 +2788,7 @@ Tcl_AppendObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Var *varPtr, *arrayPtr;
|
||||
register Tcl_Obj *varValuePtr = NULL;
|
||||
Tcl_Obj *varValuePtr = NULL;
|
||||
/* Initialized to avoid compiler warning. */
|
||||
int i;
|
||||
|
||||
@@ -3697,7 +3697,7 @@ ArraySetCmd(
|
||||
}
|
||||
if (arrayPtr) {
|
||||
CleanupVar(varPtr, arrayPtr);
|
||||
TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
|
||||
TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY, -1);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
|
||||
TclGetString(arrayNameObj), NULL);
|
||||
return TCL_ERROR;
|
||||
@@ -3815,7 +3815,7 @@ ArraySetCmd(
|
||||
*/
|
||||
|
||||
TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
|
||||
needArray, -1);
|
||||
NEEDARRAY, -1);
|
||||
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -4529,7 +4529,7 @@ Tcl_GetVariableFullName(
|
||||
* variable's full name is appended. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Var *varPtr = (Var *) variable;
|
||||
Var *varPtr = (Var *) variable;
|
||||
Tcl_Obj *namePtr;
|
||||
Namespace *nsPtr;
|
||||
|
||||
@@ -4589,9 +4589,9 @@ Tcl_GlobalObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Tcl_Obj *objPtr, *tailPtr;
|
||||
Tcl_Obj *objPtr, *tailPtr;
|
||||
const char *varName;
|
||||
register const char *tail;
|
||||
const char *tail;
|
||||
int result, i;
|
||||
|
||||
/*
|
||||
@@ -4718,7 +4718,7 @@ Tcl_VariableObjCmd(
|
||||
*/
|
||||
|
||||
TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
|
||||
isArrayElement, -1);
|
||||
ISARRAYELEMENT, -1);
|
||||
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -4999,8 +4999,8 @@ ParseSearchId(
|
||||
* name. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register const char *string;
|
||||
register size_t offset;
|
||||
const char *string;
|
||||
size_t offset;
|
||||
int id;
|
||||
ArraySearch *searchPtr;
|
||||
const char *varName = TclGetString(varNamePtr);
|
||||
@@ -5081,7 +5081,7 @@ ParseSearchId(
|
||||
static void
|
||||
DeleteSearches(
|
||||
Interp *iPtr,
|
||||
register Var *arrayVarPtr) /* Variable whose searches are to be
|
||||
Var *arrayVarPtr) /* Variable whose searches are to be
|
||||
* deleted. */
|
||||
{
|
||||
ArraySearch *searchPtr, *nextPtr;
|
||||
@@ -5140,7 +5140,8 @@ TclDeleteNamespaceVars(
|
||||
|
||||
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
|
||||
varPtr = VarHashFirstVar(tablePtr, &search)) {
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
Tcl_Obj *objPtr;
|
||||
TclNewObj(objPtr);
|
||||
VarHashRefCount(varPtr)++; /* Make sure we get to remove from
|
||||
* hash. */
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
|
||||
@@ -5222,7 +5223,7 @@ TclDeleteVars(
|
||||
{
|
||||
Tcl_Interp *interp = (Tcl_Interp *) iPtr;
|
||||
Tcl_HashSearch search;
|
||||
register Var *varPtr;
|
||||
Var *varPtr;
|
||||
int flags;
|
||||
Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
|
||||
|
||||
@@ -5274,7 +5275,7 @@ TclDeleteCompiledLocalVars(
|
||||
CallFrame *framePtr) /* Procedure call frame containing compiler-
|
||||
* assigned local variables to delete. */
|
||||
{
|
||||
register Var *varPtr;
|
||||
Var *varPtr;
|
||||
int numLocals, i;
|
||||
Tcl_Obj **namePtrPtr;
|
||||
|
||||
@@ -5323,7 +5324,7 @@ DeleteArray(
|
||||
{
|
||||
Tcl_HashSearch search;
|
||||
Tcl_HashEntry *tPtr;
|
||||
register Var *elPtr;
|
||||
Var *elPtr;
|
||||
ActiveVarTrace *activePtr;
|
||||
Tcl_Obj *objPtr;
|
||||
VarTrace *tracePtr;
|
||||
@@ -5535,8 +5536,8 @@ static void
|
||||
FreeParsedVarName(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
|
||||
Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
char *elem = objPtr->internalRep.twoPtrValue.ptr2;
|
||||
|
||||
if (arrayPtr != NULL) {
|
||||
TclDecrRefCount(arrayPtr);
|
||||
@@ -5550,8 +5551,8 @@ DupParsedVarName(
|
||||
Tcl_Obj *srcPtr,
|
||||
Tcl_Obj *dupPtr)
|
||||
{
|
||||
register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
|
||||
Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
|
||||
char *elemCopy;
|
||||
unsigned elemLen;
|
||||
|
||||
@@ -5595,10 +5596,10 @@ UpdateParsedVarName(
|
||||
objPtr->bytes = p;
|
||||
objPtr->length = totalLen;
|
||||
|
||||
memcpy(p, part1, (unsigned) len1);
|
||||
memcpy(p, part1, len1);
|
||||
p += len1;
|
||||
*p++ = '(';
|
||||
memcpy(p, part2, (unsigned) len2);
|
||||
memcpy(p, part2, len2);
|
||||
p += len2;
|
||||
*p++ = ')';
|
||||
*p = '\0';
|
||||
@@ -5684,7 +5685,7 @@ ObjFindNamespaceVar(
|
||||
Namespace *nsPtr[2], *cxtNsPtr;
|
||||
const char *simpleName;
|
||||
Var *varPtr;
|
||||
register int search;
|
||||
int search;
|
||||
int result;
|
||||
Tcl_Var var;
|
||||
Tcl_Obj *simpleNamePtr;
|
||||
@@ -5875,7 +5876,7 @@ TclInfoVarsCmd(
|
||||
if (!TclIsVarUndefined(varPtr)
|
||||
|| TclIsVarNamespaceVar(varPtr)) {
|
||||
if (specificNsInPattern) {
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
|
||||
elemObjPtr);
|
||||
} else {
|
||||
@@ -5908,7 +5909,7 @@ TclInfoVarsCmd(
|
||||
if ((simplePattern == NULL)
|
||||
|| Tcl_StringMatch(varName, simplePattern)) {
|
||||
if (specificNsInPattern) {
|
||||
elemObjPtr = Tcl_NewObj();
|
||||
TclNewObj(elemObjPtr);
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
|
||||
elemObjPtr);
|
||||
} else {
|
||||
@@ -6311,8 +6312,8 @@ CompareVarKeys(
|
||||
{
|
||||
Tcl_Obj *objPtr1 = keyPtr;
|
||||
Tcl_Obj *objPtr2 = hPtr->key.objPtr;
|
||||
register const char *p1, *p2;
|
||||
register int l1, l2;
|
||||
const char *p1, *p2;
|
||||
int l1, l2;
|
||||
|
||||
/*
|
||||
* If the object pointers are the same then they match.
|
||||
|
||||
+11
-10
@@ -205,7 +205,7 @@ static void ZlibTransformTimerRun(ClientData clientData);
|
||||
|
||||
static const Tcl_ChannelType zlibChannelType = {
|
||||
"zlib",
|
||||
TCL_CHANNEL_VERSION_3,
|
||||
TCL_CHANNEL_VERSION_5,
|
||||
ZlibTransformClose,
|
||||
ZlibTransformInput,
|
||||
ZlibTransformOutput,
|
||||
@@ -2133,7 +2133,7 @@ ZlibCmd(
|
||||
break;
|
||||
case 1:
|
||||
headerVarObj = objv[i+1];
|
||||
headerDictObj = Tcl_NewObj();
|
||||
TclNewObj(headerDictObj);
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -2664,21 +2664,21 @@ ZlibStreamAddCmd(
|
||||
|
||||
switch ((enum addOptions) index) {
|
||||
case ao_flush: /* -flush */
|
||||
if (flush > -1) {
|
||||
if (flush >= 0) {
|
||||
flush = -2;
|
||||
} else {
|
||||
flush = Z_SYNC_FLUSH;
|
||||
}
|
||||
break;
|
||||
case ao_fullflush: /* -fullflush */
|
||||
if (flush > -1) {
|
||||
if (flush >= 0) {
|
||||
flush = -2;
|
||||
} else {
|
||||
flush = Z_FULL_FLUSH;
|
||||
}
|
||||
break;
|
||||
case ao_finalize: /* -finalize */
|
||||
if (flush > -1) {
|
||||
if (flush >= 0) {
|
||||
flush = -2;
|
||||
} else {
|
||||
flush = Z_FINISH;
|
||||
@@ -2788,21 +2788,21 @@ ZlibStreamPutCmd(
|
||||
|
||||
switch ((enum putOptions) index) {
|
||||
case po_flush: /* -flush */
|
||||
if (flush > -1) {
|
||||
if (flush >= 0) {
|
||||
flush = -2;
|
||||
} else {
|
||||
flush = Z_SYNC_FLUSH;
|
||||
}
|
||||
break;
|
||||
case po_fullflush: /* -fullflush */
|
||||
if (flush > -1) {
|
||||
if (flush >= 0) {
|
||||
flush = -2;
|
||||
} else {
|
||||
flush = Z_FULL_FLUSH;
|
||||
}
|
||||
break;
|
||||
case po_finalize: /* -finalize */
|
||||
if (flush > -1) {
|
||||
if (flush >= 0) {
|
||||
flush = -2;
|
||||
} else {
|
||||
flush = Z_FINISH;
|
||||
@@ -3432,8 +3432,9 @@ ZlibTransformGetOption(
|
||||
|
||||
if ((cd->flags & IN_HEADER) && ((optionName == NULL) ||
|
||||
(strcmp(optionName, "-header") == 0))) {
|
||||
Tcl_Obj *tmpObj = Tcl_NewObj();
|
||||
Tcl_Obj *tmpObj;
|
||||
|
||||
TclNewObj(tmpObj);
|
||||
ExtractHeader(&cd->inHeader.header, tmpObj);
|
||||
if (optionName == NULL) {
|
||||
Tcl_DStringAppendElement(dsPtr, "-header");
|
||||
@@ -3683,7 +3684,7 @@ ZlibStackChannelTransform(
|
||||
if (cd->inAllocated < cd->readAheadLimit) {
|
||||
cd->inAllocated = cd->readAheadLimit;
|
||||
}
|
||||
cd->inBuffer = ckalloc(cd->inAllocated);
|
||||
cd->inBuffer = (char *)ckalloc(cd->inAllocated);
|
||||
if (cd->flags & IN_HEADER) {
|
||||
if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
|
||||
goto error;
|
||||
|
||||
+9
-7
@@ -240,6 +240,7 @@ proc auto_mkindex_old {dir args} {
|
||||
set f ""
|
||||
set error [catch {
|
||||
set f [open $file]
|
||||
fconfigure $f -eofchar \032
|
||||
while {[gets $f line] >= 0} {
|
||||
if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
|
||||
set procName [lindex [auto_qualify $procName "::"] 0]
|
||||
@@ -350,6 +351,7 @@ proc auto_mkindex_parser::mkindex {file} {
|
||||
set scriptFile $file
|
||||
|
||||
set fid [open $file]
|
||||
fconfigure $fid -eofchar \032
|
||||
set contents [read $fid]
|
||||
close $fid
|
||||
|
||||
@@ -376,10 +378,10 @@ proc auto_mkindex_parser::mkindex {file} {
|
||||
|
||||
# auto_mkindex_parser::hook command
|
||||
#
|
||||
# Registers a Tcl command to evaluate when initializing the slave interpreter
|
||||
# used by the mkindex parser. The command is evaluated in the master
|
||||
# Registers a Tcl command to evaluate when initializing the child interpreter
|
||||
# used by the mkindex parser. The command is evaluated in the parent
|
||||
# interpreter, and can use the variable auto_mkindex_parser::parser to get to
|
||||
# the slave
|
||||
# the child
|
||||
|
||||
proc auto_mkindex_parser::hook {cmd} {
|
||||
variable initCommands
|
||||
@@ -389,14 +391,14 @@ proc auto_mkindex_parser::hook {cmd} {
|
||||
|
||||
# auto_mkindex_parser::slavehook command
|
||||
#
|
||||
# Registers a Tcl command to evaluate when initializing the slave interpreter
|
||||
# used by the mkindex parser. The command is evaluated in the slave
|
||||
# Registers a Tcl command to evaluate when initializing the child interpreter
|
||||
# used by the mkindex parser. The command is evaluated in the child
|
||||
# interpreter.
|
||||
|
||||
proc auto_mkindex_parser::slavehook {cmd} {
|
||||
variable initCommands
|
||||
|
||||
# The $parser variable is defined to be the name of the slave interpreter
|
||||
# The $parser variable is defined to be the name of the child interpreter
|
||||
# when this command is used later.
|
||||
|
||||
lappend initCommands "\$parser eval [list $cmd]"
|
||||
@@ -550,7 +552,7 @@ auto_mkindex_parser::command proc {name args} {
|
||||
|
||||
# Conditionally add support for Tcl byte code files. There are some tricky
|
||||
# details here. First, we need to get the tbcload library initialized in the
|
||||
# current interpreter. We cannot load tbcload into the slave until we have
|
||||
# current interpreter. We cannot load tbcload into the child until we have
|
||||
# done so because it needs access to the tcl_patchLevel variable. Second,
|
||||
# because the package index file may defer loading the library until we invoke
|
||||
# a command, we need to explicitly invoke auto_load to force it to be loaded.
|
||||
|
||||
+2
-2
@@ -3304,7 +3304,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
|
||||
return
|
||||
}
|
||||
|
||||
# Since an unsafe interp uses the [clock] command in the master, this code
|
||||
# Since an unsafe interp uses the [clock] command in the parent, this code
|
||||
# is security sensitive. Make sure that the path name cannot escape the
|
||||
# given directory.
|
||||
|
||||
@@ -3344,7 +3344,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
|
||||
proc ::tcl::clock::LoadZoneinfoFile { fileName } {
|
||||
variable ZoneinfoPaths
|
||||
|
||||
# Since an unsafe interp uses the [clock] command in the master, this code
|
||||
# Since an unsafe interp uses the [clock] command in the parent, this code
|
||||
# is security sensitive. Make sure that the path name cannot escape the
|
||||
# given directory.
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} return
|
||||
if {[info sharedlibextension] != ".dll"} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] dde]
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] Dde]
|
||||
} else {
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] Dde]
|
||||
}
|
||||
|
||||
+99
-18
@@ -11,7 +11,7 @@
|
||||
package require Tcl 8.6-
|
||||
# Keep this in sync with pkgIndex.tcl and with the install directories in
|
||||
# Makefiles
|
||||
package provide http 2.9.2
|
||||
package provide http 2.9.5
|
||||
|
||||
namespace eval http {
|
||||
# Allow resourcing to not clobber existing data
|
||||
@@ -531,7 +531,7 @@ proc http::CloseSocket {s {token {}}} {
|
||||
} else {
|
||||
set map [array get socketMapping]
|
||||
set ndx [lsearch -exact $map $s]
|
||||
if {$ndx != -1} {
|
||||
if {$ndx >= 0} {
|
||||
incr ndx -1
|
||||
set connId [lindex $map $ndx]
|
||||
}
|
||||
@@ -721,7 +721,7 @@ proc http::geturl {url args} {
|
||||
body {}
|
||||
status ""
|
||||
http ""
|
||||
connection close
|
||||
connection keep-alive
|
||||
}
|
||||
set state(-keepalive) $defaultKeepalive
|
||||
set state(-strict) $strict
|
||||
@@ -733,6 +733,7 @@ proc http::geturl {url args} {
|
||||
-strict boolean
|
||||
-timeout integer
|
||||
-validate boolean
|
||||
-headers dict
|
||||
}
|
||||
set state(charset) $defaultCharset
|
||||
set options {
|
||||
@@ -746,9 +747,8 @@ proc http::geturl {url args} {
|
||||
foreach {flag value} $args {
|
||||
if {[regexp -- $pat $flag]} {
|
||||
# Validate numbers
|
||||
if {
|
||||
[info exists type($flag)] &&
|
||||
![string is $type($flag) -strict $value]
|
||||
if {($flag eq "-headers") ? [catch {dict size $value}] :
|
||||
([info exists type($flag)] && ![string is $type($flag) -strict $value])
|
||||
} {
|
||||
unset $token
|
||||
return -code error \
|
||||
@@ -966,6 +966,18 @@ proc http::geturl {url args} {
|
||||
set state(-pipeline) $http(-pipeline)
|
||||
}
|
||||
|
||||
# We cannot handle chunked encodings with -handler, so force HTTP/1.0
|
||||
# until we can manage this.
|
||||
if {[info exists state(-handler)]} {
|
||||
set state(-protocol) 1.0
|
||||
}
|
||||
|
||||
# RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it.
|
||||
if {$state(-protocol) eq "1.0"} {
|
||||
set state(connection) close
|
||||
set state(-keepalive) 0
|
||||
}
|
||||
|
||||
# See if we are supposed to use a previously opened channel.
|
||||
# - In principle, ANY call to http::geturl could use a previously opened
|
||||
# channel if it is available - the "Connection: keep-alive" header is a
|
||||
@@ -1037,7 +1049,7 @@ proc http::geturl {url args} {
|
||||
|
||||
}
|
||||
# Do not automatically close the connection socket.
|
||||
set state(connection) {}
|
||||
set state(connection) keep-alive
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1338,11 +1350,6 @@ proc http::Connected {token proto phost srvurl} {
|
||||
if {[info exists state(-method)] && ($state(-method) ne "")} {
|
||||
set how $state(-method)
|
||||
}
|
||||
# We cannot handle chunked encodings with -handler, so force HTTP/1.0
|
||||
# until we can manage this.
|
||||
if {[info exists state(-handler)]} {
|
||||
set state(-protocol) 1.0
|
||||
}
|
||||
set accept_types_seen 0
|
||||
|
||||
Log ^B$tk begin sending request - token $token
|
||||
@@ -1361,7 +1368,7 @@ proc http::Connected {token proto phost srvurl} {
|
||||
puts $sock "Host: $host:$port"
|
||||
}
|
||||
puts $sock "User-Agent: $http(-useragent)"
|
||||
if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
|
||||
if {($state(-protocol) > 1.0) && $state(-keepalive)} {
|
||||
# Send this header, because a 1.1 server is not compelled to treat
|
||||
# this as the default.
|
||||
puts $sock "Connection: keep-alive"
|
||||
@@ -1369,9 +1376,17 @@ proc http::Connected {token proto phost srvurl} {
|
||||
if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
|
||||
puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
|
||||
}
|
||||
if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
|
||||
puts $sock "Proxy-Connection: Keep-Alive"
|
||||
if {($state(-protocol) < 1.1)} {
|
||||
# RFC7230 A.1
|
||||
# Some server implementations of HTTP/1.0 have a faulty
|
||||
# implementation of RFC 2068 Keep-Alive.
|
||||
# Don't leave this to chance.
|
||||
# For HTTP/1.0 we have already "set state(connection) close"
|
||||
# and "state(-keepalive) 0".
|
||||
puts $sock "Connection: close"
|
||||
}
|
||||
# RFC7230 A.1 - "clients are encouraged not to send the
|
||||
# Proxy-Connection header field in any requests"
|
||||
set accept_encoding_seen 0
|
||||
set content_type_seen 0
|
||||
dict for {key value} $state(-headers) {
|
||||
@@ -1631,9 +1646,51 @@ proc http::ReceiveResponse {token} {
|
||||
Log ^D$tk begin receiving response - token $token
|
||||
|
||||
coroutine ${token}EventCoroutine http::Event $sock $token
|
||||
fileevent $sock readable ${token}EventCoroutine
|
||||
if {[info exists state(-handler)] || [info exists state(-progress)]} {
|
||||
fileevent $sock readable [list http::EventGateway $sock $token]
|
||||
} else {
|
||||
fileevent $sock readable ${token}EventCoroutine
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
# http::EventGateway
|
||||
#
|
||||
# Bug [c2dc1da315].
|
||||
# - Recursive launch of the coroutine can occur if a -handler or -progress
|
||||
# callback is used, and the callback command enters the event loop.
|
||||
# - To prevent this, the fileevent "binding" is disabled while the
|
||||
# coroutine is in flight.
|
||||
# - If a recursive call occurs despite these precautions, it is not
|
||||
# trapped and discarded here, because it is better to report it as a
|
||||
# bug.
|
||||
# - Although this solution is believed to be sufficiently general, it is
|
||||
# used only if -handler or -progress is specified. In other cases,
|
||||
# the coroutine is called directly.
|
||||
|
||||
proc http::EventGateway {sock token} {
|
||||
variable $token
|
||||
upvar 0 $token state
|
||||
fileevent $sock readable {}
|
||||
catch {${token}EventCoroutine} res opts
|
||||
if {[info commands ${token}EventCoroutine] ne {}} {
|
||||
# The coroutine can be deleted by completion (a non-yield return), by
|
||||
# http::Finish (when there is a premature end to the transaction), by
|
||||
# http::reset or http::cleanup, or if the caller set option -channel
|
||||
# but not option -handler: in the last case reading from the socket is
|
||||
# now managed by commands ::http::Copy*, http::ReceiveChunked, and
|
||||
# http::make-transformation-chunked.
|
||||
#
|
||||
# Catch in case the coroutine has closed the socket.
|
||||
catch {fileevent $sock readable [list http::EventGateway $sock $token]}
|
||||
}
|
||||
|
||||
# If there was an error, re-throw it.
|
||||
return -options $opts $res
|
||||
}
|
||||
|
||||
|
||||
# http::NextPipelinedWrite
|
||||
#
|
||||
# - Connecting a socket to a token for writing is done by this command and by
|
||||
@@ -2688,8 +2745,32 @@ proc http::Event {sock token} {
|
||||
}
|
||||
proxy-connection -
|
||||
connection {
|
||||
set state(connection) \
|
||||
[string trim [string tolower $value]]
|
||||
set tmpHeader [string trim [string tolower $value]]
|
||||
# RFC 7230 Section 6.1 states that a comma-separated
|
||||
# list is an acceptable value. According to
|
||||
# https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
|
||||
# any comma-separated list implies keep-alive, but I
|
||||
# don't see this in the RFC so we'll play safe and
|
||||
# scan any list for "close".
|
||||
if {$tmpHeader in {close keep-alive}} {
|
||||
# The common cases, continue.
|
||||
} elseif {[string first , $tmpHeader] < 0} {
|
||||
# Not a comma-separated list, not "close",
|
||||
# therefore "keep-alive".
|
||||
set tmpHeader keep-alive
|
||||
} else {
|
||||
set tmpResult keep-alive
|
||||
set tmpCsl [split $tmpHeader ,]
|
||||
# Optional whitespace either side of separator.
|
||||
foreach el $tmpCsl {
|
||||
if {[string trim $el] eq {close}} {
|
||||
set tmpResult close
|
||||
break
|
||||
}
|
||||
}
|
||||
set tmpHeader $tmpResult
|
||||
}
|
||||
set state(connection) $tmpHeader
|
||||
}
|
||||
}
|
||||
lappend state(meta) $key [string trim $value]
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
|
||||
package ifneeded http 2.9.2 [list tclPkgSetup $dir http 2.9.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
package ifneeded http 2.9.5 [list tclPkgSetup $dir http 2.9.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
|
||||
+5
-4
@@ -84,7 +84,7 @@ namespace eval tcl {
|
||||
proc min {args} {
|
||||
if {![llength $args]} {
|
||||
return -code error \
|
||||
"too few arguments to math function \"min\""
|
||||
"not enough arguments to math function \"min\""
|
||||
}
|
||||
set val Inf
|
||||
foreach arg $args {
|
||||
@@ -100,7 +100,7 @@ namespace eval tcl {
|
||||
proc max {args} {
|
||||
if {![llength $args]} {
|
||||
return -code error \
|
||||
"too few arguments to math function \"max\""
|
||||
"not enough arguments to math function \"max\""
|
||||
}
|
||||
set val -Inf
|
||||
foreach arg $args {
|
||||
@@ -313,7 +313,7 @@ proc unknown args {
|
||||
set errInfo [string range $errInfo 0 $last-1]
|
||||
set tail "\"$cinfo\""
|
||||
set last [string last $tail $errInfo]
|
||||
if {$last + [string length $tail] != [string length $errInfo]} {
|
||||
if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} {
|
||||
return -code error -errorcode $errCode \
|
||||
-errorinfo $errInfo $msg
|
||||
}
|
||||
@@ -494,6 +494,7 @@ proc auto_load_index {} {
|
||||
continue
|
||||
} else {
|
||||
set error [catch {
|
||||
fconfigure $f -eofchar \032
|
||||
set id [gets $f]
|
||||
if {$id eq "# Tcl autoload index file, version 2.0"} {
|
||||
eval [read $f]
|
||||
@@ -797,7 +798,7 @@ proc tcl::CopyDirectory {action src dest} {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if {[string first $nsrc $ndest] != -1} {
|
||||
if {[string first $nsrc $ndest] >= 0} {
|
||||
set srclen [expr {[llength [file split $nsrc]] - 1}]
|
||||
set ndest [lindex [file split $ndest] $srclen]
|
||||
if {$ndest eq [file tail $nsrc]} {
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
package require Tcl 8.5-
|
||||
# When this version number changes, update the pkgIndex.tcl file
|
||||
# and the install directory in the Makefiles.
|
||||
package provide opt 0.4.7
|
||||
package provide opt 0.4.8
|
||||
|
||||
namespace eval ::tcl {
|
||||
|
||||
@@ -44,8 +44,8 @@ namespace eval ::tcl {
|
||||
{-intflag 7}
|
||||
{-weirdflag "help string"}
|
||||
{-noStatics "Not ok to load static packages"}
|
||||
{-nestedloading1 true "OK to load into nested slaves"}
|
||||
{-nestedloading2 -boolean true "OK to load into nested slaves"}
|
||||
{-nestedloading1 true "OK to load into nested children"}
|
||||
{-nestedloading2 -boolean true "OK to load into nested children"}
|
||||
{-libsOK -choice {Tk SybTcl}
|
||||
"List of packages that can be loaded"}
|
||||
{-precision -int 12 "Number of digits of precision"}
|
||||
|
||||
@@ -9,4 +9,4 @@
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
|
||||
package ifneeded opt 0.4.7 [list source [file join $dir optparse.tcl]]
|
||||
package ifneeded opt 0.4.8 [list source [file join $dir optparse.tcl]]
|
||||
|
||||
+8
-4
@@ -237,7 +237,7 @@ proc pkg_mkIndex {args} {
|
||||
$c eval [list set ::tcl::file $file]
|
||||
$c eval [list set ::tcl::direct $direct]
|
||||
|
||||
# Download needed procedures into the slave because we've just deleted
|
||||
# Download needed procedures into the child because we've just deleted
|
||||
# the unknown procedure. This doesn't handle procedures with default
|
||||
# arguments.
|
||||
|
||||
@@ -479,9 +479,12 @@ proc tclPkgUnknown {name args} {
|
||||
}
|
||||
set tclSeenPath($dir) 1
|
||||
|
||||
# we can't use glob in safe interps, so enclose the following in a
|
||||
# catch statement, where we get the pkgIndex files out of the
|
||||
# subdirectories
|
||||
# Get the pkgIndex.tcl files in subdirectories of auto_path directories.
|
||||
# - Safe Base interpreters have a restricted "glob" command that
|
||||
# works in this case.
|
||||
# - The "catch" was essential when there was no safe glob and every
|
||||
# call in a safe interp failed; it is retained only for corner
|
||||
# cases in which the eventual call to glob returns an error.
|
||||
catch {
|
||||
foreach file [glob -directory $dir -join -nocomplain \
|
||||
* pkgIndex.tcl] {
|
||||
@@ -585,6 +588,7 @@ proc tcl::MacOSXPkgUnknown {original name args} {
|
||||
set tclSeenPath($dir) 1
|
||||
|
||||
# get the pkgIndex files out of the subdirectories
|
||||
# Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl.
|
||||
foreach file [glob -directory $dir -join -nocomplain \
|
||||
* Resources Scripts pkgIndex.tcl] {
|
||||
set dir [file dirname $file]
|
||||
|
||||
@@ -2,8 +2,8 @@ if {![package vsatisfies [package provide Tcl] 8.5]} return
|
||||
if {[info sharedlibextension] != ".dll"} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded registry 1.3.5 \
|
||||
[list load [file join $dir tclreg13g.dll] registry]
|
||||
[list load [file join $dir tclreg13g.dll] Registry]
|
||||
} else {
|
||||
package ifneeded registry 1.3.5 \
|
||||
[list load [file join $dir tclreg13.dll] registry]
|
||||
[list load [file join $dir tclreg13.dll] Registry]
|
||||
}
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user