Compare commits
246
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
8c30acc36f | ||
|
|
6cc9524fbb | ||
|
|
edf67bd765 | ||
|
|
97e8fa6621 | ||
|
|
b1f4ab80a0 | ||
|
|
04619d69b8 | ||
|
|
9804d03e1f | ||
|
|
9b4bad2783 | ||
|
|
f58326fab5 | ||
|
|
c47c440be2 | ||
|
|
1523ce53c1 | ||
|
|
68dc740f26 | ||
|
|
6e3371ad0a | ||
|
|
e5bb3b3829 | ||
|
|
6bdb76c461 | ||
|
|
3d82d5537c | ||
|
|
259220cf73 | ||
|
|
4df980c07b | ||
|
|
f0048561b7 | ||
|
|
7573820525 | ||
|
|
5175765beb | ||
|
|
35315e5c2e | ||
|
|
25a30f2db0 | ||
|
|
a6691785d8 | ||
|
|
458f106fdb | ||
|
|
501954d5aa | ||
|
|
814c9b57aa | ||
|
|
d7d411426d | ||
|
|
76238b9ab7 | ||
|
|
617e57260f | ||
|
|
ad4b60ef7c | ||
|
|
7403235131 | ||
|
|
30db6ce78e | ||
|
|
6f34bcda8f | ||
|
|
cb849ffbeb | ||
|
|
a8e1d5aae3 | ||
|
|
b632599a22 | ||
|
|
3f913d322f | ||
|
|
cdae95cf66 | ||
|
|
f36b113b00 | ||
|
|
954fcc121d | ||
|
|
c60ee515ee | ||
|
|
0008ef8d9b | ||
|
|
7357ee63c3 | ||
|
|
e0456ccfdf | ||
|
|
70c2b0e817 | ||
|
|
55076a6af2 | ||
|
|
ee4adbec91 | ||
|
|
eff036def9 | ||
|
|
d825807d46 | ||
|
|
a444785129 | ||
|
|
9deb1f2b0a | ||
|
|
a8606e7ce9 | ||
|
|
7dd17bbcbf | ||
|
|
8c5e1ee93f | ||
|
|
e809cadb0a | ||
|
|
ce199db516 | ||
|
|
cd814a13ac | ||
|
|
a6a453f3b8 | ||
|
|
8cfc027811 | ||
|
|
06938f94df | ||
|
|
597edf50b5 | ||
|
|
79b57974dc | ||
|
|
acfe572897 | ||
|
|
9b3ea0f675 | ||
|
|
9251a05e68 | ||
|
|
7413757522 | ||
|
|
3fcf24bf05 | ||
|
|
693567f0d8 | ||
|
|
98f26e503e | ||
|
|
1dfd77778e | ||
|
|
4b9ec1f4aa | ||
|
|
bd52e4af47 | ||
|
|
729c97255b | ||
|
|
60abdd9b58 | ||
|
|
5b8c40a4b1 | ||
|
|
21904bcbde | ||
|
|
4427df1ae8 | ||
|
|
19c1bb0cf6 | ||
|
|
b67894a411 | ||
|
|
d1e77398a8 | ||
|
|
f271e62139 | ||
|
|
4476f831f5 | ||
|
|
3618ecdad8 | ||
|
|
ac2c528c36 | ||
|
|
751750005b | ||
|
|
5b7381172b | ||
|
|
0d6faa1ccd | ||
|
|
4d31e6c26e | ||
|
|
3b3080a9f6 | ||
|
|
1b914f66bf | ||
|
|
9b86fa3762 | ||
|
|
31de1a727a | ||
|
|
f0316438a9 | ||
|
|
02c12ad919 | ||
|
|
a1f7ab6047 | ||
|
|
6c09446693 | ||
|
|
9882c08b41 | ||
|
|
1fb36494e2 | ||
|
|
cb796d6e08 | ||
|
|
557c437637 | ||
|
|
c0ef486e3d | ||
|
|
7a14d36614 | ||
|
|
7e1bd9ece3 | ||
|
|
4d0c2de9fe | ||
|
|
d2275e354d | ||
|
|
28821a3fc8 | ||
|
|
40e5a934ab | ||
|
|
a5ee3631c3 | ||
|
|
0c51650ae9 | ||
|
|
6d2f85de20 | ||
|
|
dbcca14632 | ||
|
|
9d13d5e64b | ||
|
|
1233589701 | ||
|
|
cd326bf172 | ||
|
|
b6d01a333a | ||
|
|
6ef2d21d52 | ||
|
|
e7ff6cacbc | ||
|
|
08902d8a97 | ||
|
|
a4006968d9 | ||
|
|
d6aac61b03 | ||
|
|
703055871b | ||
|
|
500d59bd30 | ||
|
|
fd0aa4c0fc | ||
|
|
3a1e408464 | ||
|
|
d80a12f061 | ||
|
|
1368d760bc | ||
|
|
9b49520dc2 | ||
|
|
0f48a8bc92 | ||
|
|
93e207f19d | ||
|
|
a201f0f383 | ||
|
|
1c9f5c8741 | ||
|
|
39ef112133 | ||
|
|
f14d3b58cf | ||
|
|
0187ddfaf3 | ||
|
|
9649c9074c | ||
|
|
05b875c564 | ||
|
|
d3e0d5789c | ||
|
|
11b101cd27 | ||
|
|
5bdefd0c25 | ||
|
|
a8516aa629 | ||
|
|
d9bbe48c46 | ||
|
|
12502ae524 | ||
|
|
932e04d6db | ||
|
|
962b2df00b | ||
|
|
d4d8fe187b | ||
|
|
e4e1451d4a | ||
|
|
3634214bbb | ||
|
|
7ee82af4aa | ||
|
|
e7d3979e0a | ||
|
|
1134511a98 | ||
|
|
71008a6aa8 | ||
|
|
0f818acbb7 | ||
|
|
4bd04113a8 | ||
|
|
6a484fdaef | ||
|
|
4c055148da | ||
|
|
2174632a4b | ||
|
|
60a9b8775d | ||
|
|
0d6bc7fc83 | ||
|
|
7d899dfff0 | ||
|
|
2fea9a2bbd | ||
|
|
7987c596f2 | ||
|
|
9fecbcc106 | ||
|
|
ad6b4e6f8f | ||
|
|
737753205d | ||
|
|
7caa74e545 | ||
|
|
f87cb71e7a | ||
|
|
65df3cd9fe | ||
|
|
7cf2f6d102 | ||
|
|
ed61282e22 | ||
|
|
75afeeeffa | ||
|
|
6607e4e824 | ||
|
|
eb45f86b3f | ||
|
|
b72fcddfe2 | ||
|
|
d261590825 | ||
|
|
713ea0845e | ||
|
|
e2a1c2f11c | ||
|
|
6f6229ef6e | ||
|
|
7476029a04 | ||
|
|
471313fea0 | ||
|
|
a3201caebd | ||
|
|
9cf2b1031b | ||
|
|
c5e9409992 | ||
|
|
2e4a20524c | ||
|
|
d4ed243e68 | ||
|
|
4c5c001bc8 | ||
|
|
71dcf14194 | ||
|
|
ce299372a0 | ||
|
|
ef9154f143 | ||
|
|
c7fcbf756c | ||
|
|
81d499ea31 | ||
|
|
4de3a63efd | ||
|
|
b6d1ba3fdb | ||
|
|
28437b46c3 | ||
|
|
4fa09fa5d6 | ||
|
|
f2e08d25db | ||
|
|
42a77f7b4b | ||
|
|
9bf722e8da | ||
|
|
5003483b1d | ||
|
|
c1cc3a7238 | ||
|
|
5a5cb4c044 | ||
|
|
4aa680d80d | ||
|
|
b63d1213ed | ||
|
|
2453c29945 | ||
|
|
8a32e272a4 | ||
|
|
c1a1d841e7 | ||
|
|
ae32db3ffa | ||
|
|
bd778f8dd4 | ||
|
|
103d88f85a | ||
|
|
aa6c33b39d | ||
|
|
52b58d0c7d | ||
|
|
93b4c9bd6b | ||
|
|
cfdc6e47f4 | ||
|
|
bc8789e840 | ||
|
|
14ead72e1a | ||
|
|
a6e0a802ec | ||
|
|
830d7561f9 | ||
|
|
6f8c6e12dd | ||
|
|
6f23bf98b4 | ||
|
|
3bfe6dba24 | ||
|
|
82d0339a65 | ||
|
|
3c9c7e0621 | ||
|
|
e83fde690f | ||
|
|
4ef5cbaad7 | ||
|
|
85469e495c | ||
|
|
05fa595fc5 | ||
|
|
72fd932a99 | ||
|
|
42b705be81 | ||
|
|
aa4f7bcd47 | ||
|
|
1f4a8eb5d1 | ||
|
|
2e7b2436f1 | ||
|
|
c7711541ec | ||
|
|
c6799de46b | ||
|
|
4b405eefc8 | ||
|
|
6b90b986b2 | ||
|
|
3175cb43a5 | ||
|
|
48a57e0116 | ||
|
|
269722c410 | ||
|
|
0b884f11fa | ||
|
|
958892fdd0 | ||
|
|
1806e5755f | ||
|
|
ce82e0c22d | ||
|
|
74f570670c | ||
|
|
9d25ea9cd7 | ||
|
|
b51e777fe9 | ||
|
|
a5a30fa3e2 |
@@ -1,3 +1,3 @@
|
||||
Important Note
|
||||
==========
|
||||
Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
|
||||
Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl-lang.org](https://core.tcl-lang.org/tcl/tktnew); please post them there.
|
||||
|
||||
@@ -1,3 +1,3 @@
|
||||
Important Note
|
||||
==========
|
||||
Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
|
||||
Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl-lang.org](https://core.tcl-lang.org/tcl/tktnew); please post them there.
|
||||
|
||||
@@ -2,7 +2,7 @@ name: macOS
|
||||
on: [push]
|
||||
jobs:
|
||||
xcode:
|
||||
runs-on: macos-11.0
|
||||
runs-on: macos-11
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
@@ -24,7 +24,7 @@ jobs:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
clang:
|
||||
runs-on: macos-11.0
|
||||
runs-on: macos-11
|
||||
strategy:
|
||||
matrix:
|
||||
cfgopt:
|
||||
|
||||
@@ -3,7 +3,7 @@ on: [push]
|
||||
jobs:
|
||||
linux:
|
||||
name: Linux
|
||||
runs-on: ubuntu-16.04
|
||||
runs-on: ubuntu-18.04
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
@@ -27,18 +27,18 @@ jobs:
|
||||
working-directory: unix
|
||||
- name: Package
|
||||
run: |
|
||||
cp ../unix/tclsh tclsh${TCL_PATCHLEVEL}_unofficial
|
||||
chmod +x tclsh${TCL_PATCHLEVEL}_unofficial
|
||||
tar -cf tclsh${TCL_PATCHLEVEL}_unofficial.tar tclsh${TCL_PATCHLEVEL}_unofficial
|
||||
cp ../unix/tclsh tclsh${TCL_PATCHLEVEL}_snapshot
|
||||
chmod +x tclsh${TCL_PATCHLEVEL}_snapshot
|
||||
tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot
|
||||
working-directory: 1dist
|
||||
- name: Upload
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (unofficial)
|
||||
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot)
|
||||
path: 1dist/*.tar
|
||||
macos:
|
||||
name: macOS
|
||||
runs-on: macos-11.0
|
||||
runs-on: macos-11
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
@@ -74,8 +74,8 @@ jobs:
|
||||
- name: Package
|
||||
run: |
|
||||
mkdir contents
|
||||
cp $TCL_BIN contents/tclsh${TCL_PATCHLEVEL}_unofficial
|
||||
chmod +x contents/tclsh${TCL_PATCHLEVEL}_unofficial
|
||||
cp $TCL_BIN contents/tclsh${TCL_PATCHLEVEL}_snapshot
|
||||
chmod +x contents/tclsh${TCL_PATCHLEVEL}_snapshot
|
||||
cat > contents/README.txt <<EOF
|
||||
This is a single-file executable developer preview of Tcl $TCL_PATCHLEVEL
|
||||
|
||||
@@ -83,32 +83,38 @@ jobs:
|
||||
Use strictly at your own risk.
|
||||
|
||||
To run it, you need to copy the executable out and run:
|
||||
xattr -d com.apple.quarantine tclsh${TCL_PATCHLEVEL}_unofficial
|
||||
xattr -d com.apple.quarantine tclsh${TCL_PATCHLEVEL}_snapshot
|
||||
to mark the executable as runnable on your machine.
|
||||
EOF
|
||||
$CREATE_DMG \
|
||||
--volname "Tcl $TCL_PATCHLEVEL (unofficial)" \
|
||||
--volname "Tcl $TCL_PATCHLEVEL (snapshot)" \
|
||||
--window-pos 200 120 \
|
||||
--window-size 800 400 \
|
||||
"Tcl-$TCL_PATCHLEVEL-(unofficial).dmg" \
|
||||
"Tcl-$TCL_PATCHLEVEL-(snapshot).dmg" \
|
||||
"contents/"
|
||||
working-directory: 1dist
|
||||
- name: Upload
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (unofficial)
|
||||
name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot)
|
||||
path: 1dist/*.dmg
|
||||
win:
|
||||
name: Windows
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
shell: msys2 {0}
|
||||
env:
|
||||
CC: gcc
|
||||
CFGOPT: --disable-symbols --disable-shared
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Install MSYS2
|
||||
uses: msys2/setup-msys2@v2
|
||||
with:
|
||||
msystem: UCRT64
|
||||
install: git mingw-w64-ucrt-x86_64-toolchain make zip
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch generic/tclStubInit.c generic/tclOOStubInit.c
|
||||
@@ -116,7 +122,7 @@ jobs:
|
||||
mkdir 1dist
|
||||
working-directory: .
|
||||
- name: Configure
|
||||
run: ./configure --disable-symbols --disable-shared --enable-zipfs
|
||||
run: ./configure $CFGOPT
|
||||
working-directory: win
|
||||
- name: Build
|
||||
run: |
|
||||
@@ -129,10 +135,10 @@ jobs:
|
||||
working-directory: win
|
||||
- name: Set Executable Name
|
||||
run: |
|
||||
cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_unofficial.exe
|
||||
cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe
|
||||
working-directory: 1dist
|
||||
- name: Upload
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (unofficial)
|
||||
path: '1dist/*_unofficial.exe'
|
||||
name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot)
|
||||
path: '1dist/*_snapshot.exe'
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
name: Windows
|
||||
on: [push]
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
jobs:
|
||||
msvc:
|
||||
runs-on: windows-latest
|
||||
@@ -40,14 +42,12 @@ jobs:
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
CI_BUILD_WITH_MSVC: 1
|
||||
gcc:
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
shell: msys2 {0}
|
||||
working-directory: win
|
||||
strategy:
|
||||
matrix:
|
||||
@@ -60,10 +60,13 @@ jobs:
|
||||
- "--enable-symbols=mem"
|
||||
# Using powershell means we need to explicitly stop on failure
|
||||
steps:
|
||||
- name: Install MSYS2
|
||||
uses: msys2/setup-msys2@v2
|
||||
with:
|
||||
msystem: MINGW64
|
||||
install: git mingw-w64-x86_64-toolchain make
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Install MSYS2 and Make
|
||||
run: choco install msys2 make
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
|
||||
@@ -80,8 +83,6 @@ jobs:
|
||||
run: make tcltest
|
||||
- name: Run Tests
|
||||
run: make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
|
||||
# If you add builds with Wine, be sure to define the environment variable
|
||||
# CI_USING_WINE when running them so that broken tests know not to run.
|
||||
|
||||
@@ -8096,7 +8096,7 @@ a better first place to look now.
|
||||
2009-03-25 Jan Nijtmans <nijtmans@users.sf.net>
|
||||
|
||||
* doc/tclsh.1: Bring doc and tools in line with
|
||||
* tools/installData.tcl: http://wiki.tcl.tk/812
|
||||
* tools/installData.tcl: https://wiki.tcl-lang.org/page/exec+magic
|
||||
* tools/str2c
|
||||
* tools/tcltk-man2html.tcl
|
||||
|
||||
|
||||
+1
-1
@@ -345,7 +345,7 @@
|
||||
* library/clock.tcl: Corrected the regular expressions that match a
|
||||
time zone to allow for time zones specified as +HH or -HH.
|
||||
* tests/clock.test: Added regression test case for the above issue.
|
||||
Thanks to Rolf Ade for reporting this issue [http://wiki.tcl.tk/13094]
|
||||
Thanks to Rolf Ade for reporting this issue [https://wiki.tcl-lang.org/page/Parsing+ISO8601+dates+and+times]
|
||||
* win/tclWinDde.c (Tcl_DdeObjCmd): Corrected a typo that caused a
|
||||
compilation failure on VC++.
|
||||
|
||||
|
||||
+1
-1
@@ -5262,7 +5262,7 @@
|
||||
* generic/tclStrToD.c: Added code to support the "middle endian"
|
||||
floating point format used in the Nokia N770's software-based floating
|
||||
point. Thanks to Bruce Johnson for reporting this bug, originally on
|
||||
http://wiki.tcl.tk/15408.
|
||||
https://wiki.tcl-lang.org/page/Nokia+770.
|
||||
* library/clock.tcl: Fixed a bug with Daylight Saving Time and Posix
|
||||
time zone specifiers reported by Martin Lemburg in
|
||||
http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# README: Tcl
|
||||
|
||||
This is the **Tcl 8.7a4** source distribution.
|
||||
This is the **Tcl 8.7a6** source distribution.
|
||||
|
||||
You can get any source release of Tcl from [our distribution
|
||||
site](https://sourceforge.net/projects/tcl/files/Tcl/).
|
||||
@@ -45,7 +45,7 @@ and selling it either in whole or in part. See the file
|
||||
## <a id="doc">2.</a> Documentation
|
||||
Extensive documentation is available on our website.
|
||||
The home page for this release, including new features, is
|
||||
[here](https://www.tcl.tk/software/tcltk/8.7.html).
|
||||
[here](https://www.tcl-lang.org/software/tcltk/8.7.html).
|
||||
Detailed release notes can be found at the
|
||||
[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/)
|
||||
by clicking on the relevant version.
|
||||
@@ -96,7 +96,7 @@ Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
|
||||
static code checker, single-file wrapping utility, bytecode compiler, and
|
||||
more. More information can be found at
|
||||
|
||||
http://www.ActiveState.com/Tcl
|
||||
https://www.activestate.com/products/tcl/
|
||||
|
||||
## <a id="complangtcl">5.</a> Tcl newsgroup
|
||||
There is a USENET newsgroup, "`comp.lang.tcl`", intended for the exchange of
|
||||
|
||||
@@ -8843,7 +8843,7 @@ in this changeset (new minor version) rather than bug fixes:
|
||||
|
||||
2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
|
||||
|
||||
--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details
|
||||
--- Released 8.7a1, September 8, 2017 --- https://core.tcl-lang.org/tcl/ for details
|
||||
|
||||
2017-08-10 [array names -regexp] supports backrefs (goth)
|
||||
|
||||
@@ -8942,7 +8942,7 @@ in this changeset (new minor version) rather than bug fixes:
|
||||
|
||||
2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)
|
||||
|
||||
- Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -
|
||||
- Released 8.6.9, November 16, 2018 - details at https://core.tcl-lang.org/tcl/ -
|
||||
|
||||
2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres)
|
||||
|
||||
@@ -8990,7 +8990,7 @@ in this changeset (new minor version) rather than bug fixes:
|
||||
|
||||
2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres)
|
||||
|
||||
- Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ -
|
||||
- Released 8.6.10, Nov 21, 2019 - details at https://core.tcl-lang.org/tcl/ -
|
||||
|
||||
2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans)
|
||||
|
||||
@@ -9119,7 +9119,7 @@ See RFC 2045
|
||||
|
||||
2020-12-23 tzdata updated to Olson's tzdata2020e (jima)
|
||||
|
||||
- Released 8.6.11, Dec 31, 2020 - details at http://core.tcl-lang.org/tcl/ -
|
||||
- Released 8.6.11, Dec 31, 2020 - details at https://core.tcl-lang.org/tcl/ -
|
||||
|
||||
Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10,
|
||||
plus the following, which focuses on the high-level feature changes
|
||||
@@ -9228,6 +9228,9 @@ in this changeset (new minor version) rather than bug fixes:
|
||||
|
||||
2019-04-16 [TIP 342] [dict getwithdefault]
|
||||
|
||||
2019-04-23 (bug)[67a5ea] make [chan postevent] asynchronous
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2019-05-25 [TIP 431] [file tempdir]
|
||||
|
||||
2019-05-25 [TIP 383] [coroinject], [coroprobe]
|
||||
@@ -9254,4 +9257,76 @@ Changes to 8.7a5 include all changes to the 8.6 line through 8.6.11,
|
||||
plus the following, which focuses on the high-level feature changes
|
||||
in this changeset (new minor version) rather than bug fixes:
|
||||
|
||||
- Released 8.7a5, Jan 21, 2021 --- http://core.tcl-lang.org/tcl/ for details -
|
||||
2019-12-13 [TIP 538] Externalize libtommath
|
||||
|
||||
2020-01-20 [TIP 542] Support for switchable Full Unicode support
|
||||
|
||||
2020-01-21 [TIP 543] Eliminate `TCL_INTERP_DESTROYED` flag value
|
||||
|
||||
2020-01-24 [TIP 559] Eliminate public routine `Tcl_FreeResult
|
||||
|
||||
2020-01-31 (new) Implement 64-bit seek on Zip channels. (nijtmans)
|
||||
|
||||
2020-02-28 [TIP 557] C++ support for Tcl
|
||||
|
||||
2020-02-28 [TIP 562] Deprecate channel types 1-4
|
||||
|
||||
2020-03-11 (bug)[234d6c] Segfault in [set l {}; lpop l] (sebres)
|
||||
|
||||
2020-03-12 (bug) Crash in tests binary-79.[12] (porter)
|
||||
|
||||
2020-03-13 [TIP 569] Eliminate Comments That Serve Lint
|
||||
|
||||
2020-04-06 (bug)[dd010c] [string trim*] on astral characters (porter,nijtmans)
|
||||
|
||||
2020-05-30 [TIP 551] Permit underscore in numerical literals in source code
|
||||
|
||||
2020-07-03 [TIP 578] Death to TCL_DBGX
|
||||
|
||||
2020-08-11 (bug)[e87000] Win32 crash in [fconfigure stdout] (werner,nijtmans)
|
||||
|
||||
2020-09-06 (bug)[c1a376] deletion trace on imported ensemble (coulter)
|
||||
|
||||
2020-09-13 [TIP 585] Promote the INDEX_TEMP_TABLE flag of Tcl_GetIndexFromObj*() to the public interface
|
||||
|
||||
2020-09-15 (bug)[b5777d] crash in [string index abcd 0-0x10000000000000000]
|
||||
|
||||
2020-09-19 [b9ecf3] revised stork mgmt [uplevel [list $cmd ...]] (coulter)
|
||||
|
||||
2020-10-23 [TIP 587] Default utf-8 for source command
|
||||
|
||||
2020-10-27 (bug)[11229b] test string-31.26.* (porter)
|
||||
|
||||
2020-11-08 [TIP 582] Comments in Expressions
|
||||
|
||||
2020-11-16 [TIP 586] C String Parsing Support for binary scan
|
||||
|
||||
2020-12-07 [TIP 590] Recommend lowercase Package Names
|
||||
|
||||
2021-01-06 Bump to tcltest 2.5.4
|
||||
|
||||
2021-01-15 [TIP 481] `Tcl_GetStringFromObj()` with `size_t` length parameter
|
||||
|
||||
2021-01-15 [TIP 592] End support: Windows XP, Server 2003, Vista, Server 2008
|
||||
|
||||
2021-01-25 tzdata updated to Olson's tzdata2021a (nijtmans)
|
||||
|
||||
2021-01-29 (bug)[113be1] zipfs on mac
|
||||
|
||||
2021-03-15 [TIP 575] Switchable Tcl_UtfCharComplete()/Tcl_UtfNext()/Tcl_UtfPrev()
|
||||
|
||||
2021-03-19 (new)[0221b9] Drop TCL_WINDOW_EVENTS from Tcl's [update idletasks]
|
||||
|
||||
2021-03-30 (new)[4b4830] [chan truncate] for reflected channels
|
||||
|
||||
2021-04-30 [TIP 597] "string is unicode" and better utf-8/utf-16/cesu-8 encodings
|
||||
|
||||
2021-04-09 [TIP 598] export TclWinConvertError
|
||||
|
||||
2021-05-15 (bug)[463b7a] segfault from Tcl_Unload (coulter)
|
||||
|
||||
2021-05-15 (bug)[fb2a41] tclZipfs.c free all memory (coulter)
|
||||
|
||||
2021-05-18 (bug)[688fcc,28027d] namespace teardown reform (coulter)
|
||||
|
||||
- Released 8.7a5, Jun 18, 2021 --- http://core.tcl-lang.org/tcl/ for details -
|
||||
|
||||
@@ -1,186 +1,186 @@
|
||||
/* inffas8664.c is a hand tuned assembler version of inffast.c - fast decoding
|
||||
* version for AMD64 on Windows using Microsoft C compiler
|
||||
*
|
||||
* Copyright (C) 1995-2003 Mark Adler
|
||||
* For conditions of distribution and use, see copyright notice in zlib.h
|
||||
*
|
||||
* Copyright (C) 2003 Chris Anderson <christop@charm.net>
|
||||
* Please use the copyright conditions above.
|
||||
*
|
||||
* 2005 - Adaptation to Microsoft C Compiler for AMD64 by Gilles Vollant
|
||||
*
|
||||
* inffas8664.c call function inffas8664fnc in inffasx64.asm
|
||||
* inffasx64.asm is automatically convert from AMD64 portion of inffas86.c
|
||||
*
|
||||
* Dec-29-2003 -- I added AMD64 inflate asm support. This version is also
|
||||
* slightly quicker on x86 systems because, instead of using rep movsb to copy
|
||||
* data, it uses rep movsw, which moves data in 2-byte chunks instead of single
|
||||
* bytes. I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates
|
||||
* from http://fedora.linux.duke.edu/fc1_x86_64
|
||||
* which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with
|
||||
* 1GB ram. The 64-bit version is about 4% faster than the 32-bit version,
|
||||
* when decompressing mozilla-source-1.3.tar.gz.
|
||||
*
|
||||
* Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
|
||||
* the gcc -S output of zlib-1.2.0/inffast.c. Zlib-1.2.0 is in beta release at
|
||||
* the moment. I have successfully compiled and tested this code with gcc2.96,
|
||||
* gcc3.2, icc5.0, msvc6.0. It is very close to the speed of inffast.S
|
||||
* compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
|
||||
* enabled. I will attempt to merge the MMX code into this version. Newer
|
||||
* versions of this and inffast.S can be found at
|
||||
* http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
|
||||
*
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include "zutil.h"
|
||||
#include "inftrees.h"
|
||||
#include "inflate.h"
|
||||
#include "inffast.h"
|
||||
|
||||
/* Mark Adler's comments from inffast.c: */
|
||||
|
||||
/*
|
||||
Decode literal, length, and distance codes and write out the resulting
|
||||
literal and match bytes until either not enough input or output is
|
||||
available, an end-of-block is encountered, or a data error is encountered.
|
||||
When large enough input and output buffers are supplied to inflate(), for
|
||||
example, a 16K input buffer and a 64K output buffer, more than 95% of the
|
||||
inflate execution time is spent in this routine.
|
||||
|
||||
Entry assumptions:
|
||||
|
||||
state->mode == LEN
|
||||
strm->avail_in >= 6
|
||||
strm->avail_out >= 258
|
||||
start >= strm->avail_out
|
||||
state->bits < 8
|
||||
|
||||
On return, state->mode is one of:
|
||||
|
||||
LEN -- ran out of enough output space or enough available input
|
||||
TYPE -- reached end of block code, inflate() to interpret next block
|
||||
BAD -- error in block data
|
||||
|
||||
Notes:
|
||||
|
||||
- The maximum input bits used by a length/distance pair is 15 bits for the
|
||||
length code, 5 bits for the length extra, 15 bits for the distance code,
|
||||
and 13 bits for the distance extra. This totals 48 bits, or six bytes.
|
||||
Therefore if strm->avail_in >= 6, then there is enough input to avoid
|
||||
checking for available input while decoding.
|
||||
|
||||
- The maximum bytes that a single length/distance pair can output is 258
|
||||
bytes, which is the maximum length that can be coded. inflate_fast()
|
||||
requires strm->avail_out >= 258 for each loop to avoid checking for
|
||||
output space.
|
||||
*/
|
||||
|
||||
|
||||
|
||||
typedef struct inffast_ar {
|
||||
/* 64 32 x86 x86_64 */
|
||||
/* ar offset register */
|
||||
/* 0 0 */ void *esp; /* esp save */
|
||||
/* 8 4 */ void *ebp; /* ebp save */
|
||||
/* 16 8 */ unsigned char FAR *in; /* esi rsi local strm->next_in */
|
||||
/* 24 12 */ unsigned char FAR *last; /* r9 while in < last */
|
||||
/* 32 16 */ unsigned char FAR *out; /* edi rdi local strm->next_out */
|
||||
/* 40 20 */ unsigned char FAR *beg; /* inflate()'s init next_out */
|
||||
/* 48 24 */ unsigned char FAR *end; /* r10 while out < end */
|
||||
/* 56 28 */ unsigned char FAR *window;/* size of window, wsize!=0 */
|
||||
/* 64 32 */ code const FAR *lcode; /* ebp rbp local strm->lencode */
|
||||
/* 72 36 */ code const FAR *dcode; /* r11 local strm->distcode */
|
||||
/* 80 40 */ size_t /*unsigned long */hold; /* edx rdx local strm->hold */
|
||||
/* 88 44 */ unsigned bits; /* ebx rbx local strm->bits */
|
||||
/* 92 48 */ unsigned wsize; /* window size */
|
||||
/* 96 52 */ unsigned write; /* window write index */
|
||||
/*100 56 */ unsigned lmask; /* r12 mask for lcode */
|
||||
/*104 60 */ unsigned dmask; /* r13 mask for dcode */
|
||||
/*108 64 */ unsigned len; /* r14 match length */
|
||||
/*112 68 */ unsigned dist; /* r15 match distance */
|
||||
/*116 72 */ unsigned status; /* set when state chng*/
|
||||
} type_ar;
|
||||
#ifdef ASMINF
|
||||
|
||||
void inflate_fast(strm, start)
|
||||
z_streamp strm;
|
||||
unsigned start; /* inflate()'s starting value for strm->avail_out */
|
||||
{
|
||||
struct inflate_state FAR *state;
|
||||
type_ar ar;
|
||||
void inffas8664fnc(struct inffast_ar * par);
|
||||
|
||||
|
||||
|
||||
#if (defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )) || (defined(_MSC_VER) && defined(_M_AMD64))
|
||||
#define PAD_AVAIL_IN 6
|
||||
#define PAD_AVAIL_OUT 258
|
||||
#else
|
||||
#define PAD_AVAIL_IN 5
|
||||
#define PAD_AVAIL_OUT 257
|
||||
#endif
|
||||
|
||||
/* copy state to local variables */
|
||||
state = (struct inflate_state FAR *)strm->state;
|
||||
|
||||
ar.in = strm->next_in;
|
||||
ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN);
|
||||
ar.out = strm->next_out;
|
||||
ar.beg = ar.out - (start - strm->avail_out);
|
||||
ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT);
|
||||
ar.wsize = state->wsize;
|
||||
ar.write = state->wnext;
|
||||
ar.window = state->window;
|
||||
ar.hold = state->hold;
|
||||
ar.bits = state->bits;
|
||||
ar.lcode = state->lencode;
|
||||
ar.dcode = state->distcode;
|
||||
ar.lmask = (1U << state->lenbits) - 1;
|
||||
ar.dmask = (1U << state->distbits) - 1;
|
||||
|
||||
/* decode literals and length/distances until end-of-block or not enough
|
||||
input data or output space */
|
||||
|
||||
/* align in on 1/2 hold size boundary */
|
||||
while (((size_t)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) {
|
||||
ar.hold += (unsigned long)*ar.in++ << ar.bits;
|
||||
ar.bits += 8;
|
||||
}
|
||||
|
||||
inffas8664fnc(&ar);
|
||||
|
||||
if (ar.status > 1) {
|
||||
if (ar.status == 2)
|
||||
strm->msg = "invalid literal/length code";
|
||||
else if (ar.status == 3)
|
||||
strm->msg = "invalid distance code";
|
||||
else
|
||||
strm->msg = "invalid distance too far back";
|
||||
state->mode = BAD;
|
||||
}
|
||||
else if ( ar.status == 1 ) {
|
||||
state->mode = TYPE;
|
||||
}
|
||||
|
||||
/* return unused bytes (on entry, bits < 8, so in won't go too far back) */
|
||||
ar.len = ar.bits >> 3;
|
||||
ar.in -= ar.len;
|
||||
ar.bits -= ar.len << 3;
|
||||
ar.hold &= (1U << ar.bits) - 1;
|
||||
|
||||
/* update state and return */
|
||||
strm->next_in = ar.in;
|
||||
strm->next_out = ar.out;
|
||||
strm->avail_in = (unsigned)(ar.in < ar.last ?
|
||||
PAD_AVAIL_IN + (ar.last - ar.in) :
|
||||
PAD_AVAIL_IN - (ar.in - ar.last));
|
||||
strm->avail_out = (unsigned)(ar.out < ar.end ?
|
||||
PAD_AVAIL_OUT + (ar.end - ar.out) :
|
||||
PAD_AVAIL_OUT - (ar.out - ar.end));
|
||||
state->hold = (unsigned long)ar.hold;
|
||||
state->bits = ar.bits;
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
/* inffas8664.c is a hand tuned assembler version of inffast.c - fast decoding
|
||||
* version for AMD64 on Windows using Microsoft C compiler
|
||||
*
|
||||
* Copyright (C) 1995-2003 Mark Adler
|
||||
* For conditions of distribution and use, see copyright notice in zlib.h
|
||||
*
|
||||
* Copyright (C) 2003 Chris Anderson <christop@charm.net>
|
||||
* Please use the copyright conditions above.
|
||||
*
|
||||
* 2005 - Adaptation to Microsoft C Compiler for AMD64 by Gilles Vollant
|
||||
*
|
||||
* inffas8664.c call function inffas8664fnc in inffasx64.asm
|
||||
* inffasx64.asm is automatically convert from AMD64 portion of inffas86.c
|
||||
*
|
||||
* Dec-29-2003 -- I added AMD64 inflate asm support. This version is also
|
||||
* slightly quicker on x86 systems because, instead of using rep movsb to copy
|
||||
* data, it uses rep movsw, which moves data in 2-byte chunks instead of single
|
||||
* bytes. I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates
|
||||
* from http://fedora.linux.duke.edu/fc1_x86_64
|
||||
* which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with
|
||||
* 1GB ram. The 64-bit version is about 4% faster than the 32-bit version,
|
||||
* when decompressing mozilla-source-1.3.tar.gz.
|
||||
*
|
||||
* Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
|
||||
* the gcc -S output of zlib-1.2.0/inffast.c. Zlib-1.2.0 is in beta release at
|
||||
* the moment. I have successfully compiled and tested this code with gcc2.96,
|
||||
* gcc3.2, icc5.0, msvc6.0. It is very close to the speed of inffast.S
|
||||
* compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
|
||||
* enabled. I will attempt to merge the MMX code into this version. Newer
|
||||
* versions of this and inffast.S can be found at
|
||||
* http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
|
||||
*
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include "zutil.h"
|
||||
#include "inftrees.h"
|
||||
#include "inflate.h"
|
||||
#include "inffast.h"
|
||||
|
||||
/* Mark Adler's comments from inffast.c: */
|
||||
|
||||
/*
|
||||
Decode literal, length, and distance codes and write out the resulting
|
||||
literal and match bytes until either not enough input or output is
|
||||
available, an end-of-block is encountered, or a data error is encountered.
|
||||
When large enough input and output buffers are supplied to inflate(), for
|
||||
example, a 16K input buffer and a 64K output buffer, more than 95% of the
|
||||
inflate execution time is spent in this routine.
|
||||
|
||||
Entry assumptions:
|
||||
|
||||
state->mode == LEN
|
||||
strm->avail_in >= 6
|
||||
strm->avail_out >= 258
|
||||
start >= strm->avail_out
|
||||
state->bits < 8
|
||||
|
||||
On return, state->mode is one of:
|
||||
|
||||
LEN -- ran out of enough output space or enough available input
|
||||
TYPE -- reached end of block code, inflate() to interpret next block
|
||||
BAD -- error in block data
|
||||
|
||||
Notes:
|
||||
|
||||
- The maximum input bits used by a length/distance pair is 15 bits for the
|
||||
length code, 5 bits for the length extra, 15 bits for the distance code,
|
||||
and 13 bits for the distance extra. This totals 48 bits, or six bytes.
|
||||
Therefore if strm->avail_in >= 6, then there is enough input to avoid
|
||||
checking for available input while decoding.
|
||||
|
||||
- The maximum bytes that a single length/distance pair can output is 258
|
||||
bytes, which is the maximum length that can be coded. inflate_fast()
|
||||
requires strm->avail_out >= 258 for each loop to avoid checking for
|
||||
output space.
|
||||
*/
|
||||
|
||||
|
||||
|
||||
typedef struct inffast_ar {
|
||||
/* 64 32 x86 x86_64 */
|
||||
/* ar offset register */
|
||||
/* 0 0 */ void *esp; /* esp save */
|
||||
/* 8 4 */ void *ebp; /* ebp save */
|
||||
/* 16 8 */ unsigned char FAR *in; /* esi rsi local strm->next_in */
|
||||
/* 24 12 */ unsigned char FAR *last; /* r9 while in < last */
|
||||
/* 32 16 */ unsigned char FAR *out; /* edi rdi local strm->next_out */
|
||||
/* 40 20 */ unsigned char FAR *beg; /* inflate()'s init next_out */
|
||||
/* 48 24 */ unsigned char FAR *end; /* r10 while out < end */
|
||||
/* 56 28 */ unsigned char FAR *window;/* size of window, wsize!=0 */
|
||||
/* 64 32 */ code const FAR *lcode; /* ebp rbp local strm->lencode */
|
||||
/* 72 36 */ code const FAR *dcode; /* r11 local strm->distcode */
|
||||
/* 80 40 */ size_t /*unsigned long */hold; /* edx rdx local strm->hold */
|
||||
/* 88 44 */ unsigned bits; /* ebx rbx local strm->bits */
|
||||
/* 92 48 */ unsigned wsize; /* window size */
|
||||
/* 96 52 */ unsigned write; /* window write index */
|
||||
/*100 56 */ unsigned lmask; /* r12 mask for lcode */
|
||||
/*104 60 */ unsigned dmask; /* r13 mask for dcode */
|
||||
/*108 64 */ unsigned len; /* r14 match length */
|
||||
/*112 68 */ unsigned dist; /* r15 match distance */
|
||||
/*116 72 */ unsigned status; /* set when state chng*/
|
||||
} type_ar;
|
||||
#ifdef ASMINF
|
||||
|
||||
void inflate_fast(strm, start)
|
||||
z_streamp strm;
|
||||
unsigned start; /* inflate()'s starting value for strm->avail_out */
|
||||
{
|
||||
struct inflate_state FAR *state;
|
||||
type_ar ar;
|
||||
void inffas8664fnc(struct inffast_ar * par);
|
||||
|
||||
|
||||
|
||||
#if (defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )) || (defined(_MSC_VER) && defined(_M_AMD64))
|
||||
#define PAD_AVAIL_IN 6
|
||||
#define PAD_AVAIL_OUT 258
|
||||
#else
|
||||
#define PAD_AVAIL_IN 5
|
||||
#define PAD_AVAIL_OUT 257
|
||||
#endif
|
||||
|
||||
/* copy state to local variables */
|
||||
state = (struct inflate_state FAR *)strm->state;
|
||||
|
||||
ar.in = strm->next_in;
|
||||
ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN);
|
||||
ar.out = strm->next_out;
|
||||
ar.beg = ar.out - (start - strm->avail_out);
|
||||
ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT);
|
||||
ar.wsize = state->wsize;
|
||||
ar.write = state->wnext;
|
||||
ar.window = state->window;
|
||||
ar.hold = state->hold;
|
||||
ar.bits = state->bits;
|
||||
ar.lcode = state->lencode;
|
||||
ar.dcode = state->distcode;
|
||||
ar.lmask = (1U << state->lenbits) - 1;
|
||||
ar.dmask = (1U << state->distbits) - 1;
|
||||
|
||||
/* decode literals and length/distances until end-of-block or not enough
|
||||
input data or output space */
|
||||
|
||||
/* align in on 1/2 hold size boundary */
|
||||
while (((size_t)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) {
|
||||
ar.hold += (unsigned long)*ar.in++ << ar.bits;
|
||||
ar.bits += 8;
|
||||
}
|
||||
|
||||
inffas8664fnc(&ar);
|
||||
|
||||
if (ar.status > 1) {
|
||||
if (ar.status == 2)
|
||||
strm->msg = "invalid literal/length code";
|
||||
else if (ar.status == 3)
|
||||
strm->msg = "invalid distance code";
|
||||
else
|
||||
strm->msg = "invalid distance too far back";
|
||||
state->mode = BAD;
|
||||
}
|
||||
else if ( ar.status == 1 ) {
|
||||
state->mode = TYPE;
|
||||
}
|
||||
|
||||
/* return unused bytes (on entry, bits < 8, so in won't go too far back) */
|
||||
ar.len = ar.bits >> 3;
|
||||
ar.in -= ar.len;
|
||||
ar.bits -= ar.len << 3;
|
||||
ar.hold &= (1U << ar.bits) - 1;
|
||||
|
||||
/* update state and return */
|
||||
strm->next_in = ar.in;
|
||||
strm->next_out = ar.out;
|
||||
strm->avail_in = (unsigned)(ar.in < ar.last ?
|
||||
PAD_AVAIL_IN + (ar.last - ar.in) :
|
||||
PAD_AVAIL_IN - (ar.in - ar.last));
|
||||
strm->avail_out = (unsigned)(ar.out < ar.end ?
|
||||
PAD_AVAIL_OUT + (ar.end - ar.out) :
|
||||
PAD_AVAIL_OUT - (ar.out - ar.end));
|
||||
state->hold = (unsigned long)ar.hold;
|
||||
state->bits = ar.bits;
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,275 +1,275 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <windows.h>
|
||||
|
||||
#include "zlib.h"
|
||||
|
||||
|
||||
void MyDoMinus64(LARGE_INTEGER *R,LARGE_INTEGER A,LARGE_INTEGER B)
|
||||
{
|
||||
R->HighPart = A.HighPart - B.HighPart;
|
||||
if (A.LowPart >= B.LowPart)
|
||||
R->LowPart = A.LowPart - B.LowPart;
|
||||
else
|
||||
{
|
||||
R->LowPart = A.LowPart - B.LowPart;
|
||||
R->HighPart --;
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef _M_X64
|
||||
// see http://msdn2.microsoft.com/library/twchhe95(en-us,vs.80).aspx for __rdtsc
|
||||
unsigned __int64 __rdtsc(void);
|
||||
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
// printf("rdtsc = %I64x\n",__rdtsc());
|
||||
pbeginTime64->QuadPart=__rdtsc();
|
||||
}
|
||||
|
||||
LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER LIres;
|
||||
unsigned _int64 res=__rdtsc()-((unsigned _int64)(beginTime64.QuadPart));
|
||||
LIres.QuadPart=res;
|
||||
// printf("rdtsc = %I64x\n",__rdtsc());
|
||||
return LIres;
|
||||
}
|
||||
#else
|
||||
#ifdef _M_IX86
|
||||
void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
DWORD dwEdx,dwEax;
|
||||
_asm
|
||||
{
|
||||
rdtsc
|
||||
mov dwEax,eax
|
||||
mov dwEdx,edx
|
||||
}
|
||||
pbeginTime64->LowPart=dwEax;
|
||||
pbeginTime64->HighPart=dwEdx;
|
||||
}
|
||||
|
||||
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
myGetRDTSC32(pbeginTime64);
|
||||
}
|
||||
|
||||
LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER LIres,endTime64;
|
||||
myGetRDTSC32(&endTime64);
|
||||
|
||||
LIres.LowPart=LIres.HighPart=0;
|
||||
MyDoMinus64(&LIres,endTime64,beginTime64);
|
||||
return LIres;
|
||||
}
|
||||
#else
|
||||
void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
}
|
||||
|
||||
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
}
|
||||
|
||||
LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER lr;
|
||||
lr.QuadPart=0;
|
||||
return lr;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void BeginCountPerfCounter(LARGE_INTEGER * pbeginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(pbeginTime64)))
|
||||
{
|
||||
pbeginTime64->LowPart = GetTickCount();
|
||||
pbeginTime64->HighPart = 0;
|
||||
}
|
||||
}
|
||||
|
||||
DWORD GetMsecSincePerfCounter(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER endTime64,ticksPerSecond,ticks;
|
||||
DWORDLONG ticksShifted,tickSecShifted;
|
||||
DWORD dwLog=16+0;
|
||||
DWORD dwRet;
|
||||
if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(&endTime64)))
|
||||
dwRet = (GetTickCount() - beginTime64.LowPart)*1;
|
||||
else
|
||||
{
|
||||
MyDoMinus64(&ticks,endTime64,beginTime64);
|
||||
QueryPerformanceFrequency(&ticksPerSecond);
|
||||
|
||||
|
||||
{
|
||||
ticksShifted = Int64ShrlMod32(*(DWORDLONG*)&ticks,dwLog);
|
||||
tickSecShifted = Int64ShrlMod32(*(DWORDLONG*)&ticksPerSecond,dwLog);
|
||||
|
||||
}
|
||||
|
||||
dwRet = (DWORD)((((DWORD)ticksShifted)*1000)/(DWORD)(tickSecShifted));
|
||||
dwRet *=1;
|
||||
}
|
||||
return dwRet;
|
||||
}
|
||||
|
||||
int ReadFileMemory(const char* filename,long* plFileSize,unsigned char** pFilePtr)
|
||||
{
|
||||
FILE* stream;
|
||||
unsigned char* ptr;
|
||||
int retVal=1;
|
||||
stream=fopen(filename, "rb");
|
||||
if (stream==NULL)
|
||||
return 0;
|
||||
|
||||
fseek(stream,0,SEEK_END);
|
||||
|
||||
*plFileSize=ftell(stream);
|
||||
fseek(stream,0,SEEK_SET);
|
||||
ptr=malloc((*plFileSize)+1);
|
||||
if (ptr==NULL)
|
||||
retVal=0;
|
||||
else
|
||||
{
|
||||
if (fread(ptr, 1, *plFileSize,stream) != (*plFileSize))
|
||||
retVal=0;
|
||||
}
|
||||
fclose(stream);
|
||||
*pFilePtr=ptr;
|
||||
return retVal;
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
int BlockSizeCompress=0x8000;
|
||||
int BlockSizeUncompress=0x8000;
|
||||
int cprLevel=Z_DEFAULT_COMPRESSION ;
|
||||
long lFileSize;
|
||||
unsigned char* FilePtr;
|
||||
long lBufferSizeCpr;
|
||||
long lBufferSizeUncpr;
|
||||
long lCompressedSize=0;
|
||||
unsigned char* CprPtr;
|
||||
unsigned char* UncprPtr;
|
||||
long lSizeCpr,lSizeUncpr;
|
||||
DWORD dwGetTick,dwMsecQP;
|
||||
LARGE_INTEGER li_qp,li_rdtsc,dwResRdtsc;
|
||||
|
||||
if (argc<=1)
|
||||
{
|
||||
printf("run TestZlib <File> [BlockSizeCompress] [BlockSizeUncompress] [compres. level]\n");
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (ReadFileMemory(argv[1],&lFileSize,&FilePtr)==0)
|
||||
{
|
||||
printf("error reading %s\n",argv[1]);
|
||||
return 1;
|
||||
}
|
||||
else printf("file %s read, %u bytes\n",argv[1],lFileSize);
|
||||
|
||||
if (argc>=3)
|
||||
BlockSizeCompress=atol(argv[2]);
|
||||
|
||||
if (argc>=4)
|
||||
BlockSizeUncompress=atol(argv[3]);
|
||||
|
||||
if (argc>=5)
|
||||
cprLevel=(int)atol(argv[4]);
|
||||
|
||||
lBufferSizeCpr = lFileSize + (lFileSize/0x10) + 0x200;
|
||||
lBufferSizeUncpr = lBufferSizeCpr;
|
||||
|
||||
CprPtr=(unsigned char*)malloc(lBufferSizeCpr + BlockSizeCompress);
|
||||
|
||||
BeginCountPerfCounter(&li_qp,TRUE);
|
||||
dwGetTick=GetTickCount();
|
||||
BeginCountRdtsc(&li_rdtsc);
|
||||
{
|
||||
z_stream zcpr;
|
||||
int ret=Z_OK;
|
||||
long lOrigToDo = lFileSize;
|
||||
long lOrigDone = 0;
|
||||
int step=0;
|
||||
memset(&zcpr,0,sizeof(z_stream));
|
||||
deflateInit(&zcpr,cprLevel);
|
||||
|
||||
zcpr.next_in = FilePtr;
|
||||
zcpr.next_out = CprPtr;
|
||||
|
||||
|
||||
do
|
||||
{
|
||||
long all_read_before = zcpr.total_in;
|
||||
zcpr.avail_in = min(lOrigToDo,BlockSizeCompress);
|
||||
zcpr.avail_out = BlockSizeCompress;
|
||||
ret=deflate(&zcpr,(zcpr.avail_in==lOrigToDo) ? Z_FINISH : Z_SYNC_FLUSH);
|
||||
lOrigDone += (zcpr.total_in-all_read_before);
|
||||
lOrigToDo -= (zcpr.total_in-all_read_before);
|
||||
step++;
|
||||
} while (ret==Z_OK);
|
||||
|
||||
lSizeCpr=zcpr.total_out;
|
||||
deflateEnd(&zcpr);
|
||||
dwGetTick=GetTickCount()-dwGetTick;
|
||||
dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
|
||||
dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
|
||||
printf("total compress size = %u, in %u step\n",lSizeCpr,step);
|
||||
printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
|
||||
printf("defcpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
|
||||
printf("defcpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
|
||||
}
|
||||
|
||||
CprPtr=(unsigned char*)realloc(CprPtr,lSizeCpr);
|
||||
UncprPtr=(unsigned char*)malloc(lBufferSizeUncpr + BlockSizeUncompress);
|
||||
|
||||
BeginCountPerfCounter(&li_qp,TRUE);
|
||||
dwGetTick=GetTickCount();
|
||||
BeginCountRdtsc(&li_rdtsc);
|
||||
{
|
||||
z_stream zcpr;
|
||||
int ret=Z_OK;
|
||||
long lOrigToDo = lSizeCpr;
|
||||
long lOrigDone = 0;
|
||||
int step=0;
|
||||
memset(&zcpr,0,sizeof(z_stream));
|
||||
inflateInit(&zcpr);
|
||||
|
||||
zcpr.next_in = CprPtr;
|
||||
zcpr.next_out = UncprPtr;
|
||||
|
||||
|
||||
do
|
||||
{
|
||||
long all_read_before = zcpr.total_in;
|
||||
zcpr.avail_in = min(lOrigToDo,BlockSizeUncompress);
|
||||
zcpr.avail_out = BlockSizeUncompress;
|
||||
ret=inflate(&zcpr,Z_SYNC_FLUSH);
|
||||
lOrigDone += (zcpr.total_in-all_read_before);
|
||||
lOrigToDo -= (zcpr.total_in-all_read_before);
|
||||
step++;
|
||||
} while (ret==Z_OK);
|
||||
|
||||
lSizeUncpr=zcpr.total_out;
|
||||
inflateEnd(&zcpr);
|
||||
dwGetTick=GetTickCount()-dwGetTick;
|
||||
dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
|
||||
dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
|
||||
printf("total uncompress size = %u, in %u step\n",lSizeUncpr,step);
|
||||
printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
|
||||
printf("uncpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
|
||||
printf("uncpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
|
||||
}
|
||||
|
||||
if (lSizeUncpr==lFileSize)
|
||||
{
|
||||
if (memcmp(FilePtr,UncprPtr,lFileSize)==0)
|
||||
printf("compare ok\n");
|
||||
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <windows.h>
|
||||
|
||||
#include "zlib.h"
|
||||
|
||||
|
||||
void MyDoMinus64(LARGE_INTEGER *R,LARGE_INTEGER A,LARGE_INTEGER B)
|
||||
{
|
||||
R->HighPart = A.HighPart - B.HighPart;
|
||||
if (A.LowPart >= B.LowPart)
|
||||
R->LowPart = A.LowPart - B.LowPart;
|
||||
else
|
||||
{
|
||||
R->LowPart = A.LowPart - B.LowPart;
|
||||
R->HighPart --;
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef _M_X64
|
||||
// see http://msdn2.microsoft.com/library/twchhe95(en-us,vs.80).aspx for __rdtsc
|
||||
unsigned __int64 __rdtsc(void);
|
||||
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
// printf("rdtsc = %I64x\n",__rdtsc());
|
||||
pbeginTime64->QuadPart=__rdtsc();
|
||||
}
|
||||
|
||||
LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER LIres;
|
||||
unsigned _int64 res=__rdtsc()-((unsigned _int64)(beginTime64.QuadPart));
|
||||
LIres.QuadPart=res;
|
||||
// printf("rdtsc = %I64x\n",__rdtsc());
|
||||
return LIres;
|
||||
}
|
||||
#else
|
||||
#ifdef _M_IX86
|
||||
void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
DWORD dwEdx,dwEax;
|
||||
_asm
|
||||
{
|
||||
rdtsc
|
||||
mov dwEax,eax
|
||||
mov dwEdx,edx
|
||||
}
|
||||
pbeginTime64->LowPart=dwEax;
|
||||
pbeginTime64->HighPart=dwEdx;
|
||||
}
|
||||
|
||||
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
myGetRDTSC32(pbeginTime64);
|
||||
}
|
||||
|
||||
LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER LIres,endTime64;
|
||||
myGetRDTSC32(&endTime64);
|
||||
|
||||
LIres.LowPart=LIres.HighPart=0;
|
||||
MyDoMinus64(&LIres,endTime64,beginTime64);
|
||||
return LIres;
|
||||
}
|
||||
#else
|
||||
void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
}
|
||||
|
||||
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
|
||||
{
|
||||
}
|
||||
|
||||
LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER lr;
|
||||
lr.QuadPart=0;
|
||||
return lr;
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void BeginCountPerfCounter(LARGE_INTEGER * pbeginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(pbeginTime64)))
|
||||
{
|
||||
pbeginTime64->LowPart = GetTickCount();
|
||||
pbeginTime64->HighPart = 0;
|
||||
}
|
||||
}
|
||||
|
||||
DWORD GetMsecSincePerfCounter(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
|
||||
{
|
||||
LARGE_INTEGER endTime64,ticksPerSecond,ticks;
|
||||
DWORDLONG ticksShifted,tickSecShifted;
|
||||
DWORD dwLog=16+0;
|
||||
DWORD dwRet;
|
||||
if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(&endTime64)))
|
||||
dwRet = (GetTickCount() - beginTime64.LowPart)*1;
|
||||
else
|
||||
{
|
||||
MyDoMinus64(&ticks,endTime64,beginTime64);
|
||||
QueryPerformanceFrequency(&ticksPerSecond);
|
||||
|
||||
|
||||
{
|
||||
ticksShifted = Int64ShrlMod32(*(DWORDLONG*)&ticks,dwLog);
|
||||
tickSecShifted = Int64ShrlMod32(*(DWORDLONG*)&ticksPerSecond,dwLog);
|
||||
|
||||
}
|
||||
|
||||
dwRet = (DWORD)((((DWORD)ticksShifted)*1000)/(DWORD)(tickSecShifted));
|
||||
dwRet *=1;
|
||||
}
|
||||
return dwRet;
|
||||
}
|
||||
|
||||
int ReadFileMemory(const char* filename,long* plFileSize,unsigned char** pFilePtr)
|
||||
{
|
||||
FILE* stream;
|
||||
unsigned char* ptr;
|
||||
int retVal=1;
|
||||
stream=fopen(filename, "rb");
|
||||
if (stream==NULL)
|
||||
return 0;
|
||||
|
||||
fseek(stream,0,SEEK_END);
|
||||
|
||||
*plFileSize=ftell(stream);
|
||||
fseek(stream,0,SEEK_SET);
|
||||
ptr=malloc((*plFileSize)+1);
|
||||
if (ptr==NULL)
|
||||
retVal=0;
|
||||
else
|
||||
{
|
||||
if (fread(ptr, 1, *plFileSize,stream) != (*plFileSize))
|
||||
retVal=0;
|
||||
}
|
||||
fclose(stream);
|
||||
*pFilePtr=ptr;
|
||||
return retVal;
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
int BlockSizeCompress=0x8000;
|
||||
int BlockSizeUncompress=0x8000;
|
||||
int cprLevel=Z_DEFAULT_COMPRESSION ;
|
||||
long lFileSize;
|
||||
unsigned char* FilePtr;
|
||||
long lBufferSizeCpr;
|
||||
long lBufferSizeUncpr;
|
||||
long lCompressedSize=0;
|
||||
unsigned char* CprPtr;
|
||||
unsigned char* UncprPtr;
|
||||
long lSizeCpr,lSizeUncpr;
|
||||
DWORD dwGetTick,dwMsecQP;
|
||||
LARGE_INTEGER li_qp,li_rdtsc,dwResRdtsc;
|
||||
|
||||
if (argc<=1)
|
||||
{
|
||||
printf("run TestZlib <File> [BlockSizeCompress] [BlockSizeUncompress] [compres. level]\n");
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (ReadFileMemory(argv[1],&lFileSize,&FilePtr)==0)
|
||||
{
|
||||
printf("error reading %s\n",argv[1]);
|
||||
return 1;
|
||||
}
|
||||
else printf("file %s read, %u bytes\n",argv[1],lFileSize);
|
||||
|
||||
if (argc>=3)
|
||||
BlockSizeCompress=atol(argv[2]);
|
||||
|
||||
if (argc>=4)
|
||||
BlockSizeUncompress=atol(argv[3]);
|
||||
|
||||
if (argc>=5)
|
||||
cprLevel=(int)atol(argv[4]);
|
||||
|
||||
lBufferSizeCpr = lFileSize + (lFileSize/0x10) + 0x200;
|
||||
lBufferSizeUncpr = lBufferSizeCpr;
|
||||
|
||||
CprPtr=(unsigned char*)malloc(lBufferSizeCpr + BlockSizeCompress);
|
||||
|
||||
BeginCountPerfCounter(&li_qp,TRUE);
|
||||
dwGetTick=GetTickCount();
|
||||
BeginCountRdtsc(&li_rdtsc);
|
||||
{
|
||||
z_stream zcpr;
|
||||
int ret=Z_OK;
|
||||
long lOrigToDo = lFileSize;
|
||||
long lOrigDone = 0;
|
||||
int step=0;
|
||||
memset(&zcpr,0,sizeof(z_stream));
|
||||
deflateInit(&zcpr,cprLevel);
|
||||
|
||||
zcpr.next_in = FilePtr;
|
||||
zcpr.next_out = CprPtr;
|
||||
|
||||
|
||||
do
|
||||
{
|
||||
long all_read_before = zcpr.total_in;
|
||||
zcpr.avail_in = min(lOrigToDo,BlockSizeCompress);
|
||||
zcpr.avail_out = BlockSizeCompress;
|
||||
ret=deflate(&zcpr,(zcpr.avail_in==lOrigToDo) ? Z_FINISH : Z_SYNC_FLUSH);
|
||||
lOrigDone += (zcpr.total_in-all_read_before);
|
||||
lOrigToDo -= (zcpr.total_in-all_read_before);
|
||||
step++;
|
||||
} while (ret==Z_OK);
|
||||
|
||||
lSizeCpr=zcpr.total_out;
|
||||
deflateEnd(&zcpr);
|
||||
dwGetTick=GetTickCount()-dwGetTick;
|
||||
dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
|
||||
dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
|
||||
printf("total compress size = %u, in %u step\n",lSizeCpr,step);
|
||||
printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
|
||||
printf("defcpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
|
||||
printf("defcpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
|
||||
}
|
||||
|
||||
CprPtr=(unsigned char*)realloc(CprPtr,lSizeCpr);
|
||||
UncprPtr=(unsigned char*)malloc(lBufferSizeUncpr + BlockSizeUncompress);
|
||||
|
||||
BeginCountPerfCounter(&li_qp,TRUE);
|
||||
dwGetTick=GetTickCount();
|
||||
BeginCountRdtsc(&li_rdtsc);
|
||||
{
|
||||
z_stream zcpr;
|
||||
int ret=Z_OK;
|
||||
long lOrigToDo = lSizeCpr;
|
||||
long lOrigDone = 0;
|
||||
int step=0;
|
||||
memset(&zcpr,0,sizeof(z_stream));
|
||||
inflateInit(&zcpr);
|
||||
|
||||
zcpr.next_in = CprPtr;
|
||||
zcpr.next_out = UncprPtr;
|
||||
|
||||
|
||||
do
|
||||
{
|
||||
long all_read_before = zcpr.total_in;
|
||||
zcpr.avail_in = min(lOrigToDo,BlockSizeUncompress);
|
||||
zcpr.avail_out = BlockSizeUncompress;
|
||||
ret=inflate(&zcpr,Z_SYNC_FLUSH);
|
||||
lOrigDone += (zcpr.total_in-all_read_before);
|
||||
lOrigToDo -= (zcpr.total_in-all_read_before);
|
||||
step++;
|
||||
} while (ret==Z_OK);
|
||||
|
||||
lSizeUncpr=zcpr.total_out;
|
||||
inflateEnd(&zcpr);
|
||||
dwGetTick=GetTickCount()-dwGetTick;
|
||||
dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
|
||||
dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
|
||||
printf("total uncompress size = %u, in %u step\n",lSizeUncpr,step);
|
||||
printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
|
||||
printf("uncpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
|
||||
printf("uncpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
|
||||
}
|
||||
|
||||
if (lSizeUncpr==lFileSize)
|
||||
{
|
||||
if (memcmp(FilePtr,UncprPtr,lFileSize)==0)
|
||||
printf("compare ok\n");
|
||||
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
+1
-1
@@ -20,7 +20,7 @@ int
|
||||
\fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS "struct stat" *statPtr out
|
||||
.AP char *path in
|
||||
.AP "const char" *path in
|
||||
Native name of the file to check the attributes of.
|
||||
.AP int mode in
|
||||
Mask consisting of one or more of \fBR_OK\fR, \fBW_OK\fR, \fBX_OK\fR and
|
||||
|
||||
+18
-2
@@ -49,7 +49,7 @@ Interpreter in which to record information.
|
||||
The code returned from script evaluation.
|
||||
.AP Tcl_Obj *options
|
||||
A dictionary of return options.
|
||||
.AP char *message in
|
||||
.AP "const char" *message in
|
||||
For \fBTcl_AddErrorInfo\fR,
|
||||
this is a conventional C string to append to the \fB\-errorinfo\fR return option.
|
||||
For \fBTcl_AddObjErrorInfo\fR,
|
||||
@@ -66,7 +66,7 @@ appending to the \fB\-errorinfo\fR return option.
|
||||
If negative, all bytes up to the first null byte are used.
|
||||
.AP Tcl_Obj *errorObjPtr in
|
||||
The \fB\-errorcode\fR return option will be set to this value.
|
||||
.AP char *element in
|
||||
.AP "const char" *element in
|
||||
String to record as one element of the \fB\-errorcode\fR return option.
|
||||
Last \fIelement\fR argument must be NULL.
|
||||
.AP va_list argList in
|
||||
@@ -308,6 +308,22 @@ The global variables \fBerrorInfo\fR and
|
||||
\fBerrorCode\fR are not modified by \fBTcl_ResetResult\fR
|
||||
so they continue to hold a record of information about the
|
||||
most recent error seen in an interpreter.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The result of \fBTcl_GetReturnOptions\fR will have at least one
|
||||
reference to it from the Tcl interpreter. If not using it immediately,
|
||||
you should use \fBTcl_IncrRefCount\fR to add your own reference.
|
||||
.PP
|
||||
The \fIoptions\fR argument to \fBTcl_SetReturnOptions\fR will have a
|
||||
reference added by the Tcl interpreter; it may safely be called with a
|
||||
zero-reference value.
|
||||
.PP
|
||||
\fBTcl_AppendObjToErrorInfo\fR only reads its \fIobjPtr\fR argument;
|
||||
it does not modify its reference count at all.
|
||||
.PP
|
||||
The \fIerrorObjPtr\fR argument to \fBTcl_SetObjErrorCode\fR will have a
|
||||
reference added by the Tcl interpreter; it may safely be called with a
|
||||
zero-reference value.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3),
|
||||
Tcl_SetErrno(3), errorCode(n), errorInfo(n)
|
||||
|
||||
+1
-1
@@ -18,7 +18,7 @@ char
|
||||
\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS char *countPtr out
|
||||
.AP char *src in
|
||||
.AP "const char" *src in
|
||||
Pointer to a string starting with a backslash.
|
||||
.AP int *countPtr out
|
||||
If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled
|
||||
|
||||
@@ -88,6 +88,18 @@ will lead to a \fBTCL_OK\fR return (and the boolean value 1),
|
||||
while the same value passed to \fBTcl_GetBoolean\fR will lead to
|
||||
a \fBTCL_ERROR\fR return.
|
||||
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewBooleanObj\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_SetBooleanObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument, but does require that the object be unshared.
|
||||
.PP
|
||||
\fBTcl_GetBooleanFromObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument; it only reads. Note however that this function
|
||||
may set the interpreter result; if that is the only place that
|
||||
is holding a reference to the object, it will be deleted.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj, Tcl_IsShared, Tcl_GetBoolean
|
||||
|
||||
|
||||
@@ -85,6 +85,18 @@ newly allocated bytes at the end of the array have arbitrary values. If
|
||||
the length of array is reduced to the new length. The return value is a
|
||||
pointer to the value's new array of bytes.
|
||||
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewByteArrayObj\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_SetByteArrayObj\fR and \fBTcl_SetByteArrayLength\fR do not modify the
|
||||
reference count of their \fIobjPtr\fR arguments, but do require that the
|
||||
object be unshared.
|
||||
.PP
|
||||
\fBTcl_GetByteArrayFromObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument; it only reads.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
|
||||
|
||||
|
||||
@@ -67,6 +67,14 @@ other procedures. If an error is returned and this bit is set in
|
||||
result, where it can be retrieved with \fBTcl_GetObjResult\fR or
|
||||
\fBTcl_GetStringResult\fR. If this flag bit is not set then no error
|
||||
message is left and the interpreter's result will not be modified.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_CancelEval\fR always decrements the reference count of its
|
||||
\fIresultObjPtr\fR argument (if that is non-NULL). It is expected to
|
||||
be usually called with an object with zero reference count. If the
|
||||
object is shared with some other location (including the Tcl
|
||||
evaluation stack) it should have its reference count incremented
|
||||
before calling this function.
|
||||
.SH "SEE ALSO"
|
||||
interp(n), Tcl_Eval(3),
|
||||
TIP 285
|
||||
|
||||
+23
@@ -241,6 +241,29 @@ NULL if the whole chain is to be processed (the argument itself is never
|
||||
NULL); this variable may be updated by the callback. The \fImethodNameObj\fR
|
||||
parameter gives an unshared object containing the name of the method being
|
||||
invoked, as provided by the user; this object may be updated by the callback.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_GetObjectFromObj\fR will not have its
|
||||
reference count manipulated, but this function may modify the interpreter
|
||||
result (to report any error) so interpreter results should not be fed into
|
||||
this without an additional reference being used.
|
||||
.PP
|
||||
The result of \fBTcl_GetObjectName\fR is a value that is owned by the object
|
||||
that is regenerated when this function is first called after the object is
|
||||
renamed. If the value is to be retained at all, the caller should increment
|
||||
the reference count.
|
||||
.PP
|
||||
The first \fIobjc\fR values in the \fIobjv\fR argument to
|
||||
\fBTcl_NewObjectInstance\fR are the arguments to pass to the constructor. They
|
||||
must have a reference count of at least 1, and may have their reference counts
|
||||
changed during the running of the constructor. Constructors may modify the
|
||||
interpreter result, which consequently means that interpreter results should
|
||||
not be used as arguments without an additional reference being taken.
|
||||
.PP
|
||||
The \fImethodNameObj\fR argument to a Tcl_ObjectMapMethodNameProc
|
||||
implementation will be a value with a reference count of at least 1 where at
|
||||
least one reference is not held by the interpreter result. It is expected that
|
||||
method name mappers will only read their \fImethodNameObj\fR arguments.
|
||||
.SH "SEE ALSO"
|
||||
Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+9
-1
@@ -243,8 +243,16 @@ any script evaluation mechanism will fail.
|
||||
.PP
|
||||
For a description of the Tcl interface to multiple interpreters, see
|
||||
\fIinterp(n)\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_CreateAliasObj\fR increments the reference counts of the values
|
||||
in its \fIobjv\fR argument. (That reference lasts the same length of
|
||||
time as the owning alias.)
|
||||
.PP
|
||||
\fBTcl_GetAliasObj\fR returns (via its \fIobjvPtr\fR argument) a
|
||||
pointer to values that it holds a reference to.
|
||||
.SH "SEE ALSO"
|
||||
interp
|
||||
interp(n)
|
||||
|
||||
.SH KEYWORDS
|
||||
alias, command, exposed commands, hidden commands, interpreter, invoke,
|
||||
|
||||
@@ -156,6 +156,10 @@ pointed to by \fIargTypesPointer\fR.
|
||||
\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all
|
||||
the math functions defined in the interpreter whose name matches
|
||||
\fIpattern\fR. The returned value has a reference count of zero.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_ListMathFuncs\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.SH "SEE ALSO"
|
||||
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+16
-1
@@ -54,7 +54,7 @@ const char *
|
||||
.AS Tcl_CmdDeleteProc *deleteProc in/out
|
||||
.AP Tcl_Interp *interp in
|
||||
Interpreter in which to create a new command or that contains a command.
|
||||
.AP char *cmdName in
|
||||
.AP "const char" *cmdName in
|
||||
Name of command.
|
||||
.AP Tcl_ObjCmdProc *proc in
|
||||
Implementation of the new command: \fIproc\fR will be called whenever
|
||||
@@ -323,6 +323,21 @@ instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
|
||||
string which was registered, and not a copy; use of a compile-time constant
|
||||
string is \fIstrongly recommended\fR.
|
||||
.VE "info cmdtype feature"
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
When the \fIproc\fR passed to \fBTcl_CreateObjCommand\fR is called,
|
||||
the values in its \fIobjv\fR argument will have a reference count of
|
||||
at least 1, with that guaranteed reference being from the Tcl
|
||||
evaluation stack. You should not call \fBTcl_DecrRefCount\fR on any of
|
||||
those values unless you call \fBTcl_IncrRefCount\fR on them first.
|
||||
Also, when the \fIproc\fR is called, the interpreter result is
|
||||
guaranteed to be an empty string value with a reference count of 1.
|
||||
.PP
|
||||
\fBTcl_GetCommandFullName\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument, but does require that the object be unshared.
|
||||
.PP
|
||||
\fBTcl_GetCommandFromObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument; it only reads.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -187,5 +187,14 @@ There is no way to be notified when the trace created by
|
||||
\fBTcl_CreateTrace\fR is deleted. There is no way for the \fIproc\fR
|
||||
associated with a call to \fBTcl_CreateTrace\fR to abort execution of
|
||||
\fIcommand\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
When the \fIproc\fR passed to \fBTcl_CreateObjTrace\fR is called,
|
||||
the values in its \fIobjv\fR argument will have a reference count of
|
||||
at least 1, with that guaranteed reference being from the Tcl
|
||||
evaluation stack. You should not call \fBTcl_DecrRefCount\fR on any of
|
||||
those values unless you call \fBTcl_IncrRefCount\fR on them first.
|
||||
.SH "SEE ALSO"
|
||||
trace(n)
|
||||
.SH KEYWORDS
|
||||
command, create, delete, interpreter, trace
|
||||
|
||||
@@ -190,6 +190,73 @@ path as this is easy to construct from repeated use of
|
||||
dictionaries are created for non-terminal keys where they do not
|
||||
already exist. With \fBTcl_DictObjRemoveKeyList\fR, all non-terminal
|
||||
keys must exist and have dictionaries as their values.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewDictObj\fR always returns a zero-reference object, much like
|
||||
\fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_DictObjPut\fR does not modify the reference count of its \fIdictPtr\fR
|
||||
argument, but does require that the object be unshared. If
|
||||
\fBTcl_DictObjPut\fR returns \fBTCL_ERROR\fR it does not manipulate any
|
||||
reference counts; but if it returns \fBTCL_OK\fR then it definitely increments
|
||||
the reference count of \fIvaluePtr\fR and may increment the reference count of
|
||||
\fIkeyPtr\fR; the latter case happens exactly when the key did not previously
|
||||
exist in the dictionary. Note however that this function may set the
|
||||
interpreter result; if that is the only place that is holding a reference to
|
||||
an object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_DictObjGet\fR only reads from its \fIdictPtr\fR and \fIkeyPtr\fR
|
||||
arguments, and does not manipulate their reference counts at all. If the
|
||||
\fIvaluePtrPtr\fR argument is not set to NULL (and the function doesn't return
|
||||
\fBTCL_ERROR\fR), it will be set to a value with a reference count of at least
|
||||
1, with a reference owned by the dictionary. Note however that this function
|
||||
may set the interpreter result; if that is the only place that is holding a
|
||||
reference to an object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_DictObjRemove\fR does not modify the reference count of its
|
||||
\fIdictPtr\fR argument, but does require that the object be unshared. It does
|
||||
not manipulate the reference count of its \fIkeyPtr\fR argument at all. Note
|
||||
however that this function may set the interpreter result; if that is the only
|
||||
place that is holding a reference to an object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_DictObjSize\fR does not modify the reference count of its \fIdictPtr\fR
|
||||
argument; it only reads. Note however that this function may set the
|
||||
interpreter result; if that is the only place that is holding a reference to
|
||||
the dictionary object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_DictObjFirst\fR does not modify the reference count of its
|
||||
\fIdictPtr\fR argument; it only reads. The variables given by the
|
||||
\fIkeyPtrPtr\fR and \fIvaluePtrPtr\fR arguments (if not NULL) will be updated
|
||||
to contain references to the relevant values in the dictionary; their
|
||||
reference counts will be at least 1 (due to the dictionary holding a reference
|
||||
to them). It may also manipulate internal references; these are not exposed to
|
||||
user code, but require a matching \fBTcl_DictObjDone\fR call. Note however
|
||||
that this function may set the interpreter result; if that is the only place
|
||||
that is holding a reference to the dictionary object, it will be deleted.
|
||||
.PP
|
||||
Similarly for \fBTcl_DictObjNext\fR; the variables given by the
|
||||
\fIkeyPtrPtr\fR and \fIvaluePtrPtr\fR arguments (if not NULL) will be updated
|
||||
to contain references to the relevant values in the dictionary; their
|
||||
reference counts will be at least 1 (due to the dictionary holding a reference
|
||||
to them).
|
||||
.PP
|
||||
\fBTcl_DictObjDone\fR does not manipulate (user-visible) reference counts.
|
||||
.PP
|
||||
\fBTcl_DictObjPutKeyList\fR is similar to \fBTcl_DictObjPut\fR; it does not
|
||||
modify the reference count of its \fIdictPtr\fR argument, but does require
|
||||
that the object be unshared. It may increment the reference count of any value
|
||||
passed in the \fIkeyv\fR argument, and will increment the reference count of
|
||||
the \fIvaluePtr\fR argument on success. It is recommended that values passed
|
||||
via \fIkeyv\fR and \fIvaluePtr\fR do not have zero reference counts. Note
|
||||
however that this function may set the interpreter result; if that is the only
|
||||
place that is holding a reference to an object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_DictObjRemoveKeyList\fR is similar to \fBTcl_DictObjRemove\fR; it does
|
||||
not modify the reference count of its \fIdictPtr\fR argument, but does require
|
||||
that the object be unshared, and does not modify the reference counts of any
|
||||
of the values passed in the \fIkeyv\fR argument. Note however that this
|
||||
function may set the interpreter result; if that is the only place that is
|
||||
holding a reference to an object, it will be deleted.
|
||||
.SH EXAMPLE
|
||||
Using the dictionary iteration interface to search determine if there
|
||||
is a key that maps to itself:
|
||||
|
||||
@@ -58,6 +58,18 @@ and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR.
|
||||
The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent
|
||||
calls to \fBTcl_GetDoubleFromObj\fR more efficient.
|
||||
'\" TODO: add discussion of treatment of NaN value
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewDoubleObj\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_SetDoubleObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument, but does require that the object be unshared.
|
||||
.PP
|
||||
\fBTcl_GetDoubleFromObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument; it only reads. Note however that this function
|
||||
may set the interpreter result; if that is the only place that
|
||||
is holding a reference to the object, it will be deleted.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -556,5 +556,16 @@ been loaded, it attempts to load an encoding file called \fIname\fB.enc\fR
|
||||
from the \fBencoding\fR subdirectory of each directory that Tcl searches
|
||||
for its script library. If the encoding file exists, but is
|
||||
malformed, an error message will be left in \fIinterp\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_GetEncodingFromObj\fR does not modify the reference count of its
|
||||
\fIobjPtr\fR argument; it only reads. Note however that this function may set
|
||||
the interpreter result; if that is the only place that is holding a reference
|
||||
to the object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_GetEncodingSearchPath\fR returns an object with a reference count of at
|
||||
least 1.
|
||||
.SH "SEE ALSO"
|
||||
encoding(n)
|
||||
.SH KEYWORDS
|
||||
utf, encoding, convert
|
||||
|
||||
@@ -209,6 +209,27 @@ namespace whose list of exported commands is used if both the mapping
|
||||
dictionary and the subcommand list properties are NULL. May be read
|
||||
using \fBTcl_GetEnsembleNamespace\fR which returns a Tcl result code
|
||||
(\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an ensemble).
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_FindEnsemble\fR does not modify the reference count of its
|
||||
\fIcmdNameObj\fR argument; it only reads. Note however that this function may
|
||||
set the interpreter result; if that is the only place that is holding a
|
||||
reference to the object, it will be deleted.
|
||||
.PP
|
||||
The ensemble property getters (\fBTcl_GetEnsembleMappingDict\fR,
|
||||
\fBTcl_GetEnsembleParameterList\fR, \fBTcl_GetEnsembleSubcommandList\fR, and
|
||||
\fBTcl_GetEnsembleUnknownHandler\fR) do not manipulate the reference count of
|
||||
the values they provide out; if those are non-NULL, they will have a reference
|
||||
count of at least 1. Note that these functions may set the interpreter
|
||||
result.
|
||||
.PP
|
||||
The ensemble property setters (\fBTcl_SetEnsembleMappingDict\fR,
|
||||
\fBTcl_SetEnsembleParameterList\fR, \fBTcl_SetEnsembleSubcommandList\fR, and
|
||||
\fBTcl_SetEnsembleUnknownHandler\fR) will increment the reference count of the
|
||||
new value of the property they are given if they succeed (and decrement the
|
||||
reference count of the old value of the property, if relevant). If the
|
||||
property setters return \fBTCL_ERROR\fR, the reference count of the Tcl_Obj
|
||||
argument is left unchanged.
|
||||
.SH "SEE ALSO"
|
||||
namespace(n), Tcl_DeleteCommandFromToken(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+15
-1
@@ -65,7 +65,7 @@ null terminating character. If \-1, then all characters up to the
|
||||
first null byte are used.
|
||||
.AP "const char" *script in
|
||||
Points to first byte of script to execute (null-terminated and UTF-8).
|
||||
.AP char *part in
|
||||
.AP "const char" *part in
|
||||
String forming part of a Tcl script.
|
||||
.AP va_list argList in
|
||||
An argument list which must have been initialized using
|
||||
@@ -207,6 +207,20 @@ the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was
|
||||
invoked in an inappropriate place.
|
||||
This means that top-level applications should never see a return code
|
||||
from \fBTcl_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_EvalObjEx\fR and \fBTcl_GlobalEvalObj\fR both increment and
|
||||
decrement the reference count of their \fIobjPtr\fR argument; you must
|
||||
not pass them any value with a reference count of zero. They also
|
||||
manipulate the interpreter result; you must not count on the
|
||||
interpreter result to hold the reference count of any value over
|
||||
these calls.
|
||||
.PP
|
||||
\fBTcl_EvalObjv\fR may increment and decrement the reference count of
|
||||
any value passed via its \fIobjv\fR argument; you must not pass any
|
||||
value with a reference count of zero. This function also manipulates
|
||||
the interpreter result; you must not count on the interpreter result
|
||||
to hold the reference count of any value over this call.
|
||||
|
||||
.SH KEYWORDS
|
||||
execute, file, global, result, script, value
|
||||
|
||||
@@ -98,6 +98,15 @@ containing the expression's value at \fI*resultPtrPtr\fR.
|
||||
In this case, the caller is responsible for calling
|
||||
\fBTcl_DecrRefCount\fR to decrement the value's reference count
|
||||
when it is finished with the value.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR,
|
||||
\fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprObj\fR all increment and
|
||||
decrement the reference count of their \fIobjPtr\fR arguments; you
|
||||
must not pass them any value with a reference count of zero. They also
|
||||
manipulate the interpreter result; you must not count on the
|
||||
interpreter result to hold the reference count of any value over these
|
||||
calls.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString, Tcl_GetObjResult
|
||||
|
||||
+161
-3
@@ -45,7 +45,7 @@ int
|
||||
\fBTcl_FSDeleteFile\fR(\fIpathPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_FSRemoveDirectory\fR(\fIpathPtr, int recursive, errorPtr\fR)
|
||||
\fBTcl_FSRemoveDirectory\fR(\fIpathPtr, recursive, errorPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_FSRenameFile\fR(\fIsrcPathPtr, destPathPtr\fR)
|
||||
@@ -79,10 +79,10 @@ int
|
||||
\fBTcl_FSUtime\fR(\fIpathPtr, tval\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_FSFileAttrsGet\fR(\fIinterp, int index, pathPtr, objPtrRef\fR)
|
||||
\fBTcl_FSFileAttrsGet\fR(\fIinterp, index, pathPtr, objPtrRef\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_FSFileAttrsSet\fR(\fIinterp, int index, pathPtr, Tcl_Obj *objPtr\fR)
|
||||
\fBTcl_FSFileAttrsSet\fR(\fIinterp, index, pathPtr, objPtr\fR)
|
||||
.sp
|
||||
const char *const *
|
||||
\fBTcl_FSFileAttrStrings\fR(\fIpathPtr, objPtrRef\fR)
|
||||
@@ -197,6 +197,8 @@ rename operation.
|
||||
.AP Tcl_Obj *destPathPtr in
|
||||
As for \fIpathPtr\fR, but used for the destination filename for a copy or
|
||||
rename operation.
|
||||
.AP int recursive in
|
||||
Whether to remove subdirectories and their contents as well.
|
||||
.AP "const char" *encodingName in
|
||||
The encoding of the data stored in the
|
||||
file identified by \fIpathPtr\fR and to be evaluated.
|
||||
@@ -224,6 +226,10 @@ be joined together. If negative, then all elements are joined.
|
||||
.AP Tcl_Obj **errorPtr out
|
||||
In the case of an error, filled with a value containing the name of
|
||||
the file which caused an error in the various copy/rename operations.
|
||||
.AP int index in
|
||||
The index of the attribute in question.
|
||||
.AP Tcl_Obj *objPtr in
|
||||
The value to set in the operation.
|
||||
.AP Tcl_Obj **objPtrRef out
|
||||
Filled with a value containing the result of the operation.
|
||||
.AP Tcl_Obj *resultPtr out
|
||||
@@ -1628,6 +1634,158 @@ typedef int \fBTcl_FSChdirProc\fR(
|
||||
The \fBTcl_FSChdirProc\fR changes the applications current working
|
||||
directory to the value specified in \fIpathPtr\fR. The function returns
|
||||
-1 on error or 0 on success.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.SS "PUBLIC API CALLS"
|
||||
.PP
|
||||
For all of these functions, \fIpathPtr\fR (including the \fIsrcPathPtr\fR and
|
||||
\fIdestPathPtr\fR arguments to \fBTcl_FSCopyFile\fR,
|
||||
\fBTcl_FSCopyDirectory\fR, and \fBTcl_FSRenameFile\fR, the \fIfirstPtr\fR and
|
||||
\fIsecondPtr\fR arguments to \fBTcl_FSEqualPaths\fR, and the \fIlinkNamePtr\fR
|
||||
and \fItoPtr\fR arguments to \fBTcl_FSLink\fR) must not be a zero reference
|
||||
count value; references may be retained in internal caches even for
|
||||
theoretically read-only operations. These functions may also manipulate the
|
||||
interpreter result (if they take and are given a non-NULL \fIinterp\fR
|
||||
argument); you must not count on the interpreter result to hold the reference
|
||||
count of any argument value over these calls and should manage your own
|
||||
references there. However, references held by the arguments to a Tcl command
|
||||
\fIare\fR suitable for reference count management purposes for the duration of
|
||||
the implementation of that command.
|
||||
.PP
|
||||
The \fIerrorPtr\fR argument to \fBTcl_FSCopyDirectory\fR and
|
||||
\fBTcl_FSRemoveDirectory\fR is, when an object is set into it at all, set to
|
||||
an object with a non-zero reference count that should be passed to
|
||||
\fBTcl_DecrRefCount\fR when no longer needed.
|
||||
.PP
|
||||
\fBTcl_FSListVolumes\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_FSLink\fR always returns a non-zero-reference object when it is
|
||||
asked to read; you must call \fBTcl_DecrRefCount\fR on the object
|
||||
once you no longer need it.
|
||||
.PP
|
||||
\fBTcl_FSGetCwd\fR always returns a non-zero-reference object; you
|
||||
must call \fBTcl_DecrRefCount\fR on the object once you no longer need
|
||||
it.
|
||||
.PP
|
||||
\fBTcl_FSPathSeparator\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_FSJoinPath\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR. Its \fIlistObj\fR argument can have any reference
|
||||
count; it is only read by this function.
|
||||
.PP
|
||||
\fBTcl_FSSplitPath\fR always returns a zero-reference object, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_FSGetNormalizedPath\fR returns an object with a non-zero
|
||||
reference count where Tcl is the owner. You should increment its
|
||||
reference count if you want to retain it, but do not need to if you
|
||||
are just using the value immediately.
|
||||
.PP
|
||||
\fBTcl_FSJoinToPath\fR always returns a zero-reference object, much like
|
||||
\fBTcl_NewObj\fR. Its \fIbasePtr\fR argument follows the rules above for
|
||||
\fIpathPtr\fR, as do the values in the \fIobjv\fR argument.
|
||||
.PP
|
||||
\fBTcl_FSGetTranslatedPath\fR returns a non-zero-reference object (or
|
||||
NULL in the error case); you must call \fBTcl_DecrRefCount\fR on the
|
||||
object once you no longer need it.
|
||||
.PP
|
||||
\fBTcl_FSNewNativePath\fR always returns a zero-reference object (or
|
||||
NULL), much like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_FSFileSystemInfo\fR always returns a zero-reference object (or
|
||||
NULL), much like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
The \fIobjPtr\fR and \fIobjPtrRef\fR arguments to \fBTcl_FSFileAttrsGet\fR,
|
||||
\fBTcl_FSFileAttrsSet\fR and \fBTcl_FSFileAttrStrings\fR are conventional Tcl
|
||||
values; the \fIobjPtr\fR argument will be read but not retained, and the
|
||||
\fIobjPtrRef\fR argument will have (on success) a zero-reference value written
|
||||
into it (as with \fBTcl_NewObj\fR). \fBTcl_FSFileAttrsGet\fR and
|
||||
\fBTcl_FSFileAttrsSet\fR may also manipulate the interpreter result.
|
||||
.PP
|
||||
The \fIresultPtr\fR argument to \fBTcl_FSMatchInDirectory\fR will not have its
|
||||
reference count manipulated, but it should have a reference count of no more
|
||||
than 1, and should not be the current interpreter result (as the function may
|
||||
overwrite that on error).
|
||||
.SS "VIRTUAL FILESYSTEM INTERFACE"
|
||||
.PP
|
||||
For all virtual filesystem implementation functions, any \fIpathPtr\fR
|
||||
arguments should not have their reference counts manipulated. If they take an
|
||||
\fIinterp\fR argument, they may set an error message in that, but must not
|
||||
manipulate the \fIpathPtr\fR afterwards. Aside from that:
|
||||
.TP
|
||||
\fIinternalToNormalizedProc\fR
|
||||
.
|
||||
This should return a zero-reference count value, as if allocated with
|
||||
\fBTcl_NewObj\fR.
|
||||
.TP
|
||||
\fInormalizePathProc\fR
|
||||
.
|
||||
Unlike with other API implementation functions, the \fIpathPtr\fR argument
|
||||
here is guaranteed to be an unshared object that should be updated. Its
|
||||
reference count should not be modified.
|
||||
.TP
|
||||
\fIfilesystemPathTypeProc\fR
|
||||
.
|
||||
The return value (if non-NULL) either has a reference count of zero or needs
|
||||
to be maintained (on a per-thread basis) by the filesystem. Tcl will increment
|
||||
the reference count of the value if it wishes to retain it.
|
||||
.TP
|
||||
\fIfilesystemSeparatorProc\fR
|
||||
.
|
||||
The return value should be a value with reference count of zero.
|
||||
.TP
|
||||
\fImatchInDirectoryProc\fR
|
||||
.
|
||||
The \fIresultPtr\fR argument should be assumed to hold a list that can be
|
||||
appended to (i.e., that has a reference count no greater than 1). No reference
|
||||
to it should be retained.
|
||||
.TP
|
||||
\fIlinkProc\fR
|
||||
.
|
||||
If \fItoPtr\fR is NULL, this should return a value with reference count 1 that
|
||||
has just been allocated and passed to \fBTcl_IncrRefCount\fR. If \fItoPtr\fR
|
||||
is not NULL, it should be returned on success.
|
||||
.TP
|
||||
\fIlistVolumesProc\fR
|
||||
.
|
||||
The result value should be a list (if non-NULL); it will have its reference
|
||||
count decremented once (with \fBTcl_DecrRefCount\fR) by Tcl once done.
|
||||
.TP
|
||||
\fIfileAttrStringsProc\fR
|
||||
.
|
||||
If the result is NULL, the \fIobjPtrRef\fR should have a list value written to
|
||||
it; that list will have its reference count both incremented (with
|
||||
\fBTcl_IncrRefCount\fR) and decremented (with \fBTcl_DecrRefCount\fR).
|
||||
.TP
|
||||
\fIfileAttrsGetProc\fR
|
||||
.
|
||||
The \fIobjPtrRef\fR argument should have (on non-error return) a zero
|
||||
reference count value written to it (allocated as if with \fBTcl_NewObj\fR).
|
||||
.TP
|
||||
\fIfileAttrsSetProc\fR
|
||||
.
|
||||
The \fIobjPtr\fR argument should either just be read or its reference count
|
||||
incremented to retain it.
|
||||
.TP
|
||||
\fIremoveDirectoryProc\fR
|
||||
.
|
||||
If an error is being reported, the problem filename reported via
|
||||
\fIerrorPtr\fR should be newly allocated (as if with \fBTcl_NewObj\fR) and
|
||||
have a reference count of 1 (i.e., have been passed to
|
||||
\fBTcl_IncrRefCount\fR).
|
||||
.TP
|
||||
\fIcopyDirectoryProc\fR
|
||||
.
|
||||
If an error is being reported, the problem filename reported via
|
||||
\fIerrorPtr\fR should be newly allocated (as if with \fBTcl_NewObj\fR) and
|
||||
have a reference count of 1 (i.e., have been passed to
|
||||
\fBTcl_IncrRefCount\fR).
|
||||
.TP
|
||||
\fIgetCwdProc\fR
|
||||
.
|
||||
The result will be passed to \fBTcl_DecrRefCount\fR by the implementation of
|
||||
\fBTcl_FSGetCwd\fR after it has been normalized.
|
||||
.SH "SEE ALSO"
|
||||
cd(n), file(n), filename(n), load(n), open(n), pwd(n), source(n), unload(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+3
-3
@@ -17,7 +17,7 @@ char *
|
||||
\fBTcl_GetCwd\fR(\fIinterp\fR, \fIbufferPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_Chdir\fR(\fIpath\fR)
|
||||
\fBTcl_Chdir\fR(\fIdirName\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_DString *bufferPtr in/out
|
||||
.AP Tcl_Interp *interp in
|
||||
@@ -27,7 +27,7 @@ This dynamic string is used to store the current working directory.
|
||||
At the time of the call it should be uninitialized or free. The
|
||||
caller must eventually call \fBTcl_DStringFree\fR to free up
|
||||
anything stored here.
|
||||
.AP char *path in
|
||||
.AP "const char" *dirName in
|
||||
File path in UTF\-8 format.
|
||||
.BE
|
||||
|
||||
@@ -45,7 +45,7 @@ must call \fBTcl_DStringFree()\fR when the result is no longer needed.
|
||||
The format of the path is UTF\-8.
|
||||
.PP
|
||||
\fBTcl_Chdir\fR changes the applications current working directory to
|
||||
the value specified in \fIpath\fR. The format of the passed in string
|
||||
the value specified in \fIdirName\fR. The format of the passed in string
|
||||
must be UTF\-8. The function returns -1 on error or 0 on success.
|
||||
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -105,6 +105,12 @@ array of characters at \fItablePtr\fR+\fIoffset\fR bytes, etc.)
|
||||
This is particularly useful when processing things like
|
||||
\fBTk_ConfigurationSpec\fR, whose string keys are in the same place in
|
||||
each of several array elements.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_GetIndexFromObj\fR and \fBTcl_GetIndexFromObjStruct\fR do not modify
|
||||
the reference count of their \fIobjPtr\fR arguments; they only read. Note
|
||||
however that these functions may set the interpreter result; if that is the
|
||||
only place that is holding a reference to the object, it will be deleted.
|
||||
.SH "SEE ALSO"
|
||||
prefix(n), Tcl_WrongNumArgs(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+14
@@ -330,5 +330,19 @@ typedef void \fBTcl_FreeHashEntryProc\fR(
|
||||
If this is NULL then \fBTcl_Free\fR is used to free the space for the entry.
|
||||
Tcl_Obj* keys use this function to decrement the reference count on the
|
||||
value.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
When a hash table is created with \fBTcl_InitCustomHashTable\fR, the
|
||||
\fBTcl_CreateHashEntry\fR function will increment the reference count of its
|
||||
\fIkey\fR argument when it creates a key (but not if there is an existing
|
||||
matching key). The reference count of the key will be decremented when the
|
||||
corresponding hash entry is deleted, whether with \fBTcl_DeleteHashEntry\fR or
|
||||
with \fBTcl_DeleteHashTable\fR. The \fBTcl_GetHashKey\fR function will return
|
||||
the key without further modifying its reference count.
|
||||
.PP
|
||||
Custom hash tables that use a Tcl_Obj* as key will generally need to do
|
||||
something similar in their \fIallocEntryProc\fR.
|
||||
.SH "SEE ALSO"
|
||||
Dict(3)
|
||||
.SH KEYWORDS
|
||||
hash table, key, lookup, search, value
|
||||
|
||||
+13
-1
@@ -2,7 +2,7 @@
|
||||
'\" Copyright (c) 1998-2000 Scriptics Corporation.
|
||||
'\" All rights reserved.
|
||||
'\"
|
||||
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
|
||||
.TH Tcl_Init 3 8.7 Tcl "Tcl Library Procedures"
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
@@ -13,10 +13,15 @@ Tcl_Init \- find and source initialization script
|
||||
.sp
|
||||
int
|
||||
\fBTcl_Init\fR(\fIinterp\fR)
|
||||
.sp
|
||||
const char *
|
||||
\fBTcl_SetPreInitScript\fR(\fIscriptPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_Interp *interp
|
||||
.AP Tcl_Interp *interp in
|
||||
Interpreter to initialize.
|
||||
.AP "const char" *scriptPtr in
|
||||
Address of the initialization script.
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
@@ -26,6 +31,13 @@ Interpreter to initialize.
|
||||
path.
|
||||
.PP
|
||||
\fBTcl_Init\fR is typically called from \fBTcl_AppInit\fR procedures.
|
||||
.PP
|
||||
\fBTcl_SetPreInitScript\fR registers the pre-initialization script and
|
||||
returns the former (now replaced) script pointer.
|
||||
A value of \fINULL\fR may be passed to not register any script.
|
||||
The pre-initialization script is executed by \fBTcl_Init\fR before accessing
|
||||
the file system. The purpose is to typically prepare a custom file system
|
||||
(like an embedded zip-file) to be activated before the search.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
Tcl_AppInit, Tcl_Main
|
||||
|
||||
@@ -160,6 +160,27 @@ If anything later in the caller requires
|
||||
The \fBTcl_InitBignumFromDouble\fR routine is a utility procedure
|
||||
that extracts the integer part of \fIdoubleValue\fR and stores that
|
||||
integer value in the \fBmp_int\fR value \fIbigValue\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, and
|
||||
\fBTcl_NewBignumObj\fR always return a zero-reference object, much like
|
||||
\fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, and
|
||||
\fBTcl_SetBignumObj\fR do not modify the reference count of their \fIobjPtr\fR
|
||||
arguments, but do require that the object be unshared.
|
||||
.PP
|
||||
\fBTcl_GetIntFromObj\fR, \fBTcl_GetIntForIndex\fR, \fBTcl_GetLongFromObj\fR,
|
||||
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
|
||||
\fBTcl_TakeBignumFromObj\fR do not modify the reference count of their
|
||||
\fIobjPtr\fR arguments; they only read. Note however that this function may
|
||||
set the interpreter result; if that is the only place that is holding a
|
||||
reference to the object, it will be deleted. Also note that if
|
||||
\fBTcl_TakeBignumFromObj\fR is given an unshared value, the value of that
|
||||
object may be modified; it is intended to be used when the value is
|
||||
.QW consumed
|
||||
by the operation at this point.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -246,6 +246,31 @@ with a NULL \fIobjvPtr\fR:
|
||||
result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
|
||||
0, NULL);
|
||||
.CE
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewListObj\fR always returns a zero-reference object, much like
|
||||
\fBTcl_NewObj\fR. If a non-NULL \fIobjv\fR argument is given, the reference
|
||||
counts of the first \fIobjc\fR values in that array are incremented.
|
||||
.PP
|
||||
\fBTcl_SetListObj\fR does not modify the reference count of its \fIobjPtr\fR
|
||||
argument, but does require that the object be unshared. The reference counts
|
||||
of the first \fIobjc\fR values in the \fIobjv\fR array are incremented.
|
||||
.PP
|
||||
\fBTcl_ListObjGetElements\fR, \fBTcl_ListObjIndex\fR, and
|
||||
\fBTcl_ListObjLength\fR do not modify the reference count of their
|
||||
\fIlistPtr\fR arguments; they only read. Note however that these three
|
||||
functions may set the interpreter result; if that is the only place that is
|
||||
holding a reference to the object, it will be deleted.
|
||||
.PP
|
||||
\fBTcl_ListObjAppendList\fR, \fBTcl_ListObjAppendElement\fR, and
|
||||
\fBTcl_ListObjReplace\fR require an unshared \fIlistPtr\fR argument.
|
||||
\fBTcl_ListObjAppendList\fR only reads its \fIelemListPtr\fR argument.
|
||||
\fBTcl_ListObjAppendElement\fR increments the reference count of its
|
||||
\fIobjPtr\fR on success. \fBTcl_ListObjReplace\fR increments the reference
|
||||
count of the first \fIobjc\fR values in the \fIobjv\fR array on success. Note
|
||||
however that all these three functions may set the interpreter result on
|
||||
failure; if that is the only place that is holding a reference to the object,
|
||||
it will be deleted.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -60,6 +60,10 @@ be unloaded with \fBTcl_FSUnloadFile\fR.
|
||||
the symbol cannot be found, it returns NULL and sets an error message in the
|
||||
given \fIinterp\fR (if that is non-NULL). Note that it is unsafe to use this
|
||||
operation on a handle that has been passed to \fBTcl_FSUnloadFile\fR.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The reference count of the \fIpathPtr\fR argument to \fBTcl_LoadFile\fR may be
|
||||
incremented. As such, it should not be given a zero reference count value.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_FSLoadFile(3), Tcl_FSUnloadFile(3), load(n), unload(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+25
-1
@@ -258,8 +258,32 @@ also return TCL_ERROR; it should return TCL_OK otherwise.
|
||||
The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the
|
||||
method being copied from, and the \fInewClientDataPtr\fR field will point to
|
||||
a variable in which to write the value for the method being copied to.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fInameObj\fR argument to \fBTcl_NewMethod\fR and
|
||||
\fBTcl_NewInstanceMethod\fR (when non-NULL) will have its reference count
|
||||
incremented if there is no existing method with that name in that
|
||||
class/object.
|
||||
.PP
|
||||
The result of \fBTcl_MethodName\fR is a value with a reference count of at
|
||||
least one. It should not be modified without first duplicating it (with
|
||||
\fBTcl_DuplicateObj\fR).
|
||||
.PP
|
||||
The values in the first \fIobjc\fR values of the \fIobjv\fR argument to
|
||||
\fBTcl_ObjectContextInvokeNext\fR are assumed to have a reference count of at
|
||||
least 1; the containing array is assumed to endure until the next method
|
||||
implementation (see \fBnext\fR) returns. Be aware that methods may
|
||||
\fByield\fR; if any post-call actions are desired (e.g., decrementing the
|
||||
reference count of values passed in here), they must be scheduled with
|
||||
\fBTcl_NRAddCallback\fR.
|
||||
.PP
|
||||
The \fIcallProc\fR of the \fBTcl_MethodType\fR structure takes values of at
|
||||
least reference count 1 in its \fIobjv\fR argument. It may add its own
|
||||
references, but must not decrement the reference count below that level; the
|
||||
caller of the method will decrement the reference count once the method
|
||||
returns properly (and the reference will be held if the method \fByield\fRs).
|
||||
.SH "SEE ALSO"
|
||||
Class(3), oo::class(n), oo::define(n), oo::object(n)
|
||||
Class(3), NRE(3), oo::class(n), oo::define(n), oo::object(n)
|
||||
.SH KEYWORDS
|
||||
constructor, method, object
|
||||
|
||||
|
||||
@@ -40,7 +40,7 @@ void
|
||||
.AS Tcl_CmdDeleteProc *interp in
|
||||
.AP Tcl_Interp *interp in
|
||||
The relevant Interpreter.
|
||||
.AP char *cmdName in
|
||||
.AP "const char" *cmdName in
|
||||
Name of the command to create.
|
||||
.AP Tcl_ObjCmdProc *proc in
|
||||
Called in order to evaluate a command. Is often just a small wrapper that uses
|
||||
@@ -227,6 +227,25 @@ int
|
||||
Any function comprising a routine can push other functions, making it possible
|
||||
implement looping and sequencing constructs using the function stack.
|
||||
.PP
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The first \fIobjc\fR values in the \fIobjv\fR array passed to the functions
|
||||
\fBTcl_NRCallObjProc\fR, \fBTcl_NREvalObjv\fR, and \fBTcl_NRCmdSwap\fR should
|
||||
have a reference count of at least 1; they may have additional references
|
||||
taken during the execution.
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_NREvalObj\fR and \fBTcl_NRExprObj\fR
|
||||
should have a reference count of at least 1, and may have additional
|
||||
references taken to it during execution.
|
||||
.PP
|
||||
The \fIresultObj\fR argument to \fBTcl_NRExprObj\fR should be an unshared
|
||||
object.
|
||||
.PP
|
||||
Use \fBTcl_NRAddCallback\fR to schedule any required final decrementing of the
|
||||
reference counts of arguments to any of the other functions on this page, as
|
||||
with any other post-processing step in the non-recursive execution engine.
|
||||
.PP
|
||||
The
|
||||
.SH "SEE ALSO"
|
||||
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+14
-2
@@ -46,10 +46,10 @@ Tcl_Command
|
||||
\fBTcl_FindCommand\fR(\fIinterp, name, contextNsPtr, flags\fR)
|
||||
.sp
|
||||
Tcl_Obj *
|
||||
\fBTcl_GetNamespaceUnknownHandler(\fIinterp, nsPtr\fR)
|
||||
\fBTcl_GetNamespaceUnknownHandler\fR(\fIinterp, nsPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_SetNamespaceUnknownHandler(\fIinterp, nsPtr, handlerPtr\fR)
|
||||
\fBTcl_SetNamespaceUnknownHandler\fR(\fIinterp, nsPtr, handlerPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_NamespaceDeleteProc allowOverwrite in/out
|
||||
.AP Tcl_Interp *interp in/out
|
||||
@@ -159,6 +159,18 @@ for the namespace, or NULL if none is set.
|
||||
\fBTcl_SetNamespaceUnknownHandler\fR sets the unknown command handler for
|
||||
the namespace. If \fIhandlerPtr\fR is NULL, then the handler is reset to
|
||||
its default.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_AppendExportList\fR should be an
|
||||
unshared object, as it will be modified by this function. The
|
||||
reference count of \fIobjPtr\fR will not be altered.
|
||||
.PP
|
||||
\fBTcl_GetNamespaceUnknownHandler\fR returns a possibly shared value.
|
||||
Its reference count should be incremented if the value is to be
|
||||
retained.
|
||||
.PP
|
||||
The \fIhandlerPtr\fR argument to \fBTcl_SetNamespaceUnknownHandler\fR
|
||||
will have its reference count incremented if it is a non-empty list.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_CreateCommand(3), Tcl_ListObjAppendList(3), Tcl_SetVar(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+6
-1
@@ -283,7 +283,12 @@ to reduce storage requirements.
|
||||
Reference counting is used to determine when a value is
|
||||
no longer needed and can safely be freed.
|
||||
A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
|
||||
has \fIrefCount\fR 0.
|
||||
has \fIrefCount\fR 0, meaning that the object can often be given to a function
|
||||
like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
|
||||
\fBTcl_DictObjPut\fR (as a value) without explicit reference management, all
|
||||
of which are common use cases. (The latter two require that the the target
|
||||
list or dictionary be well-formed, but that is often easy to arrange when the
|
||||
value is being initially constructed.)
|
||||
The macro \fBTcl_IncrRefCount\fR increments the reference count
|
||||
when a new reference to the value is created.
|
||||
The macro \fBTcl_DecrRefCount\fR decrements the count
|
||||
|
||||
@@ -248,6 +248,28 @@ The \fIfreeIntRepProc\fR implementation must not access the
|
||||
uses of that field during value deletion. The defined tasks for
|
||||
the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR
|
||||
member.
|
||||
.PP
|
||||
Note that if a subsidiary value has its reference count reduced to zero
|
||||
during the running of a \fIfreeIntRepProc\fR, that value may be not freed
|
||||
immediately, in order to limit stack usage. However, the value will be freed
|
||||
before the outermost current \fBTcl_DecrRefCount\fR returns.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
|
||||
value; this function will not modify the reference count of that value, but
|
||||
will modify its contents. If \fIobjPtr\fR is not (interpretable as) a list,
|
||||
this function will set the interpreter result and produce an error; using an
|
||||
unshared empty value is strongly recommended.
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_ConvertToType\fR can have any non-zero
|
||||
reference count; this function will not modify the reference count, but may
|
||||
write to the interpreter result on error so values that originate from there
|
||||
should have an additional reference made before calling this.
|
||||
.PP
|
||||
None of the callback functions in the \fBTcl_ObjType\fR structure should
|
||||
modify the reference count of their arguments, but if the values contain
|
||||
subsidiary values (e.g., the elements of a list or the keys of a dictionary)
|
||||
then those subsidiary values may have their reference counts modified.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -641,6 +641,24 @@ the channel was created with \fBTcl_OpenFileChannel\fR,
|
||||
\fBTcl_OpenCommandChannel\fR, or \fBTcl_MakeFileChannel\fR. Other
|
||||
channel types may return a different type of handle on Windows
|
||||
platforms.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIreadObjPtr\fR argument to \fBTcl_ReadChars\fR must be an unshared
|
||||
value; it will be modified by this function. Using the interpreter result for
|
||||
this purpose is \fIstrongly\fR not recommended; the preferred pattern is to
|
||||
use a new value from \fBTcl_NewObj\fR to receive the data and only to pass it
|
||||
to \fBTcl_SetObjResult\fR if this function succeeds.
|
||||
.PP
|
||||
The \fIlineObjPtr\fR argument to \fBTcl_GetsObj\fR must be an unshared value;
|
||||
it will be modified by this function. Using the interpreter result for this
|
||||
purpose is \fIstrongly\fR not recommended; the preferred pattern is to use a
|
||||
new value from \fBTcl_NewObj\fR to receive the data and only to pass it to
|
||||
\fBTcl_SetObjResult\fR if this function succeeds.
|
||||
.PP
|
||||
The \fIwriteObjPtr\fR argument to \fBTcl_WriteObj\fR should be a value with
|
||||
any reference count. This function will not modify the reference count. Using
|
||||
the interpreter result without adding an additional reference to it is not
|
||||
recommended.
|
||||
.SH "SEE ALSO"
|
||||
DString(3), fconfigure(n), filename(n), fopen(3), Tcl_CreateChannel(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -189,6 +189,12 @@ will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked
|
||||
to the lifetime of the string representation of the argument value that it
|
||||
came from, and so should be copied if it needs to be retained. The
|
||||
\fIsrcPtr\fR and \fIclientData\fR fields are ignored.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The values in the \fIobjv\fR argument to \fBTcl_ParseArgsObjv\fR will not have
|
||||
their reference counts modified by this function. The interpreter result may
|
||||
be modified on error; the values passed should not be the interpreter result
|
||||
with no further reference added.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_GetIndexFromObj(3), Tcl_Main(3), Tcl_CreateObjCommand(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -191,6 +191,7 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
|
||||
some other integer value originating in an extension.
|
||||
In addition, a result value or error message is left in \fIinterp\fR's
|
||||
result; it can be retrieved using \fBTcl_GetObjResult\fR.
|
||||
.SS "DEPRECATED FUNCTIONS"
|
||||
.PP
|
||||
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
|
||||
the return convention used: it returns the result in a new Tcl_Obj.
|
||||
@@ -463,5 +464,12 @@ There are additional fields in the Tcl_Parse structure after the
|
||||
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
|
||||
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be
|
||||
referenced by code outside of these procedures.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The result of \fBTcl_EvalTokens\fR is an unshared value with a reference count
|
||||
of 1; the caller of that function should call \fBTcl_DecrRefCount\fR on the
|
||||
result value to dispose of it. (The equivalent with
|
||||
\fBTcl_EvalTokenStandard\fR is just the interpreter result, which can be
|
||||
retrieved with \fBTcl_GetObjResult\fR.)
|
||||
.SH KEYWORDS
|
||||
backslash substitution, braces, command, expression, parse, token, variable substitution
|
||||
|
||||
@@ -91,6 +91,10 @@ functions.
|
||||
\fBTcl_PkgRequireProc\fR is the form of \fBpackage require\fR handling
|
||||
multiple requirements. The other forms are present for backward
|
||||
compatibility and translate their invocations to this form.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The requirements values given (in the \fIobjv\fR argument) to
|
||||
\fBTcl_PkgRequireProc\fR must have non-zero reference counts.
|
||||
.SH KEYWORDS
|
||||
package, present, provide, require, version
|
||||
.SH "SEE ALSO"
|
||||
|
||||
@@ -44,6 +44,12 @@ allow the user to re-issue recently invoked commands.
|
||||
If the \fIflags\fR argument contains the \fBTCL_NO_EVAL\fR bit then
|
||||
the command is recorded without being evaluated.
|
||||
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The reference count of the \fIcmdPtr\fR argument to \fBTcl_RecordAndEvalObj\fR
|
||||
must be at least 1. This function will modify the interpreter result; do not
|
||||
use an existing result as \fIcmdPtr\fR directly without incrementing its
|
||||
reference count.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_EvalObjEx, Tcl_GetObjResult
|
||||
|
||||
|
||||
+18
-2
@@ -51,14 +51,14 @@ can be efficiently searched.
|
||||
.AP Tcl_Obj *patObj in/out
|
||||
Refers to the value from which to get a regular expression. The
|
||||
compiled regular expression is cached in the value.
|
||||
.AP char *text in
|
||||
.AP "const char" *text in
|
||||
Text to search for a match with a regular expression.
|
||||
.AP "const char" *pattern in
|
||||
String in the form of a regular expression pattern.
|
||||
.AP Tcl_RegExp regexp in
|
||||
Compiled regular expression. Must have been returned previously
|
||||
by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
|
||||
.AP char *start in
|
||||
.AP "const char" *start in
|
||||
If \fItext\fR is just a portion of some other string, this argument
|
||||
identifies the beginning of the larger string.
|
||||
If it is not the same as \fItext\fR, then no
|
||||
@@ -377,6 +377,22 @@ If no match was found, then it indicates the earliest point at which a
|
||||
match might occur if additional text is appended to the string. If it
|
||||
is no match is possible even with further text, this field will be set
|
||||
to \-1.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fItextObj\fR and \fIpatObj\fR arguments to \fBTcl_RegExpMatchObj\fR must
|
||||
have reference counts of at least 1. Note however that this function may set
|
||||
the interpreter result; neither argument should be the direct interpreter
|
||||
result without an additional reference being taken.
|
||||
.PP
|
||||
The \fIpatObj\fR argument to \fBTcl_GetRegExpFromObj\fR must have a reference
|
||||
count of at least 1. Note however that this function may set the interpreter
|
||||
result; the argument should not be the direct interpreter result without an
|
||||
additional reference being taken.
|
||||
.PP
|
||||
The \fItextObj\fR argument to \fBTcl_RegExpExecObj\fR must have a reference
|
||||
count of at least 1. Note however that this function may set the interpreter
|
||||
result; the argument should not be the direct interpreter result without an
|
||||
additional reference being taken.
|
||||
.SH "SEE ALSO"
|
||||
re_syntax(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+12
-3
@@ -35,20 +35,20 @@ Refers to the Tcl interpreter whose bypass area is accessed.
|
||||
.AP Tcl_Obj* msg in
|
||||
Error message put into a bypass area. A list of return options and values,
|
||||
followed by a string message. Both message and the option/value information
|
||||
are optional.
|
||||
are optional. This \fImust\fR be a well-formed list.
|
||||
.AP Tcl_Obj** msgPtr out
|
||||
Reference to a place where the message stored in the accessed bypass area can
|
||||
be stored in.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The current definition of a Tcl channel driver does not permit the direct
|
||||
The standard definition of a Tcl channel driver does not permit the direct
|
||||
return of arbitrary error messages, except for the setting and retrieval of
|
||||
channel options. All other functions are restricted to POSIX error codes.
|
||||
.PP
|
||||
The functions described here overcome this limitation. Channel drivers are
|
||||
allowed to use \fBTcl_SetChannelError\fR and \fBTcl_SetChannelErrorInterp\fR
|
||||
to place arbitrary error messages in \fBbypass areas\fR defined for channels
|
||||
to place arbitrary error messages in \fIbypass areas\fR defined for channels
|
||||
and interpreters. And the generic I/O layer uses \fBTcl_GetChannelError\fR and
|
||||
\fBTcl_GetChannelErrorInterp\fR to look for messages in the bypass areas and
|
||||
arrange for their return as errors. The POSIX error codes set by a driver are
|
||||
@@ -134,6 +134,15 @@ leave all their error information in the interpreter result.
|
||||
.ta 1.9i 4i
|
||||
\fBTcl_Close\fR \fBTcl_UnstackChannel\fR \fBTcl_UnregisterChannel\fR
|
||||
.DE
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fImsg\fR argument to \fBTcl_SetChannelError\fR and
|
||||
\fBTcl_SetChannelErrorInterp\fR, if not NULL, may have any reference count;
|
||||
these functions will copy.
|
||||
.PP
|
||||
\fBTcl_GetChannelError\fR and \fBTcl_GetChannelErrorInterp\fR write a value
|
||||
reference into their \fImsgPtr\fR, but do not manipulate its reference count.
|
||||
The reference count will be at least 1 (unless the reference is NULL).
|
||||
.SH "SEE ALSO"
|
||||
Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -239,6 +239,33 @@ typedef void \fBTcl_FreeProc\fR(
|
||||
.PP
|
||||
When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
|
||||
the value of \fIresult\fR passed to \fBTcl_SetResult\fR.
|
||||
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The interpreter result is one of the main places that owns references to
|
||||
values, along with the bytecode execution stack, argument lists, variables,
|
||||
and the list and dictionary collection values.
|
||||
.PP
|
||||
\fBTcl_SetObjResult\fR takes a value with an arbitrary reference count
|
||||
\fI(specifically including zero)\fR and guarantees to increment the reference
|
||||
count. If code wishes to continue using the value after setting it as the
|
||||
result, it should add its own reference to it with \fBTcl_IncrRefCount\fR.
|
||||
.PP
|
||||
\fBTcl_GetObjResult\fR returns the current interpreter result value. This will
|
||||
have a reference count of at least 1. If the caller wishes to keep the
|
||||
interpreter result value, it should increment its reference count.
|
||||
.PP
|
||||
\fBTcl_GetStringResult\fR does not manipulate reference counts, but the string
|
||||
it returns is owned by (and has a lifetime controlled by) the current
|
||||
interpreter result value; it should be copied instead of being relied upon to
|
||||
persist after the next Tcl API call, as most Tcl operations can modify the
|
||||
interpreter result.
|
||||
.PP
|
||||
\fBTcl_SetResult\fR, \fBTcl_AppendResult\fR, \fBTcl_AppendResultVA\fR,
|
||||
\fBTcl_AppendElement\fR, and \fBTcl_ResetResult\fR all modify the interpreter
|
||||
result. They may cause the old interpreter result to have its reference count
|
||||
decremented and a new interpreter result to be allocated. After they have been
|
||||
called, the reference count of the interpreter result is guaranteed to be 1.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp,
|
||||
Tcl_GetReturnOptions
|
||||
|
||||
@@ -242,6 +242,27 @@ but the array remains.
|
||||
If an array name is specified without an index, then the entire
|
||||
array is removed.
|
||||
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The result of \fBTcl_SetVar2Ex\fR, \fBTcl_ObjSetVar2\fR, \fBTcl_GetVar2Ex\fR,
|
||||
and \fBTcl_ObjGetVar2\fR is (if non-NULL) a value with a reference of at least
|
||||
1, where that reference is held by the variable that the function has just
|
||||
operated upon.
|
||||
.PP
|
||||
The \fInewValuePtr\fR argument to \fBTcl_SetVar2Ex\fR and \fBTcl_ObjSetVar2\fR
|
||||
may be an arbitrary reference count value; its reference count will be
|
||||
incremented on success. However, it is recommended to not use a zero reference
|
||||
count value, as that makes correct handling of the error case tricky.
|
||||
.PP
|
||||
The \fIpart1\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR can
|
||||
have any reference count; these functions never modify it. It is recommended
|
||||
to not use a zero reference count for this argument.
|
||||
.PP
|
||||
The \fIpart2\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR, if
|
||||
non-NULL, should not have a zero reference count as these functions may
|
||||
retain a reference to it (particularly when it is used to create an array
|
||||
element that did not previously exist).
|
||||
|
||||
.SH "SEE ALSO"
|
||||
Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar
|
||||
|
||||
|
||||
+1
-1
@@ -36,7 +36,7 @@ int
|
||||
.AP Tcl_Interp *interp out
|
||||
Interpreter to use for error reporting. If NULL, then no error message
|
||||
is left.
|
||||
.AP char *list in
|
||||
.AP "const char" *list in
|
||||
Pointer to a string with proper list structure.
|
||||
.AP int *argcPtr out
|
||||
Filled in with number of elements in \fIlist\fR.
|
||||
|
||||
@@ -383,6 +383,33 @@ white space, then that value is ignored entirely. This white-space
|
||||
removal was added to make the output of the \fBconcat\fR command
|
||||
cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
|
||||
newly-created value whose ref count is zero.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_NewStringObj\fR, \fBTcl_NewUnicodeObj\fR, \fBTcl_Format\fR,
|
||||
\fBTcl_ObjPrintf\fR, and \fBTcl_ConcatObj\fR always return a zero-reference
|
||||
object, much like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
\fBTcl_GetStringFromObj\fR, \fBTcl_GetString\fR, \fBTcl_GetUnicodeFromObj\fR,
|
||||
\fBTcl_GetUnicode\fR, \fBTcl_GetUniChar\fR, \fBTcl_GetCharLength\fR, and
|
||||
\fBTcl_GetRange\fR all only work with an existing value; they do not
|
||||
manipulate its reference count in any way.
|
||||
.PP
|
||||
\fBTcl_SetStringObj\fR, \fBTcl_SetUnicodeObj\fR, \fBTcl_AppendToObj\fR,
|
||||
\fBTcl_AppendUnicodeToObj\fR, \fBTcl_AppendObjToObj\fR,
|
||||
\fBTcl_AppendStringsToObj\fR, \fBTcl_AppendStringsToObjVA\fR,
|
||||
\fBTcl_AppendLimitedToObj\fR, \fBTcl_AppendFormatToObj\fR,
|
||||
\fBTcl_AppendPrintfToObj\fR, \fBTcl_SetObjLength\fR, and
|
||||
\fBTcl_AttemptSetObjLength\fR and require their \fIobjPtr\fR to be an unshared
|
||||
value (i.e, a reference count no more than 1) as they will modify it.
|
||||
.PP
|
||||
Additional arguments to the above functions (the \fIappendObjPtr\fR argument
|
||||
to \fBTcl_AppendObjToObj\fR, values in the \fIobjv\fR argument to
|
||||
\fBTcl_Format\fR, \fBTcl_AppendFormatToObj\fR, and \fBTcl_ConcatObj\fR) can
|
||||
have any reference count, but reference counts of zero are not recommended.
|
||||
.PP
|
||||
\fBTcl_Format\fR and \fBTcl_AppendFormatToObj\fR may modify the interpreter
|
||||
result, which involves changing the reference count of a value.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -62,6 +62,13 @@ result of the whole substitution on \fIobjPtr\fR will be truncated at
|
||||
the point immediately before the start of the command substitution,
|
||||
and no characters will be added to the result or substitutions
|
||||
performed after that point.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIobjPtr\fR argument to \fBTcl_SubstObj\fR must not have a reference
|
||||
count of zero. This function modifies the interpreter result, both on success
|
||||
and on failure; the result of this function on success is exactly the current
|
||||
interpreter result. Successful results should have their reference count
|
||||
incremented if they are to be retained.
|
||||
.SH "SEE ALSO"
|
||||
subst(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
@@ -262,6 +262,31 @@ file named by the \fBfilename\fR field was modified. Suitable for use with
|
||||
.
|
||||
The type of the uncompressed data (either \fBbinary\fR or \fBtext\fR) if
|
||||
known.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_ZlibDeflate\fR and \fBTcl_ZlibInflate\fR take a value with arbitrary
|
||||
reference count for their \fIdataObj\fR and \fIdictObj\fR arguments (the
|
||||
latter often being NULL instead), and set the interpreter result with their
|
||||
output value (or an error). The existing interpreter result should not be
|
||||
passed as any argument value unless an additional reference is held.
|
||||
.PP
|
||||
\fBTcl_ZlibStreamInit\fR takes a value with arbitrary reference count for its
|
||||
\fIdictObj\fR argument; it only reads from it. The existing interpreter result
|
||||
should not be passed unless an additional reference is held.
|
||||
.PP
|
||||
\fBTcl_ZlibStreamGetCommandName\fR returns a zero reference count value, much
|
||||
like \fBTcl_NewObj\fR.
|
||||
.PP
|
||||
The \fIdataObj\fR argument to \fBTcl_ZlibStreamPut\fR is a value with
|
||||
arbitrary reference count; it is only ever read from.
|
||||
.PP
|
||||
The \fIdataObj\fR argument to \fBTcl_ZlibStreamGet\fR is an unshared value
|
||||
(see \fBTcl_IsShared\fR) that will be updated by the function.
|
||||
.PP
|
||||
The \fIcompDict\fR argument to \fBTcl_ZlibStreamSetCompressionDictionary\fR,
|
||||
if non-NULL, may be duplicated or may have its reference count incremented.
|
||||
Using a zero reference count value is not recommended.
|
||||
|
||||
.SH "PORTABILITY NOTES"
|
||||
These functions will fail gracefully if Tcl is not linked with the zlib
|
||||
library.
|
||||
|
||||
@@ -201,6 +201,15 @@ procedure (if any) returns, \fBTcl_Main\fR will also evaluate
|
||||
the \fBexit\fR command.
|
||||
.PP
|
||||
\fBTcl_Main\fR can not be used in stub-enabled extensions.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
\fBTcl_SetStartupScript\fR takes a value (or NULL) for its \fIpath\fR
|
||||
argument, and will increment the reference count of it.
|
||||
.PP
|
||||
\fBTcl_GetStartupScript\fR returns a value with reference count at least 1, or
|
||||
NULL. It's \fIencodingPtr\fR is also used (if non-NULL) to return a value with
|
||||
a reference count at least 1, or NULL. In both cases, the owner of the values
|
||||
is the current thread.
|
||||
.SH "SEE ALSO"
|
||||
tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3),
|
||||
exit(n), encoding(n)
|
||||
|
||||
@@ -359,6 +359,14 @@ Traces on a variable are always removed whenever the variable
|
||||
is deleted; the only time \fBTCL_TRACE_DESTROYED\fR is not set is for
|
||||
a whole-array trace invoked when only a single element of an
|
||||
array is unset.
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
When a \fIproc\fR callback is invoked, and that callback was installed with
|
||||
the \fBTCL_TRACE_RESULT_OBJECT\fR flag, the result of the callback is a
|
||||
Tcl_Obj reference when there is an error. The result will have its reference
|
||||
count decremented once when no longer needed, or may have additional
|
||||
references made to it (e.g., by setting it as the interpreter result with
|
||||
\fBTcl_SetObjResult\fR).
|
||||
.SH BUGS
|
||||
.PP
|
||||
Array traces are not yet integrated with the Tcl \fBinfo exists\fR command,
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters
|
||||
Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsUnicode, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -44,6 +44,9 @@ int
|
||||
\fBTcl_UniCharIsUpper\fR(\fIch\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_UniCharIsUnicode\fR(\fIch\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_UniCharIsWordChar\fR(\fIch\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS int ch
|
||||
@@ -81,6 +84,9 @@ with the various routines.
|
||||
.PP
|
||||
\fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode character.
|
||||
.PP
|
||||
\fBTcl_UniCharIsUnicode\fR tests if the character is a Unicode character, not being
|
||||
a surrogate or noncharacter.
|
||||
.PP
|
||||
\fBTcl_UniCharIsWordChar\fR tests if the character is alphanumeric or
|
||||
a connector punctuation mark.
|
||||
|
||||
|
||||
@@ -73,6 +73,12 @@ is now an \fIindexObject\fR because it was passed to
|
||||
.CS
|
||||
wrong # args: should be "foo barfly fileName count"
|
||||
.CE
|
||||
.SH "REFERENCE COUNT MANAGEMENT"
|
||||
.PP
|
||||
The \fIobjv\fR argument to \fBTcl_WrongNumArgs\fR should be the exact
|
||||
arguments passed to the command or method implementation function that is
|
||||
calling \fBTcl_WrongNumArgs\fR. As such, all values referenced in it should
|
||||
have reference counts greater than zero; this is usually a non-issue.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_GetIndexFromObj(3)
|
||||
.SH KEYWORDS
|
||||
|
||||
+2
-2
@@ -823,7 +823,7 @@ the minus sign one west of Greenwich.
|
||||
A time zone string conforming to the Posix specification of the \fBTZ\fR
|
||||
environment variable will be recognized. The specification
|
||||
may be found at
|
||||
\fIhttp://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html\fR.
|
||||
\fIhttps://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html\fR.
|
||||
.PP
|
||||
If the Posix time zone string contains a DST (Daylight Savings Time)
|
||||
part, but doesn't contain a rule stating when DST starts or ends,
|
||||
@@ -847,7 +847,7 @@ to use it as a location name, as above.
|
||||
.SH "LOCALIZATION"
|
||||
.PP
|
||||
Developers wishing to localize the date and time formatting and parsing
|
||||
are referred to \fIhttp://tip.tcl.tk/173\fR for a
|
||||
are referred to \fIhttps://tip.tcl-lang.org/173\fR for a
|
||||
specification.
|
||||
.SH "FREE FORM SCAN"
|
||||
.PP
|
||||
|
||||
+2
-2
@@ -182,7 +182,7 @@ set cookiedb ~/.tclcookies.db
|
||||
http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]
|
||||
|
||||
# No further explicit steps are required to use cookies
|
||||
set tok [http::geturl http://core.tcl.tk/]
|
||||
set tok [http::geturl http://core.tcl-lang.org/]
|
||||
.CE
|
||||
.PP
|
||||
To only allow a particular domain to use cookies, perhaps because you only
|
||||
@@ -205,7 +205,7 @@ set cookiedb ~/.tclcookies.db
|
||||
http::configure -cookiejar [MyCookieJar new $cookiedb]
|
||||
|
||||
# No further explicit steps are required to use cookies
|
||||
set tok [http::geturl http://core.tcl.tk/]
|
||||
set tok [http::geturl http://core.tcl-lang.org/]
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
http(n), oo::class(n), sqlite3(n)
|
||||
|
||||
@@ -172,7 +172,7 @@ particularly important website:
|
||||
.PP
|
||||
.CS
|
||||
package require dde
|
||||
\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl.tk/
|
||||
\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl-lang.org/
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
tk(n), winfo(n), send(n)
|
||||
|
||||
+2
-18
@@ -81,29 +81,13 @@ omitted then the command returns the current system encoding. The
|
||||
system encoding is used whenever Tcl passes strings to system calls.
|
||||
.SH EXAMPLE
|
||||
.PP
|
||||
It is common practice to write script files using a text editor that
|
||||
produces output in the euc-jp encoding, which represents the ASCII
|
||||
characters as singe bytes and Japanese characters as two bytes. This
|
||||
makes it easy to embed literal strings that correspond to non-ASCII
|
||||
characters by simply typing the strings in place in the script.
|
||||
However, because the \fBsource\fR command always reads files using the
|
||||
current system encoding, Tcl will only source such files correctly
|
||||
when the encoding used to write the file is the same. This tends not
|
||||
to be true in an internationalized setting. For example, if such a
|
||||
file was sourced in North America (where the ISO8859\-1 is normally
|
||||
used), each byte in the file would be treated as a separate character
|
||||
that maps to the 00 page in Unicode. The resulting Tcl strings will
|
||||
not contain the expected Japanese characters. Instead, they will
|
||||
contain a sequence of Latin-1 characters that correspond to the bytes
|
||||
of the original string. The \fBencoding\fR command can be used to
|
||||
convert this string to the expected Japanese Unicode characters. For
|
||||
example,
|
||||
The following example converts a byte sequence in Japanese euc-jp encoding to a TCL string:
|
||||
.PP
|
||||
.CS
|
||||
set s [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"]
|
||||
.CE
|
||||
.PP
|
||||
would return the Unicode string
|
||||
The result is the unicode codepoint:
|
||||
.QW "\eu306F" ,
|
||||
which is the Hiragana letter HA.
|
||||
.SH "SEE ALSO"
|
||||
|
||||
+2
-2
@@ -6,14 +6,14 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH "http" n 2.9 http "Tcl Bundled Packages"
|
||||
.TH "http" n 2.10 http "Tcl Bundled Packages"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.SH SYNOPSIS
|
||||
\fBpackage require http\fI ?\fB2.9\fR?
|
||||
\fBpackage require http\fI ?\fB2.10\fR?
|
||||
.\" See Also -useragent option documentation in body!
|
||||
.sp
|
||||
\fB::http::config\fR ?\fI\-option value\fR ...?
|
||||
|
||||
+4
-4
@@ -413,10 +413,10 @@ store the representation is of very low value (except to C extension
|
||||
code, which has direct access for the purpose of memory management,
|
||||
etc.)
|
||||
.PP
|
||||
\fICompatibility note:\fR it is likely that this subcommand will be
|
||||
withdrawn in a future version of Tcl. It is better to use the
|
||||
\fBencoding convertto\fR command to convert a string to a known
|
||||
encoding and then apply \fBstring length\fR to that.
|
||||
\fICompatibility note:\fR This subcommand is deprecated and will
|
||||
be removed in Tcl 9.0. It is better to use the \fBencoding convertto\fR
|
||||
command to convert a string to a known encoding (e.g. "utf-8" or "cesu-8")
|
||||
and then apply \fBstring length\fR to that.
|
||||
.PP
|
||||
.CS
|
||||
\fBstring length\fR [encoding convertto utf-8 $theString]
|
||||
|
||||
@@ -298,9 +298,9 @@ environment variables:
|
||||
.SH "SEE ALSO"
|
||||
package(n), Tcl Improvement Proposal #189
|
||||
.QW "\fITcl Modules\fR"
|
||||
(online at http://tip.tcl.tk/189.html), Tcl Improvement Proposal #190
|
||||
(online at https://tip.tcl-lang.org/189.html), Tcl Improvement Proposal #190
|
||||
.QW "\fIImplementation Choices for Tcl Modules\fR"
|
||||
(online at http://tip.tcl.tk/190.html)
|
||||
(online at https://tip.tcl-lang.org/190.html)
|
||||
.SH "KEYWORDS"
|
||||
modules, package
|
||||
.\" Local Variables:
|
||||
|
||||
@@ -2423,6 +2423,9 @@ declare 655 {
|
||||
declare 656 {
|
||||
const char *Tcl_UtfPrev(const char *src, const char *start)
|
||||
}
|
||||
declare 657 {
|
||||
int Tcl_UniCharIsUnicode(int ch)
|
||||
}
|
||||
|
||||
# ----- BASELINE -- FOR -- 8.7.0 ----- #
|
||||
|
||||
|
||||
+5
-4
@@ -50,10 +50,10 @@ extern "C" {
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 7
|
||||
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 4
|
||||
#define TCL_RELEASE_SERIAL 6
|
||||
|
||||
#define TCL_VERSION "8.7"
|
||||
#define TCL_PATCH_LEVEL "8.7a4"
|
||||
#define TCL_PATCH_LEVEL "8.7a6"
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
|
||||
/*
|
||||
@@ -2136,7 +2136,7 @@ typedef struct Tcl_EncodingType {
|
||||
#if TCL_UTF_MAX > 3
|
||||
/*
|
||||
* int isn't 100% accurate as it should be a strict 4-byte value
|
||||
* (perhaps wchar_t). ILP64/SILP64 systems may have troubles. The
|
||||
* (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
|
||||
* size of this value must be reflected correctly in regcustom.h.
|
||||
*/
|
||||
typedef int Tcl_UniChar;
|
||||
@@ -2385,6 +2385,7 @@ EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
|
||||
const char *version, int exact);
|
||||
EXTERN void Tcl_InitSubsystems(void);
|
||||
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
EXTERN const char * Tcl_SetPreInitScript(const char *string);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define Tcl_StaticPackage Tcl_StaticLibrary
|
||||
#endif
|
||||
@@ -2478,7 +2479,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
|
||||
++(objPtr)->refCount
|
||||
/*
|
||||
* Use do/while0 idiom for optimum correctness without compiler warnings.
|
||||
* http://c2.com/cgi/wiki?TrivialDoWhileLoop
|
||||
* https://wiki.c2.com/?TrivialDoWhileLoop
|
||||
*/
|
||||
# undef Tcl_DecrRefCount
|
||||
# define Tcl_DecrRefCount(objPtr) \
|
||||
|
||||
+32
-11
@@ -1826,28 +1826,28 @@ DeleteInterpProc(
|
||||
ckfree(hTablePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Invoke deletion callbacks; note that a callback can create new
|
||||
* callbacks, so we iterate.
|
||||
*/
|
||||
|
||||
while (iPtr->assocData != NULL) {
|
||||
if (iPtr->assocData != NULL) {
|
||||
AssocData *dPtr;
|
||||
|
||||
hTablePtr = iPtr->assocData;
|
||||
iPtr->assocData = NULL;
|
||||
/*
|
||||
* Invoke deletion callbacks; note that a callback can create new
|
||||
* callbacks, so we iterate.
|
||||
*/
|
||||
for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
|
||||
hPtr != NULL;
|
||||
hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
|
||||
dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
if (dPtr->proc != NULL) {
|
||||
dPtr->proc(dPtr->clientData, interp);
|
||||
}
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
ckfree(dPtr);
|
||||
}
|
||||
Tcl_DeleteHashTable(hTablePtr);
|
||||
ckfree(hTablePtr);
|
||||
iPtr->assocData = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3505,15 +3505,14 @@ Tcl_DeleteCommandFromToken(
|
||||
cmdPtr->flags |= CMD_DYING;
|
||||
|
||||
/*
|
||||
* Call trace functions for the command being deleted. Then delete its
|
||||
* traces.
|
||||
* Call each functions and then delete the trace.
|
||||
*/
|
||||
|
||||
cmdPtr->nsPtr->refCount++;
|
||||
|
||||
if (cmdPtr->tracePtr != NULL) {
|
||||
CommandTrace *tracePtr;
|
||||
/* Note that CallCommandTraces() never frees cmdPtr, that's
|
||||
/* CallCommandTraces() does not cmdPtr, that's
|
||||
* done just before Tcl_DeleteCommandFromToken() returns */
|
||||
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
|
||||
|
||||
@@ -4867,6 +4866,7 @@ NRCommand(
|
||||
int result)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *listPtr;
|
||||
|
||||
iPtr->numLevels--;
|
||||
|
||||
@@ -4875,7 +4875,10 @@ NRCommand(
|
||||
*/
|
||||
|
||||
if (data[1] && (data[1] != INT2PTR(1))) {
|
||||
TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
|
||||
listPtr = (Tcl_Obj *)data[1];
|
||||
data[1] = NULL;
|
||||
|
||||
TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL);
|
||||
}
|
||||
|
||||
/* OPT ??
|
||||
@@ -9450,6 +9453,7 @@ TclNRYieldToObjCmd(
|
||||
|
||||
iPtr->execEnvPtr = corPtr->callerEEPtr;
|
||||
TclSetTailcall(interp, listPtr);
|
||||
corPtr->yieldPtr = listPtr;
|
||||
iPtr->execEnvPtr = corPtr->eePtr;
|
||||
|
||||
return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
|
||||
@@ -9647,6 +9651,22 @@ TclNRCoroutineActivateCallback(
|
||||
*/
|
||||
|
||||
if (corPtr->stackLevel != stackLevel) {
|
||||
NRE_callback *runPtr;
|
||||
|
||||
iPtr->execEnvPtr = corPtr->callerEEPtr;
|
||||
if (corPtr->yieldPtr) {
|
||||
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
|
||||
if (runPtr->data[1] == corPtr->yieldPtr) {
|
||||
runPtr->data[1] = NULL;
|
||||
Tcl_DecrRefCount(corPtr->yieldPtr);
|
||||
corPtr->yieldPtr = NULL;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
iPtr->execEnvPtr = corPtr->eePtr;
|
||||
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"cannot yield: C stack busy", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
|
||||
@@ -9662,6 +9682,7 @@ TclNRCoroutineActivateCallback(
|
||||
Tcl_Panic("Yield received an option which is not implemented");
|
||||
}
|
||||
|
||||
corPtr->yieldPtr = NULL;
|
||||
corPtr->stackLevel = NULL;
|
||||
|
||||
numLevels = iPtr->numLevels;
|
||||
|
||||
+3
-6
@@ -274,19 +274,16 @@ typedef struct ByteArray {
|
||||
* array. */
|
||||
unsigned int allocated; /* The amount of space actually allocated
|
||||
* minus 1 byte. */
|
||||
unsigned char bytes[TCLFLEXARRAY];
|
||||
/* 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;
|
||||
|
||||
#define BYTEARRAY_SIZE(len) \
|
||||
(offsetof(ByteArray, bytes) + (len))
|
||||
(offsetof(ByteArray, bytes) + (len))
|
||||
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
|
||||
#define SET_BYTEARRAY(irPtr, baPtr) \
|
||||
do { \
|
||||
(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr); \
|
||||
} while (0)
|
||||
(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
|
||||
|
||||
int
|
||||
TclIsPureByteArray(
|
||||
|
||||
@@ -613,8 +613,6 @@ EncodingConverttoObjCmd(
|
||||
int length; /* Length of the string being converted */
|
||||
const char *stringPtr; /* Pointer to the first byte of the string */
|
||||
|
||||
/* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */
|
||||
|
||||
if (objc == 2) {
|
||||
encoding = Tcl_GetEncoding(interp, NULL);
|
||||
data = objv[1];
|
||||
|
||||
+7
-9
@@ -86,14 +86,12 @@ typedef struct {
|
||||
* following values.
|
||||
*/
|
||||
|
||||
enum {
|
||||
SORTMODE_ASCII = 0,
|
||||
SORTMODE_INTEGER = 1,
|
||||
SORTMODE_REAL = 2,
|
||||
SORTMODE_COMMAND = 3,
|
||||
SORTMODE_DICTIONARY = 4,
|
||||
SORTMODE_ASCII_NC = 8
|
||||
};
|
||||
#define SORTMODE_ASCII 0
|
||||
#define SORTMODE_INTEGER 1
|
||||
#define SORTMODE_REAL 2
|
||||
#define SORTMODE_COMMAND 3
|
||||
#define SORTMODE_DICTIONARY 4
|
||||
#define SORTMODE_ASCII_NC 8
|
||||
|
||||
/*
|
||||
* Forward declarations for procedures defined in this file:
|
||||
@@ -1243,7 +1241,7 @@ TclInfoFrame(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *tmpObj;
|
||||
Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to
|
||||
Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to
|
||||
* the dict. */
|
||||
int lc = 0;
|
||||
/*
|
||||
|
||||
+15
-8
@@ -1533,16 +1533,16 @@ StringIsCmd(
|
||||
"boolean", "dict", "digit", "double",
|
||||
"entier", "false", "graph", "integer",
|
||||
"list", "lower", "print", "punct",
|
||||
"space", "true", "upper", "wideinteger",
|
||||
"wordchar", "xdigit", NULL
|
||||
"space", "true", "upper", "unicode",
|
||||
"wideinteger", "wordchar", "xdigit", NULL
|
||||
};
|
||||
enum isClassesEnum {
|
||||
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
|
||||
STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE,
|
||||
STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT,
|
||||
STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT,
|
||||
STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE,
|
||||
STR_IS_WORD, STR_IS_XDIGIT
|
||||
STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE,
|
||||
STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT
|
||||
};
|
||||
static const char *const isOptions[] = {
|
||||
"-strict", "-failindex", NULL
|
||||
@@ -1872,6 +1872,9 @@ StringIsCmd(
|
||||
case STR_IS_UPPER:
|
||||
chcomp = Tcl_UniCharIsUpper;
|
||||
break;
|
||||
case STR_IS_UNICODE:
|
||||
chcomp = Tcl_UniCharIsUnicode;
|
||||
break;
|
||||
case STR_IS_WORD:
|
||||
chcomp = Tcl_UniCharIsWordChar;
|
||||
break;
|
||||
@@ -2832,6 +2835,7 @@ StringCatCmd(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED)
|
||||
static int
|
||||
StringBytesCmd(
|
||||
TCL_UNUSED(ClientData),
|
||||
@@ -2850,6 +2854,7 @@ StringBytesCmd(
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -3306,7 +3311,9 @@ TclInitStringCmd(
|
||||
Tcl_Interp *interp) /* Current interpreter. */
|
||||
{
|
||||
static const EnsembleImplMap stringImplMap[] = {
|
||||
#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED)
|
||||
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
#endif
|
||||
{"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
|
||||
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
|
||||
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
|
||||
@@ -5113,15 +5120,15 @@ TryPostHandler(
|
||||
{
|
||||
Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
|
||||
Tcl_Obj *finallyObj;
|
||||
int finally;
|
||||
int finallyIndex;
|
||||
|
||||
objv = (Tcl_Obj **)data[0];
|
||||
options = (Tcl_Obj *)data[1];
|
||||
handlerKindObj = (Tcl_Obj *)data[2];
|
||||
finally = PTR2INT(data[3]);
|
||||
finallyIndex = PTR2INT(data[3]);
|
||||
|
||||
cmdObj = objv[0];
|
||||
finallyObj = finally ? objv[finally] : 0;
|
||||
finallyObj = finallyIndex ? objv[finallyIndex] : 0;
|
||||
|
||||
/*
|
||||
* Check for limits/rewinding, which override normal trapping behaviour.
|
||||
@@ -5165,7 +5172,7 @@ TryPostHandler(
|
||||
|
||||
/* The 'finally' script is always the last argument word. */
|
||||
return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
|
||||
finally);
|
||||
finallyIndex);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+290
-291
File diff suppressed because it is too large
Load Diff
+210
-242
@@ -27,31 +27,6 @@ static void CompileReturnInternal(CompileEnv *envPtr,
|
||||
Tcl_Obj *returnOpts);
|
||||
static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
|
||||
|
||||
/*
|
||||
* Shorthand macros for instruction issuing.
|
||||
*/
|
||||
|
||||
#define OP(name) TclEmitOpcode(INST_##name, envPtr)
|
||||
#define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr)
|
||||
#define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr)
|
||||
#define OP11(name,val1,val2) TclEmitInstInt11(INST_##name,(val1),(val2),envPtr)
|
||||
#define OP14(name,val1,val2) TclEmitInstInt14(INST_##name,(val1),(val2),envPtr)
|
||||
#define OP44(name,val1,val2) TclEmitInstInt44(INST_##name,(val1),(val2),envPtr)
|
||||
#define PUSH(str) PushStringLiteral(envPtr, str)
|
||||
#define JUMP4(name,var) \
|
||||
(var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
|
||||
#define FIXJUMP4(var) \
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
|
||||
#define JUMP1(name,var) \
|
||||
(var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
|
||||
#define FIXJUMP1(var) \
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
|
||||
#define LOAD(idx) \
|
||||
if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
|
||||
#define STORE(idx) \
|
||||
if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
|
||||
#define INVOKE(name) TclEmitInvoke(envPtr,INST_##name)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -137,7 +112,7 @@ TclCompileGlobalCmd(
|
||||
* Push the namespace
|
||||
*/
|
||||
|
||||
PUSH( "::");
|
||||
PushStringLiteral(envPtr, "::");
|
||||
|
||||
/*
|
||||
* Loop over the variables.
|
||||
@@ -158,15 +133,15 @@ TclCompileGlobalCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
OP4( NSUPVAR, localIndex);
|
||||
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Pop the namespace, and set the result to empty
|
||||
*/
|
||||
|
||||
OP( POP);
|
||||
PUSH( "");
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -188,30 +163,6 @@ TclCompileGlobalCmd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
IsElseToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return (tokenPtr->size == 4) &&
|
||||
(strncmp(tokenPtr->start, "else", 4) == 0);
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsElseifToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return (tokenPtr->size == 6) &&
|
||||
(strncmp(tokenPtr->start, "elseif", 6) == 0);
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsThenToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return (tokenPtr->size == 4) &&
|
||||
(strncmp(tokenPtr->start, "then", 4) == 0);
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileIfCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
@@ -230,7 +181,8 @@ TclCompileIfCmd(
|
||||
* determined. */
|
||||
Tcl_Token *tokenPtr, *testTokenPtr;
|
||||
int jumpIndex = 0; /* Avoid compiler warning. */
|
||||
int jumpFalseDist, numWords, wordIdx, j, code;
|
||||
int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
|
||||
const char *word;
|
||||
int realCond = 1; /* Set to 0 for static conditions:
|
||||
* "if 0 {..}" */
|
||||
int boolVal; /* Value of static condition. */
|
||||
@@ -268,7 +220,10 @@ TclCompileIfCmd(
|
||||
* Stop looping if the token isn't "if" or "elseif".
|
||||
*/
|
||||
|
||||
if ((tokenPtr == parsePtr->tokenPtr) || IsElseifToken(&tokenPtr[1])) {
|
||||
word = tokenPtr[1].start;
|
||||
numBytes = tokenPtr[1].size;
|
||||
if ((tokenPtr == parsePtr->tokenPtr)
|
||||
|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
wordIdx++;
|
||||
} else {
|
||||
@@ -331,12 +286,16 @@ TclCompileIfCmd(
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
if (IsThenToken(&tokenPtr[1])) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
wordIdx++;
|
||||
if (wordIdx >= numWords) {
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
word = tokenPtr[1].start;
|
||||
numBytes = tokenPtr[1].size;
|
||||
if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
wordIdx++;
|
||||
if (wordIdx >= numWords) {
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -404,12 +363,14 @@ TclCompileIfCmd(
|
||||
* an "if 1 {...}" case.
|
||||
*/
|
||||
|
||||
if (wordIdx < numWords) {
|
||||
if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
|
||||
/*
|
||||
* There is an else clause. Skip over the optional "else" word.
|
||||
*/
|
||||
|
||||
if (IsElseToken(&tokenPtr[1])) {
|
||||
word = tokenPtr[1].start;
|
||||
numBytes = tokenPtr[1].size;
|
||||
if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
wordIdx++;
|
||||
if (wordIdx >= numWords) {
|
||||
@@ -441,7 +402,7 @@ TclCompileIfCmd(
|
||||
*/
|
||||
|
||||
if (compileScripts) {
|
||||
PUSH("");
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -564,29 +525,31 @@ TclCompileIncrCmd(
|
||||
if (isScalar) { /* Simple scalar variable. */
|
||||
if (localIndex >= 0) {
|
||||
if (haveImmValue) {
|
||||
OP11( INCR_SCALAR1_IMM, localIndex, immValue);
|
||||
TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
|
||||
TclEmitInt1(immValue, envPtr);
|
||||
} else {
|
||||
OP1( INCR_SCALAR1, localIndex);
|
||||
TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (haveImmValue) {
|
||||
OP1( INCR_STK_IMM, immValue);
|
||||
TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
|
||||
} else {
|
||||
OP( INCR_STK);
|
||||
TclEmitOpcode( INST_INCR_STK, envPtr);
|
||||
}
|
||||
}
|
||||
} else { /* Simple array variable. */
|
||||
if (localIndex >= 0) {
|
||||
if (haveImmValue) {
|
||||
OP11( INCR_ARRAY1_IMM, localIndex, immValue);
|
||||
TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
|
||||
TclEmitInt1(immValue, envPtr);
|
||||
} else {
|
||||
OP1( INCR_ARRAY1, localIndex);
|
||||
TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (haveImmValue) {
|
||||
OP1( INCR_ARRAY_STK_IMM, immValue);
|
||||
TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
|
||||
} else {
|
||||
OP( INCR_ARRAY_STK);
|
||||
TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -661,11 +624,11 @@ TclCompileInfoCommandsCmd(
|
||||
|
||||
/* TODO: Just push the known value */
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
OP( RESOLVE_COMMAND);
|
||||
OP( DUP);
|
||||
OP( STR_LEN);
|
||||
OP1( JUMP_FALSE1, 7);
|
||||
OP4( LIST, 1);
|
||||
TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_STR_LEN, envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr);
|
||||
TclEmitInstInt4( INST_LIST, 1, envPtr);
|
||||
return TCL_OK;
|
||||
|
||||
notCompilable:
|
||||
@@ -693,7 +656,7 @@ TclCompileInfoCoroutineCmd(
|
||||
* Not much to do; we compile to a single instruction...
|
||||
*/
|
||||
|
||||
OP( COROUTINE_NAME);
|
||||
TclEmitOpcode( INST_COROUTINE_NAME, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -730,15 +693,15 @@ TclCompileInfoExistsCmd(
|
||||
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
OP( EXIST_STK);
|
||||
TclEmitOpcode( INST_EXIST_STK, envPtr);
|
||||
} else {
|
||||
OP4( EXIST_SCALAR, localIndex);
|
||||
TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (localIndex < 0) {
|
||||
OP( EXIST_ARRAY_STK);
|
||||
TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr);
|
||||
} else {
|
||||
OP4( EXIST_ARRAY, localIndex);
|
||||
TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -762,7 +725,7 @@ TclCompileInfoLevelCmd(
|
||||
* Not much to do; we compile to a single instruction...
|
||||
*/
|
||||
|
||||
OP( INFO_LEVEL_NUM);
|
||||
TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr);
|
||||
} else if (parsePtr->numWords != 2) {
|
||||
return TCL_ERROR;
|
||||
} else {
|
||||
@@ -774,7 +737,7 @@ TclCompileInfoLevelCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
|
||||
OP( INFO_LEVEL_ARGS);
|
||||
TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -794,7 +757,7 @@ TclCompileInfoObjectClassCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
OP( TCLOO_CLASS);
|
||||
TclEmitOpcode( INST_TCLOO_CLASS, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -829,7 +792,7 @@ TclCompileInfoObjectIsACmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
OP( TCLOO_IS_OBJECT);
|
||||
TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -848,7 +811,7 @@ TclCompileInfoObjectNamespaceCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
OP( TCLOO_NS);
|
||||
TclEmitOpcode( INST_TCLOO_NS, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -927,15 +890,15 @@ TclCompileLappendCmd(
|
||||
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
OP( LAPPEND_STK);
|
||||
TclEmitOpcode( INST_LAPPEND_STK, envPtr);
|
||||
} else {
|
||||
Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr);
|
||||
Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (localIndex < 0) {
|
||||
OP( LAPPEND_ARRAY_STK);
|
||||
TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr);
|
||||
} else {
|
||||
Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr);
|
||||
Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -950,18 +913,18 @@ TclCompileLappendCmd(
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i);
|
||||
valueTokenPtr = TokenAfter(valueTokenPtr);
|
||||
}
|
||||
OP4( LIST, numWords - 2);
|
||||
TclEmitInstInt4( INST_LIST, numWords - 2, envPtr);
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
OP( LAPPEND_LIST_STK);
|
||||
TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
|
||||
} else {
|
||||
OP4( LAPPEND_LIST, localIndex);
|
||||
TclEmitInstInt4(INST_LAPPEND_LIST, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (localIndex < 0) {
|
||||
OP( LAPPEND_LIST_ARRAY_STK);
|
||||
TclEmitOpcode( INST_LAPPEND_LIST_ARRAY_STK, envPtr);
|
||||
} else {
|
||||
OP4( LAPPEND_LIST_ARRAY, localIndex);
|
||||
TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr);
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
@@ -1035,27 +998,27 @@ TclCompileLassignCmd(
|
||||
|
||||
if (isScalar) {
|
||||
if (localIndex >= 0) {
|
||||
OP( DUP);
|
||||
OP4( LIST_INDEX_IMM, idx);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
|
||||
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
|
||||
OP( POP);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
} else {
|
||||
OP4( OVER, 1);
|
||||
OP4( LIST_INDEX_IMM, idx);
|
||||
OP( STORE_STK);
|
||||
OP( POP);
|
||||
TclEmitInstInt4(INST_OVER, 1, envPtr);
|
||||
TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
|
||||
TclEmitOpcode( INST_STORE_STK, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (localIndex >= 0) {
|
||||
OP4( OVER, 1);
|
||||
OP4( LIST_INDEX_IMM, idx);
|
||||
TclEmitInstInt4(INST_OVER, 1, envPtr);
|
||||
TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
|
||||
Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
|
||||
OP( POP);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
} else {
|
||||
OP4( OVER, 2);
|
||||
OP4( LIST_INDEX_IMM, idx);
|
||||
OP( STORE_ARRAY_STK);
|
||||
OP( POP);
|
||||
TclEmitInstInt4(INST_OVER, 2, envPtr);
|
||||
TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
|
||||
TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1064,7 +1027,8 @@ TclCompileLassignCmd(
|
||||
* Generate code to leave the rest of the list on the stack.
|
||||
*/
|
||||
|
||||
OP44( LIST_RANGE_IMM, idx, (int) TCL_INDEX_END);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
|
||||
TclEmitInt4( (int)TCL_INDEX_END, envPtr);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1125,7 +1089,7 @@ TclCompileLindexCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valTokenPtr, interp, 1);
|
||||
OP4( LIST_INDEX_IMM, idx);
|
||||
TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1151,9 +1115,9 @@ TclCompileLindexCmd(
|
||||
*/
|
||||
|
||||
if (numWords == 3) {
|
||||
OP( LIST_INDEX);
|
||||
TclEmitOpcode( INST_LIST_INDEX, envPtr);
|
||||
} else {
|
||||
OP4( LIST_INDEX_MULTI, numWords - 1);
|
||||
TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr);
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
@@ -1195,7 +1159,7 @@ TclCompileListCmd(
|
||||
* [list] without arguments just pushes an empty object.
|
||||
*/
|
||||
|
||||
PUSH("");
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1232,9 +1196,9 @@ TclCompileListCmd(
|
||||
concat = build = 0;
|
||||
for (i = 1; i < numWords; i++) {
|
||||
if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
|
||||
OP4( LIST, build);
|
||||
TclEmitInstInt4( INST_LIST, build, envPtr);
|
||||
if (concat) {
|
||||
OP( LIST_CONCAT);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
build = 0;
|
||||
concat = 1;
|
||||
@@ -1242,7 +1206,7 @@ TclCompileListCmd(
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i);
|
||||
if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
|
||||
if (concat) {
|
||||
OP( LIST_CONCAT);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
} else {
|
||||
concat = 1;
|
||||
}
|
||||
@@ -1252,9 +1216,9 @@ TclCompileListCmd(
|
||||
valueTokenPtr = TokenAfter(valueTokenPtr);
|
||||
}
|
||||
if (build > 0) {
|
||||
OP4( LIST, build);
|
||||
TclEmitInstInt4( INST_LIST, build, envPtr);
|
||||
if (concat) {
|
||||
OP( LIST_CONCAT);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1266,7 +1230,8 @@ TclCompileListCmd(
|
||||
*/
|
||||
|
||||
if (concat && numWords == 2) {
|
||||
OP44( LIST_RANGE_IMM, 0, (int) TCL_INDEX_END);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( (int)TCL_INDEX_END, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1306,7 +1271,7 @@ TclCompileLlengthCmd(
|
||||
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
|
||||
CompileWord(envPtr, varTokenPtr, interp, 1);
|
||||
OP( LIST_LENGTH);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1344,8 +1309,8 @@ TclCompileLrangeCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/*
|
||||
* Token was an index value, and we treat all "first" indices before the
|
||||
* list same as the start of the list.
|
||||
* Token was an index value, and we treat all "first" indices
|
||||
* before the list same as the start of the list.
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
@@ -1353,10 +1318,9 @@ TclCompileLrangeCmd(
|
||||
&idx2) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Token was an index value, and we treat all "last" indices after the
|
||||
* list same as the end of the list.
|
||||
* Token was an index value, and we treat all "last" indices
|
||||
* after the list same as the end of the list.
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -1366,7 +1330,8 @@ TclCompileLrangeCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
OP44( LIST_RANGE_IMM, idx1, idx2);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
|
||||
TclEmitInt4( idx2, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1407,11 +1372,11 @@ TclCompileLinsertCmd(
|
||||
tokenPtr = TokenAfter(listTokenPtr);
|
||||
|
||||
/*
|
||||
* NOTE: This command treats all inserts at indices before the list the
|
||||
* same as inserts at the start of the list, and all inserts after the
|
||||
* list the same as inserts at the end of the list. We make that
|
||||
* transformation here so we can use the optimized bytecode as much as
|
||||
* possible.
|
||||
* NOTE: This command treats all inserts at indices before the list
|
||||
* the same as inserts at the start of the list, and all inserts
|
||||
* after the list the same as inserts at the end of the list. We
|
||||
* make that transformation here so we can use the optimized bytecode
|
||||
* as much as possible.
|
||||
*/
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END,
|
||||
&idx) != TCL_OK) {
|
||||
@@ -1427,7 +1392,8 @@ TclCompileLinsertCmd(
|
||||
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
if (parsePtr->numWords == 3) {
|
||||
OP44( LIST_RANGE_IMM, 0, (int) TCL_INDEX_END);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( (int)TCL_INDEX_END, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1435,13 +1401,13 @@ TclCompileLinsertCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
}
|
||||
OP4( LIST, i - 3);
|
||||
TclEmitInstInt4( INST_LIST, i - 3, envPtr);
|
||||
|
||||
if (idx == (int) TCL_INDEX_START) {
|
||||
OP4( REVERSE, 2);
|
||||
OP( LIST_CONCAT);
|
||||
} else if (idx == (int) TCL_INDEX_END) {
|
||||
OP( LIST_CONCAT);
|
||||
if (idx == (int)TCL_INDEX_START) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
} else if (idx == (int)TCL_INDEX_END) {
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
} else {
|
||||
/*
|
||||
* Here we handle two ranges for idx. First when idx > 0, we
|
||||
@@ -1458,12 +1424,14 @@ TclCompileLinsertCmd(
|
||||
if (idx < (int)TCL_INDEX_END) {
|
||||
idx++;
|
||||
}
|
||||
OP4( OVER, 1);
|
||||
OP44( LIST_RANGE_IMM, 0, idx - 1);
|
||||
OP4( REVERSE, 3);
|
||||
OP44( LIST_RANGE_IMM, idx, (int) TCL_INDEX_END);
|
||||
OP( LIST_CONCAT);
|
||||
OP( LIST_CONCAT);
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx - 1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
|
||||
TclEmitInt4( (int)TCL_INDEX_END, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
@@ -1534,17 +1502,13 @@ TclCompileLreplaceCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* All paths start with computing/pushing the original value.
|
||||
*/
|
||||
|
||||
/* All paths start with computing/pushing the original value. */
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
|
||||
/*
|
||||
* Push all the replacement values next so any errors raised in creating
|
||||
* them get raised first.
|
||||
* Push all the replacement values next so any errors raised in
|
||||
* creating them get raised first.
|
||||
*/
|
||||
|
||||
if (parsePtr->numWords > 4) {
|
||||
/* Push the replacement arguments */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
@@ -1554,7 +1518,7 @@ TclCompileLreplaceCmd(
|
||||
}
|
||||
|
||||
/* Make a list of them... */
|
||||
OP4( LIST, i - 4);
|
||||
TclEmitInstInt4( INST_LIST, i - 4, envPtr);
|
||||
|
||||
emptyPrefix = 0;
|
||||
}
|
||||
@@ -1562,42 +1526,45 @@ TclCompileLreplaceCmd(
|
||||
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
|
||||
/*
|
||||
* This is a "no-op". Example: [lreplace {a b c} 2 0]
|
||||
* We still do a list operation to get list-verification and
|
||||
* canonicalization side effects.
|
||||
* We still do a list operation to get list-verification
|
||||
* and canonicalization side effects.
|
||||
*/
|
||||
OP44( LIST_RANGE_IMM, 0, (int) TCL_INDEX_END);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( (int)TCL_INDEX_END, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (idx1 != (int) TCL_INDEX_START) {
|
||||
if (idx1 != (int)TCL_INDEX_START) {
|
||||
/* Prefix may not be empty; generate bytecode to push it */
|
||||
if (emptyPrefix) {
|
||||
OP( DUP);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
} else {
|
||||
OP4( OVER, 1);
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
}
|
||||
OP44( LIST_RANGE_IMM, 0, idx1 - 1);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx1 - 1, envPtr);
|
||||
if (!emptyPrefix) {
|
||||
OP4( REVERSE, 2);
|
||||
OP( LIST_CONCAT);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
emptyPrefix = 0;
|
||||
}
|
||||
|
||||
if (!emptyPrefix) {
|
||||
OP4( REVERSE, 2);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
}
|
||||
|
||||
if (suffixStart == (int) TCL_INDEX_NONE) {
|
||||
OP( POP);
|
||||
if (suffixStart == (int)TCL_INDEX_NONE) {
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
if (emptyPrefix) {
|
||||
PUSH( "");
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
} else {
|
||||
/* Suffix may not be empty; generate bytecode to push it */
|
||||
OP44( LIST_RANGE_IMM, suffixStart, (int) TCL_INDEX_END);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, suffixStart, envPtr);
|
||||
TclEmitInt4( (int)TCL_INDEX_END, envPtr);
|
||||
if (!emptyPrefix) {
|
||||
OP( LIST_CONCAT);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1705,7 +1672,7 @@ TclCompileLsetCmd(
|
||||
} else {
|
||||
tempDepth = parsePtr->numWords - 1;
|
||||
}
|
||||
OP4( OVER, tempDepth);
|
||||
TclEmitInstInt4( INST_OVER, tempDepth, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1718,7 +1685,7 @@ TclCompileLsetCmd(
|
||||
} else {
|
||||
tempDepth = parsePtr->numWords - 2;
|
||||
}
|
||||
OP4( OVER, tempDepth);
|
||||
TclEmitInstInt4( INST_OVER, tempDepth, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1727,13 +1694,13 @@ TclCompileLsetCmd(
|
||||
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
OP( LOAD_STK);
|
||||
TclEmitOpcode( INST_LOAD_STK, envPtr);
|
||||
} else {
|
||||
LOAD( localIndex);
|
||||
Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (localIndex < 0) {
|
||||
OP( LOAD_ARRAY_STK);
|
||||
TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr);
|
||||
} else {
|
||||
Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr);
|
||||
}
|
||||
@@ -1744,9 +1711,9 @@ TclCompileLsetCmd(
|
||||
*/
|
||||
|
||||
if (parsePtr->numWords == 4) {
|
||||
OP( LSET_LIST);
|
||||
TclEmitOpcode( INST_LSET_LIST, envPtr);
|
||||
} else {
|
||||
OP4( LSET_FLAT, parsePtr->numWords - 1);
|
||||
TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1755,13 +1722,13 @@ TclCompileLsetCmd(
|
||||
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
OP( STORE_STK);
|
||||
TclEmitOpcode( INST_STORE_STK, envPtr);
|
||||
} else {
|
||||
STORE( localIndex);
|
||||
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
if (localIndex < 0) {
|
||||
OP( STORE_ARRAY_STK);
|
||||
TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
|
||||
} else {
|
||||
Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
|
||||
}
|
||||
@@ -1810,7 +1777,7 @@ TclCompileNamespaceCurrentCmd(
|
||||
* Not much to do; we compile to a single instruction...
|
||||
*/
|
||||
|
||||
OP(NS_CURRENT);
|
||||
TclEmitOpcode( INST_NS_CURRENT, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1855,11 +1822,11 @@ TclCompileNamespaceCodeCmd(
|
||||
* the value needs to be determined at runtime for safety.
|
||||
*/
|
||||
|
||||
PUSH( "::namespace");
|
||||
PUSH( "inscope");
|
||||
OP( NS_CURRENT);
|
||||
PushStringLiteral(envPtr, "::namespace");
|
||||
PushStringLiteral(envPtr, "inscope");
|
||||
TclEmitOpcode( INST_NS_CURRENT, envPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
OP4( LIST, 4);
|
||||
TclEmitInstInt4( INST_LIST, 4, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1880,7 +1847,7 @@ TclCompileNamespaceOriginCmd(
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
OP(ORIGIN_COMMAND);
|
||||
TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1901,21 +1868,21 @@ TclCompileNamespaceQualifiersCmd(
|
||||
}
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
PUSH( "0");
|
||||
PUSH( "::");
|
||||
OP4( OVER, 2);
|
||||
OP( STR_FIND_LAST);
|
||||
PushStringLiteral(envPtr, "0");
|
||||
PushStringLiteral(envPtr, "::");
|
||||
TclEmitInstInt4( INST_OVER, 2, envPtr);
|
||||
TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
|
||||
off = CurrentOffset(envPtr);
|
||||
PUSH( "1");
|
||||
OP( SUB);
|
||||
OP4( OVER, 2);
|
||||
OP4( OVER, 1);
|
||||
OP( STR_INDEX);
|
||||
PUSH( ":");
|
||||
OP( STR_EQ);
|
||||
PushStringLiteral(envPtr, "1");
|
||||
TclEmitOpcode( INST_SUB, envPtr);
|
||||
TclEmitInstInt4( INST_OVER, 2, envPtr);
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
TclEmitOpcode( INST_STR_INDEX, envPtr);
|
||||
PushStringLiteral(envPtr, ":");
|
||||
TclEmitOpcode( INST_STR_EQ, envPtr);
|
||||
off = off - CurrentOffset(envPtr);
|
||||
OP1( JUMP_TRUE1, off);
|
||||
OP( STR_RANGE);
|
||||
TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr);
|
||||
TclEmitOpcode( INST_STR_RANGE, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1940,18 +1907,18 @@ TclCompileNamespaceTailCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
PUSH( "::");
|
||||
OP4( OVER, 1);
|
||||
OP( STR_FIND_LAST);
|
||||
OP( DUP);
|
||||
PUSH( "0");
|
||||
OP( GE);
|
||||
PushStringLiteral(envPtr, "::");
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
PushStringLiteral(envPtr, "0");
|
||||
TclEmitOpcode( INST_GE, envPtr);
|
||||
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
|
||||
PUSH( "2");
|
||||
OP( ADD);
|
||||
PushStringLiteral(envPtr, "2");
|
||||
TclEmitOpcode( INST_ADD, envPtr);
|
||||
TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
|
||||
PUSH( "end");
|
||||
OP( STR_RANGE);
|
||||
PushStringLiteral(envPtr, "end");
|
||||
TclEmitOpcode( INST_STR_RANGE, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2003,15 +1970,15 @@ TclCompileNamespaceUpvarCmd(
|
||||
if (localIndex < 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
OP4( NSUPVAR, localIndex);
|
||||
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Pop the namespace, and set the result to empty
|
||||
*/
|
||||
|
||||
OP( POP);
|
||||
PUSH( "");
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2056,7 +2023,7 @@ TclCompileNamespaceWhichCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, idx);
|
||||
OP( RESOLVE_COMMAND);
|
||||
TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2175,7 +2142,7 @@ TclCompileRegexpCmd(
|
||||
* The semantics of regexp are always match on re == "".
|
||||
*/
|
||||
|
||||
PUSH( "1");
|
||||
PushStringLiteral(envPtr, "1");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2205,9 +2172,9 @@ TclCompileRegexpCmd(
|
||||
|
||||
if (simple) {
|
||||
if (exact && !nocase) {
|
||||
OP( STR_EQ);
|
||||
TclEmitOpcode( INST_STR_EQ, envPtr);
|
||||
} else {
|
||||
OP1( STR_MATCH, nocase);
|
||||
TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr);
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
@@ -2218,7 +2185,7 @@ TclCompileRegexpCmd(
|
||||
|
||||
int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
|
||||
|
||||
OP1( REGEXP, cflags);
|
||||
TclEmitInstInt1( INST_REGEXP, cflags, envPtr);
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
@@ -2385,7 +2352,7 @@ TclCompileRegsubCmd(
|
||||
bytes = TclGetStringFromObj(replacementObj, &len);
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2);
|
||||
OP( STR_MAP);
|
||||
TclEmitOpcode( INST_STR_MAP, envPtr);
|
||||
|
||||
done:
|
||||
Tcl_DStringFree(&pattern);
|
||||
@@ -2518,7 +2485,7 @@ TclCompileReturnCmd(
|
||||
* No explict result argument, so default result is empty string.
|
||||
*/
|
||||
|
||||
PUSH( "");
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2552,7 +2519,7 @@ TclCompileReturnCmd(
|
||||
*/
|
||||
|
||||
Tcl_DecrRefCount(returnOpts);
|
||||
OP( DONE);
|
||||
TclEmitOpcode(INST_DONE, envPtr);
|
||||
TclAdjustStackDepth(1, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -2583,7 +2550,7 @@ TclCompileReturnCmd(
|
||||
CompileWord(envPtr, wordTokenPtr, interp, objc);
|
||||
wordTokenPtr = TokenAfter(wordTokenPtr);
|
||||
}
|
||||
OP4( LIST, numOptionWords);
|
||||
TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);
|
||||
|
||||
/*
|
||||
* Push the result.
|
||||
@@ -2592,14 +2559,14 @@ TclCompileReturnCmd(
|
||||
if (explicitResult) {
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
|
||||
} else {
|
||||
PUSH( "");
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
|
||||
/*
|
||||
* Issue the RETURN itself.
|
||||
*/
|
||||
|
||||
INVOKE( RETURN_STK);
|
||||
TclEmitInvoke(envPtr, INST_RETURN_STK);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2629,7 +2596,8 @@ CompileReturnInternal(
|
||||
}
|
||||
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
|
||||
TclEmitInstInt44(op, code, level, envPtr);
|
||||
TclEmitInstInt4(op, code, envPtr);
|
||||
TclEmitInt4(level, envPtr);
|
||||
}
|
||||
|
||||
void
|
||||
@@ -2708,7 +2676,7 @@ TclCompileUpvarCmd(
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
|
||||
if (newTypePtr != typePtr) {
|
||||
if (numWords % 2) {
|
||||
if (numWords%2) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/* TODO: Push the known value instead? */
|
||||
@@ -2716,10 +2684,10 @@ TclCompileUpvarCmd(
|
||||
otherTokenPtr = TokenAfter(tokenPtr);
|
||||
i = 2;
|
||||
} else {
|
||||
if (!(numWords % 2)) {
|
||||
if (!(numWords%2)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
PUSH("1");
|
||||
PushStringLiteral(envPtr, "1");
|
||||
otherTokenPtr = tokenPtr;
|
||||
i = 1;
|
||||
}
|
||||
@@ -2742,15 +2710,15 @@ TclCompileUpvarCmd(
|
||||
if (localIndex < 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
OP4( UPVAR, localIndex);
|
||||
TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Pop the frame index, and set the result to empty
|
||||
*/
|
||||
|
||||
OP( POP);
|
||||
PUSH( "");
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2816,7 +2784,7 @@ TclCompileVariableCmd(
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
OP4( VARIABLE, localIndex);
|
||||
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
|
||||
|
||||
if (i + 1 < numWords) {
|
||||
/*
|
||||
@@ -2824,8 +2792,8 @@ TclCompileVariableCmd(
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i + 1);
|
||||
STORE( localIndex);
|
||||
OP( POP);
|
||||
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2833,7 +2801,7 @@ TclCompileVariableCmd(
|
||||
* Set the result to empty
|
||||
*/
|
||||
|
||||
PUSH( "");
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2965,7 +2933,7 @@ TclCompileObjectNextCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
OP1( TCLOO_NEXT, i);
|
||||
TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2989,7 +2957,7 @@ TclCompileObjectNextToCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
OP1( TCLOO_NEXT_CLASS, i);
|
||||
TclEmitInstInt1( INST_TCLOO_NEXT_CLASS, i, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -3002,9 +2970,9 @@ TclCompileObjectSelfCmd(
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
/*
|
||||
* We only handle [self], [self object] (which is the same operation) and
|
||||
* [self namespace]. These are the only very common operations on [self]
|
||||
* for which bytecoding is at all reasonable.
|
||||
* We only handle [self] and [self object] (which is the same operation).
|
||||
* These are the only very common operations on [self] for which
|
||||
* bytecoding is at all reasonable.
|
||||
*/
|
||||
|
||||
if (parsePtr->numWords == 1) {
|
||||
@@ -3036,7 +3004,7 @@ TclCompileObjectSelfCmd(
|
||||
* This delegates the entire problem to a single opcode.
|
||||
*/
|
||||
|
||||
OP( TCLOO_SELF);
|
||||
TclEmitOpcode( INST_TCLOO_SELF, envPtr);
|
||||
return TCL_OK;
|
||||
|
||||
compileSelfNamespace:
|
||||
@@ -3049,9 +3017,9 @@ TclCompileObjectSelfCmd(
|
||||
* avoids creating another opcode, so that's all good!
|
||||
*/
|
||||
|
||||
OP( TCLOO_SELF);
|
||||
OP( POP);
|
||||
OP( NS_CURRENT);
|
||||
TclEmitOpcode( INST_TCLOO_SELF, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
TclEmitOpcode( INST_NS_CURRENT, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
+236
-291
@@ -81,9 +81,12 @@ const AuxDataType tclJumptableInfoType = {
|
||||
#define OP(name) TclEmitOpcode(INST_##name, envPtr)
|
||||
#define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr)
|
||||
#define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr)
|
||||
#define OP14(name,val1,val2) TclEmitInstInt14(INST_##name,(val1),(val2),envPtr)
|
||||
#define OP44(name,val1,val2) TclEmitInstInt44(INST_##name,(val1),(val2),envPtr)
|
||||
#define PUSH(str) PushStringLiteral(envPtr, str)
|
||||
#define OP14(name,val1,val2) \
|
||||
TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
|
||||
#define OP44(name,val1,val2) \
|
||||
TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
|
||||
#define PUSH(str) \
|
||||
PushStringLiteral(envPtr, str)
|
||||
#define JUMP4(name,var) \
|
||||
(var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
|
||||
#define FIXJUMP4(var) \
|
||||
@@ -96,60 +99,9 @@ const AuxDataType tclJumptableInfoType = {
|
||||
if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
|
||||
#define STORE(idx) \
|
||||
if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
|
||||
#define INVOKE(name) TclEmitInvoke(envPtr,INST_##name)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* IsContinuationBody, IsDefaultToken, IsFinallyToken, IsOnToken,
|
||||
* IsTrapToken --
|
||||
*
|
||||
* Helpers for TclCompileSwitchCmd and TclCompileTryCmd to compare tokens
|
||||
* to key literals.
|
||||
*
|
||||
* Results:
|
||||
* Returns 1 if they're equal, 0 if not.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
#define INVOKE(name) \
|
||||
TclEmitInvoke(envPtr,INST_##name)
|
||||
|
||||
static inline int
|
||||
IsContinuationBody(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return tokenPtr->size == 1 && tokenPtr->start[0] == '-';
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsDefaultToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return tokenPtr->size == 7 && memcmp(tokenPtr->start, "default", 7) == 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsFinallyToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return tokenPtr->size == 7 && memcmp(tokenPtr->start, "finally", 7) == 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsOnToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return tokenPtr->size == 2 && memcmp(tokenPtr->start, "on", 2) == 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsTrapToken(
|
||||
const Tcl_Token *tokenPtr)
|
||||
{
|
||||
return tokenPtr->size == 4 && memcmp(tokenPtr->start, "trap", 4) == 0;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -212,33 +164,33 @@ TclCompileSetCmd(
|
||||
* Emit instructions to set/get the variable.
|
||||
*/
|
||||
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
TclEmitOpcode((isAssignment?
|
||||
INST_STORE_STK : INST_LOAD_STK), envPtr);
|
||||
} else if (localIndex <= 255) {
|
||||
TclEmitInstInt1((isAssignment?
|
||||
INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
|
||||
localIndex, envPtr);
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
TclEmitOpcode((isAssignment?
|
||||
INST_STORE_STK : INST_LOAD_STK), envPtr);
|
||||
} else if (localIndex <= 255) {
|
||||
TclEmitInstInt1((isAssignment?
|
||||
INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
|
||||
localIndex, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4((isAssignment?
|
||||
INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
|
||||
localIndex, envPtr);
|
||||
}
|
||||
} else {
|
||||
TclEmitInstInt4((isAssignment?
|
||||
INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
|
||||
localIndex, envPtr);
|
||||
if (localIndex < 0) {
|
||||
TclEmitOpcode((isAssignment?
|
||||
INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
|
||||
} else if (localIndex <= 255) {
|
||||
TclEmitInstInt1((isAssignment?
|
||||
INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
|
||||
localIndex, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4((isAssignment?
|
||||
INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
|
||||
localIndex, envPtr);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (localIndex < 0) {
|
||||
TclEmitOpcode((isAssignment?
|
||||
INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
|
||||
} else if (localIndex <= 255) {
|
||||
TclEmitInstInt1((isAssignment?
|
||||
INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
|
||||
localIndex, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4((isAssignment?
|
||||
INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
|
||||
localIndex, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -277,15 +229,13 @@ TclCompileStringCatCmd(
|
||||
|
||||
/* Trivial case, no arg */
|
||||
|
||||
if (numWords < 2) {
|
||||
PUSH( "");
|
||||
if (numWords<2) {
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* General case: issue CONCAT1's (by chunks of 254 if needed), folding
|
||||
* contiguous constants along the way.
|
||||
*/
|
||||
/* General case: issue CONCAT1's (by chunks of 254 if needed), folding
|
||||
contiguous constants along the way */
|
||||
|
||||
numArgs = 0;
|
||||
folded = NULL;
|
||||
@@ -313,7 +263,7 @@ TclCompileStringCatCmd(
|
||||
CompileWord(envPtr, wordTokenPtr, interp, i);
|
||||
numArgs ++;
|
||||
if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
|
||||
OP1( STR_CONCAT1, numArgs);
|
||||
TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
|
||||
numArgs = 1; /* concat pushes 1 obj, the result */
|
||||
}
|
||||
}
|
||||
@@ -329,7 +279,7 @@ TclCompileStringCatCmd(
|
||||
numArgs ++;
|
||||
}
|
||||
if (numArgs > 1) {
|
||||
OP1( STR_CONCAT1, numArgs);
|
||||
TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
@@ -362,7 +312,7 @@ TclCompileStringCmpCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
OP( STR_CMP);
|
||||
TclEmitOpcode(INST_STR_CMP, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -393,7 +343,7 @@ TclCompileStringEqualCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
OP( STR_EQ);
|
||||
TclEmitOpcode(INST_STR_EQ, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -424,7 +374,7 @@ TclCompileStringFirstCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
OP( STR_FIND);
|
||||
OP(STR_FIND);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -455,7 +405,7 @@ TclCompileStringLastCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
OP( STR_FIND_LAST);
|
||||
OP(STR_FIND_LAST);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -482,7 +432,7 @@ TclCompileStringIndexCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
OP( STR_INDEX);
|
||||
TclEmitOpcode(INST_STR_INDEX, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -502,28 +452,20 @@ TclCompileStringInsertCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compute and push the string in which to insert.
|
||||
*/
|
||||
|
||||
/* Compute and push the string in which to insert */
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
|
||||
/*
|
||||
* See what can be discovered about index at compile time.
|
||||
*/
|
||||
|
||||
/* See what can be discovered about index at compile time */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (TCL_OK != TclGetIndexFromToken(tokenPtr, TCL_INDEX_START,
|
||||
TCL_INDEX_END, &idx)) {
|
||||
|
||||
/* Nothing useful knowable - cease compile; let it direct eval */
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compute and push the string to be inserted.
|
||||
*/
|
||||
|
||||
/* Compute and push the string to be inserted */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 3);
|
||||
|
||||
@@ -550,17 +492,6 @@ TclCompileStringInsertCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static inline int
|
||||
GotLiteral(
|
||||
const Tcl_Token *tokenPtr,
|
||||
const char *word)
|
||||
{
|
||||
return (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
|
||||
tokenPtr[1].size > 1 &&
|
||||
tokenPtr[1].start[0] == word[0] &&
|
||||
strncmp(tokenPtr[1].start, word, tokenPtr[1].size) == 0);
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileStringIsCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
@@ -574,19 +505,19 @@ TclCompileStringIsCmd(
|
||||
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
static const char *const isClasses[] = {
|
||||
"alnum", "alpha", "ascii", "control",
|
||||
"boolean", "dict", "digit", "double", "entier",
|
||||
"false", "graph", "integer", "list",
|
||||
"lower", "print", "punct", "space",
|
||||
"true", "upper", "wideinteger", "wordchar",
|
||||
"xdigit", NULL
|
||||
"boolean", "dict", "digit", "double",
|
||||
"entier", "false", "graph", "integer",
|
||||
"list", "lower", "print", "punct",
|
||||
"space", "true", "upper", "unicode",
|
||||
"wideinteger", "wordchar", "xdigit", NULL
|
||||
};
|
||||
enum isClassesEnum {
|
||||
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
|
||||
STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
|
||||
STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
|
||||
STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
|
||||
STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
|
||||
STR_IS_XDIGIT
|
||||
STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE,
|
||||
STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT,
|
||||
STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT,
|
||||
STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE,
|
||||
STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT
|
||||
};
|
||||
int t, range, allowEmpty = 0, end;
|
||||
InstStringClassType strClassType;
|
||||
@@ -607,6 +538,12 @@ TclCompileStringIsCmd(
|
||||
}
|
||||
Tcl_DecrRefCount(isClass);
|
||||
|
||||
#define GotLiteral(tokenPtr, word) \
|
||||
((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \
|
||||
(tokenPtr)[1].size > 1 && \
|
||||
(tokenPtr)[1].start[0] == word[0] && \
|
||||
strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
|
||||
|
||||
/*
|
||||
* Cannot handle the -failindex option at all, and that's the only legal
|
||||
* way to have more than 4 arguments.
|
||||
@@ -625,6 +562,7 @@ TclCompileStringIsCmd(
|
||||
}
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
#undef GotLiteral
|
||||
|
||||
/*
|
||||
* Compile the code. There are several main classes of check here.
|
||||
@@ -671,6 +609,9 @@ TclCompileStringIsCmd(
|
||||
case STR_IS_UPPER:
|
||||
strClassType = STR_CLASS_UPPER;
|
||||
goto compileStrClass;
|
||||
case STR_IS_UNICODE:
|
||||
strClassType = STR_CLASS_UNICODE;
|
||||
goto compileStrClass;
|
||||
case STR_IS_WORD:
|
||||
strClassType = STR_CLASS_WORD;
|
||||
goto compileStrClass;
|
||||
@@ -866,7 +807,12 @@ TclCompileStringMatchCmd(
|
||||
*/
|
||||
|
||||
if (parsePtr->numWords == 4) {
|
||||
if (!GotLiteral(tokenPtr, "-nocase")) {
|
||||
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
|
||||
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
|
||||
}
|
||||
str = tokenPtr[1].start;
|
||||
length = tokenPtr[1].size;
|
||||
if ((length <= 1) || strncmp(str, "-nocase", length)) {
|
||||
/*
|
||||
* Fail at run time, not in compilation.
|
||||
*/
|
||||
@@ -900,7 +846,7 @@ TclCompileStringMatchCmd(
|
||||
}
|
||||
PushLiteral(envPtr, str, length);
|
||||
} else {
|
||||
SetLineInformation(i + 1 + nocase);
|
||||
SetLineInformation(i+1+nocase);
|
||||
CompileTokens(envPtr, tokenPtr, interp);
|
||||
}
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
@@ -911,9 +857,9 @@ TclCompileStringMatchCmd(
|
||||
*/
|
||||
|
||||
if (exactMatch) {
|
||||
OP( STR_EQ);
|
||||
TclEmitOpcode(INST_STR_EQ, envPtr);
|
||||
} else {
|
||||
OP1( STR_MATCH, nocase);
|
||||
TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -951,7 +897,7 @@ TclCompileStringLenCmd(
|
||||
} else {
|
||||
SetLineInformation(1);
|
||||
CompileTokens(envPtr, tokenPtr, interp);
|
||||
OP( STR_LEN);
|
||||
TclEmitOpcode(INST_STR_LEN, envPtr);
|
||||
}
|
||||
TclDecrRefCount(objPtr);
|
||||
return TCL_OK;
|
||||
@@ -1050,7 +996,6 @@ TclCompileStringRangeCmd(
|
||||
&idx1) != TCL_OK) {
|
||||
goto nonConstantIndices;
|
||||
}
|
||||
|
||||
/*
|
||||
* Token parsed as an index expression. We treat all indices before
|
||||
* the string the same as the start of the string.
|
||||
@@ -1067,12 +1012,10 @@ TclCompileStringRangeCmd(
|
||||
&idx2) != TCL_OK) {
|
||||
goto nonConstantIndices;
|
||||
}
|
||||
|
||||
/*
|
||||
* Token parsed as an index expression. We treat all indices after
|
||||
* the string the same as the end of the string.
|
||||
*/
|
||||
|
||||
if (idx2 == (int)TCL_INDEX_NONE) {
|
||||
/* [string range $s $first -1] must be empty string */
|
||||
OP( POP);
|
||||
@@ -1121,7 +1064,6 @@ TclCompileStringReplaceCmd(
|
||||
/*
|
||||
* Check for first index known and useful at compile time.
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
|
||||
&first) != TCL_OK) {
|
||||
@@ -1131,7 +1073,6 @@ TclCompileStringReplaceCmd(
|
||||
/*
|
||||
* Check for last index known and useful at compile time.
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
|
||||
&last) != TCL_OK) {
|
||||
@@ -1139,25 +1080,26 @@ TclCompileStringReplaceCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* [string replace] is an odd bird. For many arguments it is a
|
||||
* conventional substring replacer. However it also goes out of its way
|
||||
* to become a no-op for many cases where it would be replacing an empty
|
||||
* substring. Precisely, it is a no-op when
|
||||
* [string replace] is an odd bird. For many arguments it is
|
||||
* a conventional substring replacer. However it also goes out
|
||||
* of its way to become a no-op for many cases where it would be
|
||||
* replacing an empty substring. Precisely, it is a no-op when
|
||||
*
|
||||
* (last < first) OR
|
||||
* (last < 0) OR
|
||||
* (end < first)
|
||||
*
|
||||
* For some compile-time values we can detect these cases, and compile
|
||||
* direct to bytecode implementing the no-op.
|
||||
* For some compile-time values we can detect these cases, and
|
||||
* compile direct to bytecode implementing the no-op.
|
||||
*/
|
||||
|
||||
if ((last == (int)TCL_INDEX_NONE) /* Know (last < 0) */
|
||||
|| (first == (int)TCL_INDEX_NONE) /* Know (first > end) */
|
||||
|
||||
/*
|
||||
* Tricky to determine when runtime (last < first) can be certainly
|
||||
* known based on the encoded values. Consider the cases...
|
||||
* Tricky to determine when runtime (last < first) can be
|
||||
* certainly known based on the encoded values. Consider the
|
||||
* cases...
|
||||
*
|
||||
* (first <= TCL_INDEX_END) &&
|
||||
* (last <= TCL_INDEX END) && (last < first) => ACCEPT
|
||||
@@ -1186,72 +1128,74 @@ TclCompileStringReplaceCmd(
|
||||
}
|
||||
|
||||
if (parsePtr->numWords == 5) {
|
||||
/*
|
||||
* When we have a string replacement, we have to take care about not
|
||||
* replacing empty substrings that [string replace] promises not to
|
||||
* replace.
|
||||
*
|
||||
* The remaining index values might be suitable for conventional
|
||||
* string replacement, but only if they cannot possibly meet the
|
||||
* conditions described above at runtime. If there's a chance they
|
||||
* might, we would have to emit bytecode to check and at that point
|
||||
* we're paying more in bytecode execution time than would make things
|
||||
* worthwhile. Trouble is we are very limited in how much we can
|
||||
* detect that at compile time. After decoding, we need, first:
|
||||
*
|
||||
* (first <= end)
|
||||
*
|
||||
* The encoded indices (first <= TCL_INDEX END) and (first ==
|
||||
* TCL_INDEX_NONE) always meets this condition, but any other encoded
|
||||
* first index has some list for which it fails.
|
||||
*
|
||||
* We also need, second:
|
||||
*
|
||||
* (last >= 0)
|
||||
*
|
||||
* The encoded index (last >= TCL_INDEX_START) always meet this
|
||||
* condition but any other encoded last index has some list for which
|
||||
* it fails.
|
||||
*
|
||||
* Finally we need, third:
|
||||
*
|
||||
* (first <= last)
|
||||
*
|
||||
* Considered in combination with the constraints we already have, we
|
||||
* see that we can proceed when (first == TCL_INDEX_NONE). These also
|
||||
* permit simplification of the prefix|replace|suffix construction.
|
||||
* The other constraints, though, interfere with getting a guarantee
|
||||
* that first <= last.
|
||||
*/
|
||||
/*
|
||||
* When we have a string replacement, we have to take care about
|
||||
* not replacing empty substrings that [string replace] promises
|
||||
* not to replace
|
||||
*
|
||||
* The remaining index values might be suitable for conventional
|
||||
* string replacement, but only if they cannot possibly meet the
|
||||
* conditions described above at runtime. If there's a chance they
|
||||
* might, we would have to emit bytecode to check and at that point
|
||||
* we're paying more in bytecode execution time than would make
|
||||
* things worthwhile. Trouble is we are very limited in
|
||||
* how much we can detect that at compile time. After decoding,
|
||||
* we need, first:
|
||||
*
|
||||
* (first <= end)
|
||||
*
|
||||
* The encoded indices (first <= TCL_INDEX END) and
|
||||
* (first == TCL_INDEX_NONE) always meets this condition, but
|
||||
* any other encoded first index has some list for which it fails.
|
||||
*
|
||||
* We also need, second:
|
||||
*
|
||||
* (last >= 0)
|
||||
*
|
||||
* The encoded index (last >= TCL_INDEX_START) always meet this
|
||||
* condition but any other encoded last index has some list for
|
||||
* which it fails.
|
||||
*
|
||||
* Finally we need, third:
|
||||
*
|
||||
* (first <= last)
|
||||
*
|
||||
* Considered in combination with the constraints we already have,
|
||||
* we see that we can proceed when (first == TCL_INDEX_NONE).
|
||||
* These also permit simplification of the prefix|replace|suffix
|
||||
* construction. The other constraints, though, interfere with
|
||||
* getting a guarantee that first <= last.
|
||||
*/
|
||||
|
||||
if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
|
||||
/* empty prefix */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
OP4( REVERSE, 2);
|
||||
if (last == INT_MAX) {
|
||||
OP( POP); /* Pop original */
|
||||
} else {
|
||||
OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
|
||||
OP44( STR_RANGE_IMM, 0, first-1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
|
||||
/* empty prefix */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
OP4( REVERSE, 2);
|
||||
if (last == INT_MAX) {
|
||||
OP( POP); /* Pop original */
|
||||
} else {
|
||||
OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
return TCL_OK;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
|
||||
OP44( STR_RANGE_IMM, 0, first-1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/* FLOW THROUGH TO genericReplace */
|
||||
|
||||
} else {
|
||||
/*
|
||||
* When we have no replacement string to worry about, we may have more
|
||||
* luck, because the forbidden empty string replacements are harmless
|
||||
* when they are replaced by another empty string.
|
||||
* When we have no replacement string to worry about, we may
|
||||
* have more luck, because the forbidden empty string replacements
|
||||
* are harmless when they are replaced by another empty string.
|
||||
*/
|
||||
|
||||
if (first == (int)TCL_INDEX_START) {
|
||||
@@ -1260,7 +1204,7 @@ TclCompileStringReplaceCmd(
|
||||
if (last == (int)TCL_INDEX_END) {
|
||||
/* empty suffix too => empty result */
|
||||
OP( POP); /* Pop original */
|
||||
PUSH( "");
|
||||
PUSH ( "");
|
||||
return TCL_OK;
|
||||
}
|
||||
OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
|
||||
@@ -1280,19 +1224,19 @@ TclCompileStringReplaceCmd(
|
||||
}
|
||||
}
|
||||
|
||||
genericReplace:
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 3);
|
||||
if (parsePtr->numWords == 5) {
|
||||
genericReplace:
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
} else {
|
||||
PUSH( "");
|
||||
}
|
||||
OP( STR_REPLACE);
|
||||
return TCL_OK;
|
||||
CompileWord(envPtr, tokenPtr, interp, 3);
|
||||
if (parsePtr->numWords == 5) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
} else {
|
||||
PUSH( "");
|
||||
}
|
||||
OP( STR_REPLACE);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int
|
||||
@@ -1474,6 +1418,7 @@ StringClassDesc const tclStringClassTable[] = {
|
||||
{"upper", Tcl_UniCharIsUpper},
|
||||
{"word", Tcl_UniCharIsWordChar},
|
||||
{"xdigit", UniCharIsHexDigit},
|
||||
{"unicode", Tcl_UniCharIsUnicode},
|
||||
{"", NULL}
|
||||
};
|
||||
|
||||
@@ -1536,14 +1481,12 @@ TclCompileSubstCmd(
|
||||
}
|
||||
*/
|
||||
|
||||
/*
|
||||
* TODO: Figure out expansion to cover WordKnownAtCompileTime. The
|
||||
* difficulty is that WKACT makes a copy, and if TclSubstParse below
|
||||
* parses the copy of the original source string, some deep parts of the
|
||||
* compile machinery get upset. They want all pointers stored in
|
||||
* Tcl_Tokens to point back to the same original string.
|
||||
/* TODO: Figure out expansion to cover WordKnownAtCompileTime
|
||||
* The difficulty is that WKACT makes a copy, and if TclSubstParse
|
||||
* below parses the copy of the original source string, some deep
|
||||
* parts of the compile machinery get upset. They want all pointers
|
||||
* stored in Tcl_Tokens to point back to the same original string.
|
||||
*/
|
||||
|
||||
if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
code = TclSubstOptions(NULL, numOpts, objv, &flags);
|
||||
}
|
||||
@@ -1600,14 +1543,16 @@ TclSubstCompile(
|
||||
|
||||
for (endTokenPtr = tokenPtr + parse.numTokens;
|
||||
tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
|
||||
int length, catchRange, breakJump;
|
||||
int length, literal, catchRange, breakJump;
|
||||
char buf[4] = "";
|
||||
JumpFixup startFixup, okFixup, returnFixup, breakFixup;
|
||||
JumpFixup continueFixup, otherFixup, endFixup;
|
||||
|
||||
switch (tokenPtr->type) {
|
||||
case TCL_TOKEN_TEXT:
|
||||
PushLiteral(envPtr, tokenPtr->start, tokenPtr->size);
|
||||
literal = TclRegisterLiteral(envPtr,
|
||||
tokenPtr->start, tokenPtr->size, 0);
|
||||
TclEmitPush(literal, envPtr);
|
||||
TclAdvanceLines(&bline, tokenPtr->start,
|
||||
tokenPtr->start + tokenPtr->size);
|
||||
count++;
|
||||
@@ -1615,7 +1560,8 @@ TclSubstCompile(
|
||||
case TCL_TOKEN_BS:
|
||||
length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
|
||||
NULL, buf);
|
||||
PushLiteral(envPtr, buf, length);
|
||||
literal = TclRegisterLiteral(envPtr, buf, length, 0);
|
||||
TclEmitPush(literal, envPtr);
|
||||
count++;
|
||||
continue;
|
||||
case TCL_TOKEN_VARIABLE:
|
||||
@@ -1662,7 +1608,8 @@ TclSubstCompile(
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup);
|
||||
|
||||
/* Jump to the end (all BREAKs land here) */
|
||||
JUMP4( JUMP, breakOffset);
|
||||
breakOffset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt4(INST_JUMP4, 0, envPtr);
|
||||
|
||||
/* Start */
|
||||
if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
|
||||
@@ -1673,7 +1620,7 @@ TclSubstCompile(
|
||||
|
||||
envPtr->line = bline;
|
||||
catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
|
||||
OP4( BEGIN_CATCH4, catchRange);
|
||||
OP4( BEGIN_CATCH4, catchRange);
|
||||
ExceptionRangeStarts(envPtr, catchRange);
|
||||
|
||||
switch (tokenPtr->type) {
|
||||
@@ -1694,21 +1641,21 @@ TclSubstCompile(
|
||||
ExceptionRangeEnds(envPtr, catchRange);
|
||||
|
||||
/* Substitution produced TCL_OK */
|
||||
OP( END_CATCH);
|
||||
OP( END_CATCH);
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
|
||||
/* Exceptional return codes processed here */
|
||||
ExceptionRangeTarget(envPtr, catchRange, catchOffset);
|
||||
OP( PUSH_RETURN_OPTIONS);
|
||||
OP( PUSH_RESULT);
|
||||
OP( PUSH_RETURN_CODE);
|
||||
OP( END_CATCH);
|
||||
OP( RETURN_CODE_BRANCH);
|
||||
OP( PUSH_RETURN_OPTIONS);
|
||||
OP( PUSH_RESULT);
|
||||
OP( PUSH_RETURN_CODE);
|
||||
OP( END_CATCH);
|
||||
OP( RETURN_CODE_BRANCH);
|
||||
|
||||
/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
|
||||
OP( RETURN_STK);
|
||||
OP( NOP);
|
||||
OP( RETURN_STK);
|
||||
OP( NOP);
|
||||
|
||||
/* RETURN */
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);
|
||||
@@ -1728,14 +1675,14 @@ TclSubstCompile(
|
||||
Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
|
||||
(int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
|
||||
}
|
||||
OP( POP);
|
||||
OP( POP);
|
||||
OP( POP);
|
||||
OP( POP);
|
||||
|
||||
breakJump = CurrentOffset(envPtr) - breakOffset;
|
||||
if (breakJump > 127) {
|
||||
OP4( JUMP4, -breakJump);
|
||||
OP4(JUMP4, -breakJump);
|
||||
} else {
|
||||
OP1( JUMP1, -breakJump);
|
||||
OP1(JUMP1, -breakJump);
|
||||
}
|
||||
|
||||
TclAdjustStackDepth(2, envPtr);
|
||||
@@ -1802,7 +1749,8 @@ TclSubstCompile(
|
||||
|
||||
/* Final target of the multi-jump from all BREAKs */
|
||||
if (breakOffset > 0) {
|
||||
FIXJUMP4(breakOffset);
|
||||
TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset,
|
||||
envPtr->codeStart + breakOffset);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2099,7 +2047,8 @@ TclCompileSwitchCmd(
|
||||
* illegal, but this makes the error happen at the right time).
|
||||
*/
|
||||
|
||||
if (IsContinuationBody(bodyToken[numWords-1])) {
|
||||
if (bodyToken[numWords-1]->size == 1 &&
|
||||
bodyToken[numWords-1]->start[0] == '-') {
|
||||
goto freeTemporaries;
|
||||
}
|
||||
|
||||
@@ -2111,10 +2060,7 @@ TclCompileSwitchCmd(
|
||||
* but it handles the most common case well enough.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Both methods push the value to match against onto the stack.
|
||||
*/
|
||||
|
||||
/* Both methods push the value to match against onto the stack. */
|
||||
CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
|
||||
|
||||
if (mode == Switch_Exact) {
|
||||
@@ -2198,8 +2144,8 @@ IssueSwitchChainedTests(
|
||||
foundDefault = 0;
|
||||
for (i=0 ; i<numBodyTokens ; i+=2) {
|
||||
nextArmFixupIndex = -1;
|
||||
if (i != numBodyTokens - 2 ||
|
||||
!IsDefaultToken(bodyToken[numBodyTokens - 2])) {
|
||||
if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
|
||||
memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
|
||||
/*
|
||||
* Generate the test for the arm.
|
||||
*/
|
||||
@@ -2281,7 +2227,7 @@ IssueSwitchChainedTests(
|
||||
* ensured earlier; the final body is never a fall-through).
|
||||
*/
|
||||
|
||||
if (IsContinuationBody(bodyToken[i + 1])) {
|
||||
if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
|
||||
if (contFixIndex == -1) {
|
||||
contFixIndex = fixupCount;
|
||||
contFixCount = 0;
|
||||
@@ -2461,8 +2407,8 @@ IssueSwitchJumpTable(
|
||||
* term.
|
||||
*/
|
||||
|
||||
if (i != numBodyTokens - 2 ||
|
||||
!IsDefaultToken(bodyToken[numBodyTokens - 2])) {
|
||||
if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
|
||||
memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
|
||||
/*
|
||||
* This is not a default clause, so insert the current location as
|
||||
* a target in the jump table (assuming it isn't already there,
|
||||
@@ -2481,8 +2427,7 @@ IssueSwitchJumpTable(
|
||||
* point to here.
|
||||
*/
|
||||
|
||||
Tcl_SetHashValue(hPtr, (ptrdiff_t)
|
||||
(CurrentOffset(envPtr) - jumpLocation));
|
||||
Tcl_SetHashValue(hPtr, CurrentOffset(envPtr) - jumpLocation);
|
||||
}
|
||||
Tcl_DStringFree(&buffer);
|
||||
} else {
|
||||
@@ -2493,8 +2438,8 @@ IssueSwitchJumpTable(
|
||||
|
||||
foundDefault = 1;
|
||||
isNew = 1;
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr) - jumpToDefault,
|
||||
envPtr->codeStart + jumpToDefault + 1);
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
|
||||
envPtr->codeStart+jumpToDefault+1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2505,7 +2450,7 @@ IssueSwitchJumpTable(
|
||||
* will also point here, so we advance to the next clause.
|
||||
*/
|
||||
|
||||
if (IsContinuationBody(bodyToken[i + 1])) {
|
||||
if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
|
||||
mustGenerate = 1;
|
||||
continue;
|
||||
}
|
||||
@@ -2557,7 +2502,7 @@ IssueSwitchJumpTable(
|
||||
*/
|
||||
|
||||
if (!foundDefault) {
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr) - jumpToDefault,
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
|
||||
envPtr->codeStart+jumpToDefault+1);
|
||||
PUSH("");
|
||||
}
|
||||
@@ -2568,8 +2513,8 @@ IssueSwitchJumpTable(
|
||||
*/
|
||||
|
||||
for (i=0 ; i<numRealBodies ; i++) {
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr) - finalFixups[i],
|
||||
envPtr->codeStart + finalFixups[i] + 1);
|
||||
TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
|
||||
envPtr->codeStart+finalFixups[i]+1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2728,7 +2673,7 @@ TclCompileTailcallCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
}
|
||||
OP1( TAILCALL, parsePtr->numWords);
|
||||
TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2776,10 +2721,9 @@ TclCompileThrowCmd(
|
||||
codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr);
|
||||
|
||||
/*
|
||||
* First we must emit the code to substitute the arguments. This must
|
||||
* come first in case substitution raises errors.
|
||||
* First we must emit the code to substitute the arguments. This
|
||||
* must come first in case substitution raises errors.
|
||||
*/
|
||||
|
||||
if (!codeKnown) {
|
||||
CompileWord(envPtr, codeToken, interp, 1);
|
||||
PUSH( "-errorcode");
|
||||
@@ -2803,7 +2747,6 @@ TclCompileThrowCmd(
|
||||
/*
|
||||
* Simpler bytecodes when we detect invalid arguments at compile time.
|
||||
*/
|
||||
|
||||
if (codeKnown && !codeIsValid) {
|
||||
OP( POP);
|
||||
if (codeIsList) {
|
||||
@@ -2816,9 +2759,9 @@ TclCompileThrowCmd(
|
||||
|
||||
if (!codeKnown) {
|
||||
/*
|
||||
* Argument validity checking has to be done by bytecode at run time.
|
||||
* Argument validity checking has to be done by bytecode at
|
||||
* run time.
|
||||
*/
|
||||
|
||||
OP4( REVERSE, 3);
|
||||
OP( DUP);
|
||||
OP( LIST_LENGTH);
|
||||
@@ -2910,7 +2853,8 @@ TclCompileTryCmd(
|
||||
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
|
||||
goto failedToCompile;
|
||||
}
|
||||
if (IsTrapToken(&tokenPtr[1])) {
|
||||
if (tokenPtr[1].size == 4
|
||||
&& !strncmp(tokenPtr[1].start, "trap", 4)) {
|
||||
/*
|
||||
* Parse the list of errorCode words to match against.
|
||||
*/
|
||||
@@ -2927,7 +2871,8 @@ TclCompileTryCmd(
|
||||
}
|
||||
Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
|
||||
matchClauses[i] = tmpObj;
|
||||
} else if (IsOnToken(&tokenPtr[1])) {
|
||||
} else if (tokenPtr[1].size == 2
|
||||
&& !strncmp(tokenPtr[1].start, "on", 2)) {
|
||||
int code;
|
||||
|
||||
/*
|
||||
@@ -3001,7 +2946,7 @@ TclCompileTryCmd(
|
||||
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
|
||||
goto failedToCompile;
|
||||
}
|
||||
if (IsContinuationBody(&tokenPtr[1])) {
|
||||
if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') {
|
||||
handlerTokens[i] = NULL;
|
||||
} else {
|
||||
handlerTokens[i] = tokenPtr;
|
||||
@@ -3022,8 +2967,8 @@ TclCompileTryCmd(
|
||||
if (numWords == 0) {
|
||||
finallyToken = NULL;
|
||||
} else if (numWords == 2) {
|
||||
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
|
||||
!IsFinallyToken(&tokenPtr[1])) {
|
||||
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7
|
||||
|| strncmp(tokenPtr[1].start, "finally", 7)) {
|
||||
goto failedToCompile;
|
||||
}
|
||||
finallyToken = TokenAfter(tokenPtr);
|
||||
@@ -3928,16 +3873,16 @@ TclCompileWhileCmd(
|
||||
|
||||
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
|
||||
if (jumpDist > 127) {
|
||||
OP4(JUMP_TRUE4, -jumpDist);
|
||||
TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
|
||||
} else {
|
||||
OP1(JUMP_TRUE1, -jumpDist);
|
||||
TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
|
||||
}
|
||||
} else {
|
||||
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
|
||||
if (jumpDist > 127) {
|
||||
OP4(JUMP4, -jumpDist);
|
||||
TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
|
||||
} else {
|
||||
OP1(JUMP1, -jumpDist);
|
||||
TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -4226,16 +4171,16 @@ CompileComparisonOpCmd(
|
||||
STORE(tmpIndex);
|
||||
TclEmitOpcode(instruction, envPtr);
|
||||
for (words=3 ; words<parsePtr->numWords ;) {
|
||||
LOAD( tmpIndex);
|
||||
LOAD(tmpIndex);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, words);
|
||||
if (++words < parsePtr->numWords) {
|
||||
STORE( tmpIndex);
|
||||
STORE(tmpIndex);
|
||||
}
|
||||
TclEmitOpcode(instruction, envPtr);
|
||||
}
|
||||
for (; words>3 ; words--) {
|
||||
OP( BITAND);
|
||||
OP( BITAND);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -4243,7 +4188,7 @@ CompileComparisonOpCmd(
|
||||
* might be expensive elsewhere.
|
||||
*/
|
||||
|
||||
OP14( UNSET_SCALAR, 0, tmpIndex);
|
||||
OP14( UNSET_SCALAR, 0, tmpIndex);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -4369,7 +4314,7 @@ TclCompilePowOpCmd(
|
||||
words++;
|
||||
}
|
||||
while (--words > 1) {
|
||||
OP( EXPON);
|
||||
TclEmitOpcode(INST_EXPON, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -4569,11 +4514,11 @@ TclCompileMinusOpCmd(
|
||||
CompileWord(envPtr, tokenPtr, interp, words);
|
||||
}
|
||||
if (words == 2) {
|
||||
OP( UMINUS);
|
||||
TclEmitOpcode(INST_UMINUS, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
if (words == 3) {
|
||||
OP( SUB);
|
||||
TclEmitOpcode(INST_SUB, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -4582,10 +4527,10 @@ TclCompileMinusOpCmd(
|
||||
* calcuations, including roundoff errors.
|
||||
*/
|
||||
|
||||
OP4( REVERSE, words - 1);
|
||||
TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
|
||||
while (--words > 1) {
|
||||
OP4( REVERSE, 2);
|
||||
OP( SUB);
|
||||
TclEmitInstInt4(INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode(INST_SUB, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -4610,14 +4555,14 @@ TclCompileDivOpCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (parsePtr->numWords == 2) {
|
||||
PUSH( "1.0");
|
||||
PUSH("1.0");
|
||||
}
|
||||
for (words=1 ; words<parsePtr->numWords ; words++) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, words);
|
||||
}
|
||||
if (words <= 3) {
|
||||
OP( DIV);
|
||||
TclEmitOpcode(INST_DIV, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -4626,10 +4571,10 @@ TclCompileDivOpCmd(
|
||||
* calcuations, including roundoff errors.
|
||||
*/
|
||||
|
||||
OP4( REVERSE, words - 1);
|
||||
TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
|
||||
while (--words > 1) {
|
||||
OP4( REVERSE, 2);
|
||||
OP( DIV);
|
||||
TclEmitInstInt4(INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode(INST_DIV, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+72
-68
@@ -134,16 +134,15 @@ enum Marks {
|
||||
* need not take the form of a bit array.
|
||||
*/
|
||||
|
||||
enum {
|
||||
BINARY = 0x40, /* This lexeme is a binary operator. An OpNode
|
||||
#define BINARY 0x40 /* This lexeme is a binary operator. An OpNode
|
||||
* representing it should go into the parse
|
||||
* tree, and two operands should be parsed for
|
||||
* it in the expression. */
|
||||
UNARY = 0x80, /* This lexeme is a unary operator. An OpNode
|
||||
#define UNARY 0x80 /* This lexeme is a unary operator. An OpNode
|
||||
* representing it should go into the parse
|
||||
* tree, and one operand should be parsed for
|
||||
* it in the expression. */
|
||||
LEAF = 0xC0 /* This lexeme is a leaf operand in the parse
|
||||
#define LEAF 0xC0 /* This lexeme is a leaf operand in the parse
|
||||
* tree. No OpNode will be placed in the tree
|
||||
* for it. Either a literal value will be
|
||||
* appended to the list of literals in this
|
||||
@@ -151,46 +150,47 @@ enum {
|
||||
* be appended in a Tcl_Parse struct to
|
||||
* represent those leaves that require some
|
||||
* form of substitution. */
|
||||
};
|
||||
|
||||
/* Uncategorized lexemes */
|
||||
|
||||
enum {
|
||||
PLUS = 1, /* Ambiguous. Resolves to UNARY_PLUS or
|
||||
#define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or
|
||||
* BINARY_PLUS according to context. */
|
||||
MINUS = 2, /* Ambiguous. Resolves to UNARY_MINUS or
|
||||
#define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or
|
||||
* BINARY_MINUS according to context. */
|
||||
BAREWORD = 3, /* Ambigous. Resolves to BOOLEAN or to
|
||||
#define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to
|
||||
* FUNCTION or a parse error according to
|
||||
* context and value. */
|
||||
INCOMPLETE = 4, /* A parse error. Used only when the single
|
||||
#define INCOMPLETE 4 /* A parse error. Used only when the single
|
||||
* "=" is encountered. */
|
||||
INVALID = 5, /* A parse error. Used when any punctuation
|
||||
#define INVALID 5 /* A parse error. Used when any punctuation
|
||||
* appears that's not a supported operator. */
|
||||
COMMENT = 6 /* Comment. Lasts to end of line or end of
|
||||
#define COMMENT 6 /* Comment. Lasts to end of line or end of
|
||||
* expression, whichever comes first. */
|
||||
};
|
||||
|
||||
/* Leaf lexemes */
|
||||
|
||||
enum {
|
||||
NUMBER = (LEAF | 1), /* For literal numbers */
|
||||
SCRIPT = (LEAF | 2), /* Script substitution; [foo] */
|
||||
BOOLEAN = (LEAF | BAREWORD),/* For literal booleans */
|
||||
BRACED = (LEAF | 4), /* Braced string; {foo bar} */
|
||||
VARIABLE = (LEAF | 5), /* Variable substitution; $x */
|
||||
QUOTED = (LEAF | 6), /* Quoted string; "foo $bar [soom]" */
|
||||
EMPTY = (LEAF | 7) /* Used only for an empty argument list to a
|
||||
#define NUMBER (LEAF | 1)
|
||||
/* For literal numbers */
|
||||
#define SCRIPT (LEAF | 2)
|
||||
/* Script substitution; [foo] */
|
||||
#define BOOLEAN (LEAF | BAREWORD)
|
||||
/* For literal booleans */
|
||||
#define BRACED (LEAF | 4)
|
||||
/* Braced string; {foo bar} */
|
||||
#define VARIABLE (LEAF | 5)
|
||||
/* Variable substitution; $x */
|
||||
#define QUOTED (LEAF | 6)
|
||||
/* Quoted string; "foo $bar [soom]" */
|
||||
#define EMPTY (LEAF | 7)
|
||||
/* Used only for an empty argument list to a
|
||||
* function. Represents the empty string
|
||||
* within parens in the expression: rand() */
|
||||
};
|
||||
|
||||
/* Unary operator lexemes */
|
||||
|
||||
enum {
|
||||
UNARY_PLUS = (UNARY | PLUS),
|
||||
UNARY_MINUS = (UNARY | MINUS),
|
||||
FUNCTION = (UNARY | BAREWORD),
|
||||
#define UNARY_PLUS (UNARY | PLUS)
|
||||
#define UNARY_MINUS (UNARY | MINUS)
|
||||
#define FUNCTION (UNARY | BAREWORD)
|
||||
/* This is a bit of "creative interpretation"
|
||||
* on the part of the parser. A function call
|
||||
* is parsed into the parse tree according to
|
||||
@@ -206,64 +206,69 @@ enum {
|
||||
* include such exceptional handling in the
|
||||
* code against the need we would otherwise
|
||||
* have for more lexeme categories. */
|
||||
START = (UNARY | 4), /* This lexeme isn't parsed from the
|
||||
#define START (UNARY | 4)
|
||||
/* This lexeme isn't parsed from the
|
||||
* expression text at all. It represents the
|
||||
* start of the expression and sits at the
|
||||
* root of the parse tree where it serves as
|
||||
* the start/end point of traversals. */
|
||||
OPEN_PAREN = (UNARY | 5), /* Another bit of creative interpretation,
|
||||
#define OPEN_PAREN (UNARY | 5)
|
||||
/* Another bit of creative interpretation,
|
||||
* where we treat "(" as a unary operator with
|
||||
* the sub-expression between it and its
|
||||
* matching ")" as its operand. See
|
||||
* CLOSE_PAREN below. */
|
||||
NOT = (UNARY | 6),
|
||||
BIT_NOT = (UNARY | 7)
|
||||
};
|
||||
#define NOT (UNARY | 6)
|
||||
#define BIT_NOT (UNARY | 7)
|
||||
|
||||
/* Binary operator lexemes */
|
||||
|
||||
enum {
|
||||
BINARY_PLUS = (BINARY | PLUS),
|
||||
BINARY_MINUS = (BINARY | MINUS),
|
||||
COMMA = (BINARY | 3), /* The "," operator is a low precedence binary
|
||||
#define BINARY_PLUS (BINARY | PLUS)
|
||||
#define BINARY_MINUS (BINARY | MINUS)
|
||||
#define COMMA (BINARY | 3)
|
||||
/* The "," operator is a low precedence binary
|
||||
* operator that separates the arguments in a
|
||||
* function call. The additional constraint
|
||||
* that this operator can only legally appear
|
||||
* at the right places within a function call
|
||||
* argument list are hard coded within
|
||||
* ParseExpr(). */
|
||||
MULT = (BINARY | 4),
|
||||
DIVIDE = (BINARY | 5),
|
||||
MOD = (BINARY | 6),
|
||||
LESS = (BINARY | 7),
|
||||
GREATER = (BINARY | 8),
|
||||
BIT_AND = (BINARY | 9),
|
||||
BIT_XOR = (BINARY | 10),
|
||||
BIT_OR = (BINARY | 11),
|
||||
QUESTION = (BINARY | 12), /* These two lexemes make up the */
|
||||
COLON = (BINARY | 13), /* ternary conditional operator, $x ? $y : $z.
|
||||
#define MULT (BINARY | 4)
|
||||
#define DIVIDE (BINARY | 5)
|
||||
#define MOD (BINARY | 6)
|
||||
#define LESS (BINARY | 7)
|
||||
#define GREATER (BINARY | 8)
|
||||
#define BIT_AND (BINARY | 9)
|
||||
#define BIT_XOR (BINARY | 10)
|
||||
#define BIT_OR (BINARY | 11)
|
||||
#define QUESTION (BINARY | 12)
|
||||
/* These two lexemes make up the */
|
||||
#define COLON (BINARY | 13)
|
||||
/* ternary conditional operator, $x ? $y : $z.
|
||||
* We treat them as two binary operators to
|
||||
* avoid another lexeme category, and code the
|
||||
* additional constraints directly in
|
||||
* ParseExpr(). For instance, the right
|
||||
* operand of a "?" operator must be a ":"
|
||||
* operator. */
|
||||
LEFT_SHIFT = (BINARY | 14),
|
||||
RIGHT_SHIFT = (BINARY | 15),
|
||||
LEQ = (BINARY | 16),
|
||||
GEQ = (BINARY | 17),
|
||||
EQUAL = (BINARY | 18),
|
||||
NEQ = (BINARY | 19),
|
||||
AND = (BINARY | 20),
|
||||
OR = (BINARY | 21),
|
||||
STREQ = (BINARY | 22),
|
||||
STRNEQ = (BINARY | 23),
|
||||
EXPON = (BINARY | 24), /* Unlike the other binary operators, EXPON is
|
||||
#define LEFT_SHIFT (BINARY | 14)
|
||||
#define RIGHT_SHIFT (BINARY | 15)
|
||||
#define LEQ (BINARY | 16)
|
||||
#define GEQ (BINARY | 17)
|
||||
#define EQUAL (BINARY | 18)
|
||||
#define NEQ (BINARY | 19)
|
||||
#define AND (BINARY | 20)
|
||||
#define OR (BINARY | 21)
|
||||
#define STREQ (BINARY | 22)
|
||||
#define STRNEQ (BINARY | 23)
|
||||
#define EXPON (BINARY | 24)
|
||||
/* Unlike the other binary operators, EXPON is
|
||||
* right associative and this distinction is
|
||||
* coded directly in ParseExpr(). */
|
||||
IN_LIST = (BINARY | 25),
|
||||
NOT_IN_LIST = (BINARY | 26),
|
||||
CLOSE_PAREN = (BINARY | 27),/* By categorizing the CLOSE_PAREN lexeme as a
|
||||
#define IN_LIST (BINARY | 25)
|
||||
#define NOT_IN_LIST (BINARY | 26)
|
||||
#define CLOSE_PAREN (BINARY | 27)
|
||||
/* By categorizing the CLOSE_PAREN lexeme as a
|
||||
* BINARY operator, the normal parsing rules
|
||||
* for binary operators assure that a close
|
||||
* paren will not directly follow another
|
||||
@@ -278,17 +283,17 @@ enum {
|
||||
* parse tree. The sub-expression between
|
||||
* parens becomes the single argument of the
|
||||
* matching OPEN_PAREN unary operator. */
|
||||
STR_LT = (BINARY | 28),
|
||||
STR_GT = (BINARY | 29),
|
||||
STR_LEQ = (BINARY | 30),
|
||||
STR_GEQ = (BINARY | 31),
|
||||
END = (BINARY | 32) /* This lexeme represents the end of the
|
||||
#define STR_LT (BINARY | 28)
|
||||
#define STR_GT (BINARY | 29)
|
||||
#define STR_LEQ (BINARY | 30)
|
||||
#define STR_GEQ (BINARY | 31)
|
||||
#define END (BINARY | 32)
|
||||
/* This lexeme represents the end of the
|
||||
* string being parsed. Treating it as a
|
||||
* binary operator follows the same logic as
|
||||
* the CLOSE_PAREN lexeme and END pairs with
|
||||
* START, in the same way that CLOSE_PAREN
|
||||
* pairs with OPEN_PAREN. */
|
||||
};
|
||||
|
||||
/*
|
||||
* When ParseExpr() builds the parse tree it must choose which operands to
|
||||
@@ -2675,10 +2680,9 @@ TclSortingOpCmd(
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
|
||||
} else {
|
||||
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
|
||||
Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp,
|
||||
Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
|
||||
2 * (objc-2) * sizeof(Tcl_Obj *));
|
||||
OpNode *nodes = (OpNode *)
|
||||
TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
|
||||
OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
|
||||
unsigned char lexeme;
|
||||
int i, lastAnd = 1;
|
||||
Tcl_Obj *const *litObjPtrPtr = litObjv;
|
||||
|
||||
+617
-825
File diff suppressed because it is too large
Load Diff
@@ -1937,6 +1937,8 @@ EXTERN int Tcl_UtfCharComplete(const char *src, int length);
|
||||
EXTERN const char * Tcl_UtfNext(const char *src);
|
||||
/* 656 */
|
||||
EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
|
||||
/* 657 */
|
||||
EXTERN int Tcl_UniCharIsUnicode(int ch);
|
||||
|
||||
typedef struct {
|
||||
const struct TclPlatStubs *tclPlatStubs;
|
||||
@@ -2629,6 +2631,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_UtfCharComplete) (const char *src, int length); /* 654 */
|
||||
const char * (*tcl_UtfNext) (const char *src); /* 655 */
|
||||
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
|
||||
int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
|
||||
} TclStubs;
|
||||
|
||||
extern const TclStubs *tclStubsPtr;
|
||||
@@ -3971,6 +3974,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_UtfNext) /* 655 */
|
||||
#define Tcl_UtfPrev \
|
||||
(tclStubsPtr->tcl_UtfPrev) /* 656 */
|
||||
#define Tcl_UniCharIsUnicode \
|
||||
(tclStubsPtr->tcl_UniCharIsUnicode) /* 657 */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
|
||||
@@ -950,7 +950,7 @@ Tcl_DictObjPut(
|
||||
TclInvalidateStringRep(dictPtr);
|
||||
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
|
||||
dict->refCount++;
|
||||
TclFreeIntRep(dictPtr);
|
||||
TclFreeIntRep(dictPtr)
|
||||
DictSetIntRep(dictPtr, dict);
|
||||
Tcl_IncrRefCount(valuePtr);
|
||||
if (!isNew) {
|
||||
|
||||
@@ -53,11 +53,12 @@ static const Tcl_ObjType instNameType = {
|
||||
|
||||
#define InstNameGetIntRep(objPtr, inst) \
|
||||
do { \
|
||||
const Tcl_ObjIntRep *irPtr = \
|
||||
TclFetchIntRep((objPtr), &instNameType); \
|
||||
const Tcl_ObjIntRep *irPtr; \
|
||||
irPtr = TclFetchIntRep((objPtr), &instNameType); \
|
||||
assert(irPtr != NULL); \
|
||||
(inst) = (size_t) irPtr->wideValue; \
|
||||
(inst) = (size_t)irPtr->wideValue; \
|
||||
} while (0)
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
|
||||
+61
-29
@@ -116,8 +116,7 @@ typedef struct {
|
||||
* entry in this array is 1, otherwise it is
|
||||
* 0. */
|
||||
int numSubTables; /* Length of following array. */
|
||||
EscapeSubTable subTables[TCLFLEXARRAY];
|
||||
/* 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. */
|
||||
@@ -128,12 +127,10 @@ typedef struct {
|
||||
* file.
|
||||
*/
|
||||
|
||||
enum {
|
||||
ENCODING_SINGLEBYTE = 0,
|
||||
ENCODING_DOUBLEBYTE = 1,
|
||||
ENCODING_MULTIBYTE = 2,
|
||||
ENCODING_ESCAPE = 3
|
||||
};
|
||||
#define ENCODING_SINGLEBYTE 0
|
||||
#define ENCODING_DOUBLEBYTE 1
|
||||
#define ENCODING_MULTIBYTE 2
|
||||
#define ENCODING_ESCAPE 3
|
||||
|
||||
/*
|
||||
* A list of directories in which Tcl should look for *.enc files. This list
|
||||
@@ -236,7 +233,7 @@ static Tcl_EncodingConvertProc Iso88591ToUtfProc;
|
||||
static const Tcl_ObjType encodingType = {
|
||||
"encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
|
||||
};
|
||||
#define EncodingSetIntRep(objPtr, encoding) \
|
||||
#define EncodingSetIntRep(objPtr, encoding) \
|
||||
do { \
|
||||
Tcl_ObjIntRep ir; \
|
||||
ir.twoPtrValue.ptr1 = (encoding); \
|
||||
@@ -244,7 +241,7 @@ static const Tcl_ObjType encodingType = {
|
||||
Tcl_StoreIntRep((objPtr), &encodingType, &ir); \
|
||||
} while (0)
|
||||
|
||||
#define EncodingGetIntRep(objPtr, encoding) \
|
||||
#define EncodingGetIntRep(objPtr, encoding) \
|
||||
do { \
|
||||
const Tcl_ObjIntRep *irPtr; \
|
||||
irPtr = TclFetchIntRep ((objPtr), &encodingType); \
|
||||
@@ -513,17 +510,12 @@ FillEncodingFileMap(void)
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
enum {
|
||||
/* This flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
|
||||
TCL_ENCODING_MODIFIED = 0x20, /* Converting NULL bytes to 0xC0 0x80 */
|
||||
|
||||
/*
|
||||
* Since TCL_ENCODING_MODIFIED is only used for utf-8 and TCL_ENCODING_LE
|
||||
* is only used for utf-16/ucs-2, re-use the same value
|
||||
*/
|
||||
|
||||
TCL_ENCODING_LE = TCL_ENCODING_MODIFIED /* Little-endian encoding */
|
||||
};
|
||||
/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
|
||||
/* Since TCL_ENCODING_MODIFIED is only used for utf-8/cesu-8 and
|
||||
* TCL_ENCODING_LE is only used for utf-16/ucs-2. re-use the same value */
|
||||
#define TCL_ENCODING_MODIFIED 0x20 /* Converting NULL bytes to 0xC0 0x80 */
|
||||
#define TCL_ENCODING_LE TCL_ENCODING_MODIFIED /* Little-endian encoding */
|
||||
#define TCL_ENCODING_UTF 0x200 /* For UTF-8 encoding, allow 4-byte output sequences */
|
||||
|
||||
void
|
||||
TclInitEncodingSubsystem(void)
|
||||
@@ -565,7 +557,10 @@ TclInitEncodingSubsystem(void)
|
||||
type.fromUtfProc = UtfToUtfProc;
|
||||
type.freeProc = NULL;
|
||||
type.nullSize = 1;
|
||||
type.clientData = NULL;
|
||||
type.clientData = INT2PTR(TCL_ENCODING_UTF);
|
||||
Tcl_CreateEncoding(&type);
|
||||
type.clientData = INT2PTR(0);
|
||||
type.encodingName = "cesu-8";
|
||||
Tcl_CreateEncoding(&type);
|
||||
|
||||
type.toUtfProc = Utf16ToUtfProc;
|
||||
@@ -1150,7 +1145,7 @@ Tcl_ExternalToUtfDString(
|
||||
|
||||
flags = TCL_ENCODING_START | TCL_ENCODING_END;
|
||||
if (encodingPtr->toUtfProc == UtfToUtfProc) {
|
||||
flags |= TCL_ENCODING_MODIFIED;
|
||||
flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
|
||||
}
|
||||
|
||||
while (1) {
|
||||
@@ -1267,7 +1262,7 @@ Tcl_ExternalToUtf(
|
||||
dstLen--;
|
||||
}
|
||||
if (encodingPtr->toUtfProc == UtfToUtfProc) {
|
||||
flags |= TCL_ENCODING_MODIFIED;
|
||||
flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
|
||||
}
|
||||
do {
|
||||
Tcl_EncodingState savedState = *statePtr;
|
||||
@@ -1346,6 +1341,7 @@ Tcl_UtfToExternalDString(
|
||||
&srcRead, &dstWrote, &dstChars);
|
||||
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
|
||||
|
||||
src += srcRead;
|
||||
if (result != TCL_CONVERT_NOSPACE) {
|
||||
if (encodingPtr->nullSize == 2) {
|
||||
Tcl_DStringSetLength(dstPtr, soFar + 1);
|
||||
@@ -1355,7 +1351,6 @@ Tcl_UtfToExternalDString(
|
||||
}
|
||||
|
||||
flags &= ~TCL_ENCODING_START;
|
||||
src += srcRead;
|
||||
srcLen -= srcRead;
|
||||
if (Tcl_DStringLength(dstPtr) == 0) {
|
||||
Tcl_DStringSetLength(dstPtr, dstLen);
|
||||
@@ -2224,7 +2219,7 @@ UtfToUtfProc(
|
||||
|
||||
dstStart = dst;
|
||||
flags |= PTR2INT(clientData);
|
||||
dstEnd = dst + dstLen - TCL_UTF_MAX;
|
||||
dstEnd = dst + dstLen - ((flags & TCL_ENCODING_UTF) ? TCL_UTF_MAX : 6);
|
||||
|
||||
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
|
||||
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
|
||||
@@ -2277,6 +2272,7 @@ UtfToUtfProc(
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
} else {
|
||||
int low;
|
||||
const char *saveSrc = src;
|
||||
size_t len = TclUtfToUCS4(src, &ch);
|
||||
if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)
|
||||
&& (flags & TCL_ENCODING_MODIFIED)) {
|
||||
@@ -2284,7 +2280,17 @@ UtfToUtfProc(
|
||||
break;
|
||||
}
|
||||
src += len;
|
||||
if ((ch | 0x7FF) == 0xDFFF) {
|
||||
if (!(flags & TCL_ENCODING_UTF) && (ch > 0x3FF)) {
|
||||
if (ch > 0xFFFF) {
|
||||
/* CESU-8 6-byte sequence for chars > U+FFFF */
|
||||
ch -= 0x10000;
|
||||
*dst++ = 0xED;
|
||||
*dst++ = (char) (((ch >> 16) & 0x0F) | 0xA0);
|
||||
*dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
|
||||
ch = (ch & 0x0CFF) | 0xDC00;
|
||||
}
|
||||
goto cesu8;
|
||||
} else if ((ch | 0x7FF) == 0xDFFF) {
|
||||
/*
|
||||
* A surrogate character is detected, handle especially.
|
||||
*/
|
||||
@@ -2293,6 +2299,15 @@ UtfToUtfProc(
|
||||
len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
|
||||
|
||||
if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
|
||||
if (flags & TCL_ENCODING_STOPONERROR) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
src = saveSrc;
|
||||
break;
|
||||
}
|
||||
if (!(flags & TCL_ENCODING_MODIFIED)) {
|
||||
ch = 0xFFFD;
|
||||
}
|
||||
cesu8:
|
||||
*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
|
||||
*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
|
||||
*dst++ = (char) ((ch | 0x80) & 0xBF);
|
||||
@@ -2301,6 +2316,15 @@ UtfToUtfProc(
|
||||
src += len;
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
ch = low;
|
||||
} else if (!Tcl_UniCharIsUnicode(ch)) {
|
||||
if (flags & TCL_ENCODING_STOPONERROR) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
src = saveSrc;
|
||||
break;
|
||||
}
|
||||
if (!(flags & TCL_ENCODING_MODIFIED)) {
|
||||
ch = 0xFFFD;
|
||||
}
|
||||
}
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
}
|
||||
@@ -2459,7 +2483,7 @@ UtfToUtf16Proc(
|
||||
{
|
||||
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
|
||||
int result, numChars;
|
||||
int ch;
|
||||
int ch, len;
|
||||
|
||||
srcStart = src;
|
||||
srcEnd = src + srcLen;
|
||||
@@ -2487,7 +2511,15 @@ UtfToUtf16Proc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
src += TclUtfToUCS4(src, &ch);
|
||||
len = TclUtfToUCS4(src, &ch);
|
||||
if (!Tcl_UniCharIsUnicode(ch)) {
|
||||
if (flags & TCL_ENCODING_STOPONERROR) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
break;
|
||||
}
|
||||
ch = 0xFFFD;
|
||||
}
|
||||
src += len;
|
||||
if (flags & TCL_ENCODING_LE) {
|
||||
if (ch <= 0xFFFF) {
|
||||
*dst++ = (ch & 0xFF);
|
||||
|
||||
@@ -165,7 +165,7 @@ TclNamespaceEnsembleCmd(
|
||||
const char *simpleName;
|
||||
int index, done;
|
||||
|
||||
if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
|
||||
if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
|
||||
if (!Tcl_InterpDeleted(interp)) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"tried to manipulate ensemble of deleted namespace",
|
||||
@@ -1730,7 +1730,7 @@ NsEnsembleImplementationCmdNR(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (ensemblePtr->nsPtr->flags & NS_DYING) {
|
||||
if (ensemblePtr->nsPtr->flags & NS_DEAD) {
|
||||
/*
|
||||
* Don't know how we got here, but make things give up quickly.
|
||||
*/
|
||||
|
||||
@@ -420,6 +420,16 @@ Tcl_PutEnv(
|
||||
|
||||
if ((value != NULL) && (value != name)) {
|
||||
value[0] = '\0';
|
||||
#if defined(_WIN32)
|
||||
if (tenviron == NULL) {
|
||||
/*
|
||||
* When we are started from main(), the _wenviron array could
|
||||
* be NULL and will be initialized by the first _wgetenv() call.
|
||||
*/
|
||||
|
||||
(void) _wgetenv(L"WINDIR");
|
||||
}
|
||||
#endif
|
||||
TclSetEnv(name, value+1);
|
||||
}
|
||||
TclEnvEpoch++;
|
||||
|
||||
+16
-26
@@ -15,7 +15,6 @@
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#define _BUILD_TCL_EXECUTE 1
|
||||
#include "tclInt.h"
|
||||
#include "tclCompile.h"
|
||||
#include "tclOOInt.h"
|
||||
@@ -208,16 +207,11 @@ typedef struct TEBCdata {
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
* These variable-access inline functions have to coincide with those in
|
||||
* tclVar.c
|
||||
* These variable-access macros have to coincide with those in tclVar.c
|
||||
*/
|
||||
|
||||
static inline Var *
|
||||
VarHashGetValue(
|
||||
Tcl_HashEntry *hPtr)
|
||||
{
|
||||
return (Var *) ((char *)hPtr - offsetof(VarInHash, entry));
|
||||
}
|
||||
#define VarHashGetValue(hPtr) \
|
||||
((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
|
||||
|
||||
static inline Var *
|
||||
VarHashCreateVar(
|
||||
@@ -234,13 +228,8 @@ VarHashCreateVar(
|
||||
return VarHashGetValue(hPtr);
|
||||
}
|
||||
|
||||
static inline Var *
|
||||
VarHashFindVar(
|
||||
TclVarHashTable *tablePtr,
|
||||
Tcl_Obj *key)
|
||||
{
|
||||
return VarHashCreateVar((tablePtr), (key), NULL);
|
||||
}
|
||||
#define VarHashFindVar(tablePtr, key) \
|
||||
VarHashCreateVar((tablePtr), (key), NULL)
|
||||
|
||||
/*
|
||||
* The new macro for ending an instruction; note that a reasonable C-optimiser
|
||||
@@ -272,7 +261,7 @@ VarHashFindVar(
|
||||
#define CHECK_STACK()
|
||||
#endif
|
||||
|
||||
#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
|
||||
#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
|
||||
do { \
|
||||
TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \
|
||||
CHECK_STACK(); \
|
||||
@@ -354,16 +343,16 @@ VarHashFindVar(
|
||||
switch (*pc) { \
|
||||
case INST_JUMP_FALSE1: \
|
||||
NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
|
||||
break; \
|
||||
break; \
|
||||
case INST_JUMP_TRUE1: \
|
||||
NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
|
||||
break; \
|
||||
break; \
|
||||
case INST_JUMP_FALSE4: \
|
||||
NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
|
||||
break; \
|
||||
break; \
|
||||
case INST_JUMP_TRUE4: \
|
||||
NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
|
||||
break; \
|
||||
break; \
|
||||
default: \
|
||||
if ((condition) < 0) { \
|
||||
TclNewIntObj(objResultPtr, -1); \
|
||||
@@ -371,12 +360,12 @@ VarHashFindVar(
|
||||
objResultPtr = TCONST((condition) > 0); \
|
||||
} \
|
||||
NEXT_INST_V(0, (cleanup), 1); \
|
||||
break; \
|
||||
break; \
|
||||
} \
|
||||
} while (0)
|
||||
#else /* TCL_COMPILE_DEBUG */
|
||||
#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
|
||||
do { \
|
||||
do{ \
|
||||
if ((condition) < 0) { \
|
||||
TclNewIntObj(objResultPtr, -1); \
|
||||
} else { \
|
||||
@@ -385,7 +374,7 @@ VarHashFindVar(
|
||||
NEXT_INST_F((pcAdjustment), (cleanup), 1); \
|
||||
} while (0)
|
||||
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
|
||||
do { \
|
||||
do{ \
|
||||
if ((condition) < 0) { \
|
||||
TclNewIntObj(objResultPtr, -1); \
|
||||
} else { \
|
||||
@@ -1009,7 +998,7 @@ static inline int
|
||||
wordSkip(
|
||||
void *ptr)
|
||||
{
|
||||
int mask = TCL_ALLOCALIGN - 1;
|
||||
int mask = TCL_ALLOCALIGN-1;
|
||||
int base = PTR2INT(ptr) & mask;
|
||||
return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
|
||||
}
|
||||
@@ -2517,6 +2506,7 @@ TEBCresume(
|
||||
Tcl_IncrRefCount(valuePtr);
|
||||
iPtr->execEnvPtr = corPtr->callerEEPtr;
|
||||
TclSetTailcall(interp, valuePtr);
|
||||
corPtr->yieldPtr = valuePtr;
|
||||
iPtr->execEnvPtr = corPtr->eePtr;
|
||||
yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
|
||||
|
||||
@@ -8828,7 +8818,7 @@ ExecuteExtendedUnaryMathOp(
|
||||
int opcode, /* What operation to perform. */
|
||||
Tcl_Obj *valuePtr) /* The operand on the stack. */
|
||||
{
|
||||
ClientData ptr;
|
||||
ClientData ptr = NULL;
|
||||
int type;
|
||||
Tcl_WideInt w;
|
||||
mp_int big;
|
||||
|
||||
+293
-292
File diff suppressed because it is too large
Load Diff
+6
-9
@@ -40,9 +40,9 @@ static Tcl_ExitProc FinalizeIOCmdTSD;
|
||||
static Tcl_TcpAcceptProc AcceptCallbackProc;
|
||||
static Tcl_ObjCmdProc ChanPendingObjCmd;
|
||||
static Tcl_ObjCmdProc ChanTruncateObjCmd;
|
||||
static void RegisterTcpServerInterpCleanup(
|
||||
Tcl_Interp *interp,
|
||||
AcceptCallback *acceptCallbackPtr);
|
||||
static void RegisterTcpServerInterpCleanup(
|
||||
Tcl_Interp *interp,
|
||||
AcceptCallback *acceptCallbackPtr);
|
||||
static Tcl_InterpDeleteProc TcpAcceptCallbacksDeleteProc;
|
||||
static void TcpServerCloseProc(ClientData callbackData);
|
||||
static void UnregisterTcpServerInterpCleanupProc(
|
||||
@@ -1219,8 +1219,7 @@ TcpAcceptCallbacksDeleteProc(
|
||||
|
||||
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
|
||||
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
|
||||
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
|
||||
Tcl_GetHashValue(hPtr);
|
||||
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr);
|
||||
|
||||
acceptCallbackPtr->interp = NULL;
|
||||
}
|
||||
@@ -1308,8 +1307,7 @@ UnregisterTcpServerInterpCleanupProc(
|
||||
Tcl_HashTable *hTblPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
|
||||
hTblPtr = (Tcl_HashTable *)
|
||||
Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
|
||||
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
|
||||
if (hTblPtr == NULL) {
|
||||
return;
|
||||
}
|
||||
@@ -1637,8 +1635,7 @@ Tcl_SocketObjCmd(
|
||||
port = TclGetString(objv[a]);
|
||||
|
||||
if (server) {
|
||||
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
|
||||
ckalloc(sizeof(AcceptCallback));
|
||||
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback));
|
||||
|
||||
Tcl_IncrRefCount(script);
|
||||
acceptCallbackPtr->script = script;
|
||||
|
||||
+12
-16
@@ -68,22 +68,18 @@ static int ExecuteCallback(TransformChannelData *ctrl,
|
||||
* the procedure what to do with the result of the script it calls.
|
||||
*/
|
||||
|
||||
enum {
|
||||
TRANSMIT_DONT = 0, /* No transfer to do. */
|
||||
TRANSMIT_DOWN = 1, /* Transfer to the underlying channel. */
|
||||
TRANSMIT_SELF = 2, /* Transfer into our channel. */
|
||||
TRANSMIT_IBUF = 3, /* Transfer to internal input buffer. */
|
||||
TRANSMIT_NUM = 4 /* Transfer number to 'maxRead'. */
|
||||
};
|
||||
#define TRANSMIT_DONT 0 /* No transfer to do. */
|
||||
#define TRANSMIT_DOWN 1 /* Transfer to the underlying channel. */
|
||||
#define TRANSMIT_SELF 2 /* Transfer into our channel. */
|
||||
#define TRANSMIT_IBUF 3 /* Transfer to internal input buffer. */
|
||||
#define TRANSMIT_NUM 4 /* Transfer number to 'maxRead'. */
|
||||
|
||||
/*
|
||||
* Codes for 'preserve' of 'ExecuteCallback'.
|
||||
*/
|
||||
|
||||
enum {
|
||||
P_PRESERVE = 1,
|
||||
P_NO_PRESERVE = 0
|
||||
};
|
||||
#define P_PRESERVE 1
|
||||
#define P_NO_PRESERVE 0
|
||||
|
||||
/*
|
||||
* Strings for the action codes delivered to the script implementing a
|
||||
@@ -973,11 +969,11 @@ TransformWideSeekProc(
|
||||
|
||||
if (parentWideSeekProc == NULL) {
|
||||
/*
|
||||
* We're transferring to narrow seeks at this point; this is a bit
|
||||
* complex because we have to check whether the seek is possible first
|
||||
* (i.e. whether we are losing information in truncating the bits of
|
||||
* the offset). Luckily, there's a defined error for what happens when
|
||||
* trying to go out of the representable range.
|
||||
* We're transferring to narrow seeks at this point; this is a bit complex
|
||||
* because we have to check whether the seek is possible first (i.e.
|
||||
* whether we are losing information in truncating the bits of the
|
||||
* offset). Luckily, there's a defined error for what happens when trying
|
||||
* to go out of the representable range.
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
|
||||
+32
-30
@@ -43,13 +43,13 @@ static int ReflectBlock(ClientData clientData, int mode);
|
||||
static void ReflectThread(ClientData clientData, int action);
|
||||
static int ReflectEventRun(Tcl_Event *ev, int flags);
|
||||
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
|
||||
#endif /* TCL_THREADS */
|
||||
#endif
|
||||
static long long ReflectSeekWide(ClientData clientData,
|
||||
long long offset, int mode, int *errorCodePtr);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
static int ReflectSeek(ClientData clientData, long offset,
|
||||
int mode, int *errorCodePtr);
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#endif
|
||||
static int ReflectGetOption(ClientData clientData,
|
||||
Tcl_Interp *interp, const char *optionName,
|
||||
Tcl_DString *dsPtr);
|
||||
@@ -58,8 +58,8 @@ static int ReflectSetOption(ClientData clientData,
|
||||
const char *newValue);
|
||||
static int ReflectTruncate(ClientData clientData,
|
||||
long long length);
|
||||
static void TimerRunRead(ClientData clientData);
|
||||
static void TimerRunWrite(ClientData clientData);
|
||||
static void TimerRunRead(ClientData clientData);
|
||||
static void TimerRunWrite(ClientData clientData);
|
||||
|
||||
/*
|
||||
* The C layer channel type/driver definition used by the reflection.
|
||||
@@ -80,7 +80,7 @@ static const Tcl_ChannelType tclRChannelType = {
|
||||
ReflectGetOption, /* Get options. NULL'able */
|
||||
ReflectWatch, /* Initialize notifier */
|
||||
NULL, /* Get OS handle from the channel. NULL'able */
|
||||
ReflectClose, /* No close2 support. NULL'able */
|
||||
ReflectClose, /* No close2 support. NULL'able */
|
||||
ReflectBlock, /* Set blocking/nonblocking. NULL'able */
|
||||
NULL, /* Flush channel. Not used by core. NULL'able */
|
||||
NULL, /* Handle events. NULL'able */
|
||||
@@ -104,27 +104,33 @@ typedef struct {
|
||||
* Tcl level part of the channel. NULL here
|
||||
* signals the channel is dead because the
|
||||
* interpreter/thread containing its Tcl
|
||||
* command is gone. */
|
||||
* command is gone.
|
||||
*/
|
||||
#if TCL_THREADS
|
||||
Tcl_ThreadId thread; /* Thread the 'interp' belongs to.
|
||||
* == Handler thread */
|
||||
Tcl_ThreadId owner; /* Thread owning the structure.
|
||||
* == Channel thread */
|
||||
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
|
||||
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
|
||||
#endif
|
||||
Tcl_Obj *cmd; /* Callback command prefix */
|
||||
Tcl_Obj *methods; /* Methods to append to command prefix */
|
||||
Tcl_Obj *name; /* Name of the channel as created */
|
||||
|
||||
int mode; /* Mask of R/W mode */
|
||||
int interest; /* Mask of events the channel is interested
|
||||
* in. */
|
||||
|
||||
int dead; /* Boolean signal that some operations
|
||||
* should no longer be attempted. */
|
||||
Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in
|
||||
* order to call Tcl_NotifyChannel when the
|
||||
* channel is readable */
|
||||
Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in
|
||||
* order to call Tcl_NotifyChannel when the
|
||||
* channel is writable */
|
||||
|
||||
Tcl_TimerToken readTimer; /*
|
||||
A token for the timer that is scheduled in
|
||||
order to call Tcl_NotifyChannel when the
|
||||
channel is readable
|
||||
*/
|
||||
Tcl_TimerToken writeTimer; /*
|
||||
A token for the timer that is scheduled in
|
||||
order to call Tcl_NotifyChannel when the
|
||||
channel is writable
|
||||
*/
|
||||
|
||||
/*
|
||||
* Note regarding the usage of timers.
|
||||
@@ -690,8 +696,7 @@ TclChanCreateObjCmd(
|
||||
* as the actual channel type.
|
||||
*/
|
||||
|
||||
Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
|
||||
ckalloc(sizeof(Tcl_ChannelType));
|
||||
Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType));
|
||||
|
||||
memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
|
||||
|
||||
@@ -897,7 +902,7 @@ TclChanPostEventObjCmd(
|
||||
* have gone seriously haywire.
|
||||
*/
|
||||
|
||||
chan = (Tcl_Channel) Tcl_GetHashValue(hPtr);
|
||||
chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
|
||||
chanTypePtr = Tcl_GetChannelType(chan);
|
||||
|
||||
/*
|
||||
@@ -1151,7 +1156,7 @@ TclChanCaughtErrorBypass(
|
||||
* ReflectClose --
|
||||
*
|
||||
* This function is invoked when the channel is closed, to delete the
|
||||
* driver specific instance data.
|
||||
* driver-specific instance data.
|
||||
*
|
||||
* Results:
|
||||
* A posix error.
|
||||
@@ -1166,7 +1171,7 @@ static int
|
||||
ReflectClose(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int flags)
|
||||
int flags)
|
||||
{
|
||||
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
|
||||
int result; /* Result code for 'close' */
|
||||
@@ -1184,8 +1189,8 @@ ReflectClose(
|
||||
/*
|
||||
* This call comes from TclFinalizeIOSystem. There are no
|
||||
* interpreters, and therefore we cannot call upon the handler command
|
||||
* anymore. Threading is irrelevant as well. We simply clean up all
|
||||
* our C level data structures and leave the Tcl level to the other
|
||||
* anymore. Threading is irrelevant as well. Simply clean up all
|
||||
* the C level data structures and leave the Tcl level to the other
|
||||
* finalization functions.
|
||||
*/
|
||||
|
||||
@@ -2085,7 +2090,7 @@ ReflectTruncate(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -2585,8 +2590,7 @@ static ReflectedChannelMap *
|
||||
GetReflectedChannelMap(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)
|
||||
Tcl_GetAssocData(interp, RCMKEY, NULL);
|
||||
ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);
|
||||
|
||||
if (rcmPtr == NULL) {
|
||||
rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
|
||||
@@ -2789,8 +2793,7 @@ GetThreadReflectedChannelMap(void)
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (!tsdPtr->rcmPtr) {
|
||||
tsdPtr->rcmPtr = (ReflectedChannelMap *)
|
||||
ckalloc(sizeof(ReflectedChannelMap));
|
||||
tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
|
||||
Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
|
||||
Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
|
||||
}
|
||||
@@ -2908,8 +2911,7 @@ DeleteThreadReflectedChannelMap(
|
||||
hPtr != NULL;
|
||||
hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
|
||||
Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
|
||||
ReflectedChannel *rcPtr = (ReflectedChannel *)
|
||||
Tcl_GetChannelInstanceData(chan);
|
||||
ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
|
||||
|
||||
MarkDead(rcPtr);
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
|
||||
+41
-41
@@ -476,10 +476,8 @@ static int TransformLimit(ReflectedTransform *rtPtr,
|
||||
* Operation codes for TransformFlush().
|
||||
*/
|
||||
|
||||
enum {
|
||||
FLUSH_WRITE = 1,
|
||||
FLUSH_DISCARD = 0
|
||||
};
|
||||
#define FLUSH_WRITE 1
|
||||
#define FLUSH_DISCARD 0
|
||||
|
||||
/*
|
||||
* Main methods to plug into the 'chan' ensemble'. ==================
|
||||
@@ -1115,6 +1113,7 @@ ReflectInput(
|
||||
goto stop;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* The buffer is exhausted, but the caller wants even more. We now
|
||||
* have to go to the underlying channel, get more bytes and then
|
||||
@@ -1150,6 +1149,7 @@ ReflectInput(
|
||||
goto stop;
|
||||
}
|
||||
|
||||
|
||||
readBytes = Tcl_ReadRaw(rtPtr->parent,
|
||||
(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
|
||||
if (readBytes < 0) {
|
||||
@@ -1165,10 +1165,11 @@ ReflectInput(
|
||||
}
|
||||
|
||||
/*
|
||||
* Either the down channel is not blocked (a real error) or it is
|
||||
* and there are gotBytes==0 byte copied so far. In either case,
|
||||
* pass up the error, so we either report any real error, or do
|
||||
* not mistakenly signal EOF by returning 0 to the caller.
|
||||
* Either the down channel is not blocked (a real error)
|
||||
* or it is and there are gotBytes==0 byte copied so far.
|
||||
* In either case, pass up the error, so we either report
|
||||
* any real error, or do not mistakenly signal EOF by
|
||||
* returning 0 to the caller.
|
||||
*/
|
||||
|
||||
*errorCodePtr = Tcl_GetErrno();
|
||||
@@ -1176,6 +1177,7 @@ ReflectInput(
|
||||
}
|
||||
|
||||
if (readBytes == 0) {
|
||||
|
||||
/*
|
||||
* Zero returned from Tcl_ReadRaw() always indicates EOF
|
||||
* on the down channel.
|
||||
@@ -1183,26 +1185,26 @@ ReflectInput(
|
||||
|
||||
rtPtr->eofPending = 1;
|
||||
|
||||
/*
|
||||
* Now this is a bit different. The partial data waiting is
|
||||
* converted and returned.
|
||||
*/
|
||||
|
||||
if (HAS(rtPtr->methods, METH_DRAIN)) {
|
||||
if (!TransformDrain(rtPtr, errorCodePtr)) {
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
|
||||
if (ResultLength(&rtPtr->result) == 0) {
|
||||
/*
|
||||
* The drain delivered nothing.
|
||||
* Now this is a bit different. The partial data waiting is
|
||||
* converted and returned.
|
||||
*/
|
||||
|
||||
goto stop;
|
||||
}
|
||||
if (HAS(rtPtr->methods, METH_DRAIN)) {
|
||||
if (!TransformDrain(rtPtr, errorCodePtr)) {
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
|
||||
continue; /* at: while (toRead > 0) */
|
||||
if (ResultLength(&rtPtr->result) == 0) {
|
||||
/*
|
||||
* The drain delivered nothing.
|
||||
*/
|
||||
|
||||
goto stop;
|
||||
}
|
||||
|
||||
continue; /* at: while (toRead > 0) */
|
||||
} /* readBytes == 0 */
|
||||
|
||||
/*
|
||||
@@ -1259,7 +1261,7 @@ ReflectOutput(
|
||||
int toWrite,
|
||||
int *errorCodePtr)
|
||||
{
|
||||
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
|
||||
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
|
||||
|
||||
/*
|
||||
* The following check can be done before thread redirection, because we
|
||||
@@ -1386,15 +1388,16 @@ ReflectSeekWide(
|
||||
curPos = -1;
|
||||
} else {
|
||||
curPos = Tcl_ChannelSeekProc(parent->typePtr)(
|
||||
parent->instanceData, offset, seekMode, errorCodePtr);
|
||||
parent->instanceData, offset, seekMode,
|
||||
errorCodePtr);
|
||||
}
|
||||
#else
|
||||
*errorCodePtr = EINVAL;
|
||||
curPos = -1;
|
||||
#endif
|
||||
} else {
|
||||
curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData,
|
||||
offset, seekMode, errorCodePtr);
|
||||
curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
|
||||
seekMode, errorCodePtr);
|
||||
}
|
||||
if (curPos == -1) {
|
||||
Tcl_SetErrno(*errorCodePtr);
|
||||
@@ -1420,7 +1423,8 @@ ReflectSeek(
|
||||
* routine.
|
||||
*/
|
||||
|
||||
return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr);
|
||||
return ReflectSeekWide(clientData, offset, seekMode,
|
||||
errorCodePtr);
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -2038,7 +2042,6 @@ InvokeTclMethod(
|
||||
* This is complex and ugly, and would be completely unnecessary
|
||||
* if we only added support for a TCL_FORBID_EXCEPTIONS flag.
|
||||
*/
|
||||
|
||||
if (result != TCL_ERROR) {
|
||||
Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
|
||||
int cmdLen;
|
||||
@@ -2111,12 +2114,10 @@ static ReflectedTransformMap *
|
||||
GetReflectedTransformMap(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)
|
||||
Tcl_GetAssocData(interp, RTMKEY, NULL);
|
||||
ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL);
|
||||
|
||||
if (rtmPtr == NULL) {
|
||||
rtmPtr = (ReflectedTransformMap *)
|
||||
ckalloc(sizeof(ReflectedTransformMap));
|
||||
rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
|
||||
Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
|
||||
Tcl_SetAssocData(interp, RTMKEY,
|
||||
(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
|
||||
@@ -2279,8 +2280,7 @@ GetThreadReflectedTransformMap(void)
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (!tsdPtr->rtmPtr) {
|
||||
tsdPtr->rtmPtr = (ReflectedTransformMap *)
|
||||
ckalloc(sizeof(ReflectedTransformMap));
|
||||
tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
|
||||
Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
|
||||
Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
|
||||
}
|
||||
@@ -2415,8 +2415,8 @@ ForwardOpToOwnerThread(
|
||||
* Create and initialize the event and data structures.
|
||||
*/
|
||||
|
||||
evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
|
||||
resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
|
||||
evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent));
|
||||
resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult));
|
||||
|
||||
evPtr->event.proc = ForwardProc;
|
||||
evPtr->resultPtr = resultPtr;
|
||||
@@ -2759,7 +2759,7 @@ static void
|
||||
SrcExitProc(
|
||||
ClientData clientData)
|
||||
{
|
||||
ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
|
||||
ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardParam *paramPtr;
|
||||
|
||||
@@ -3230,7 +3230,7 @@ TransformDrain(
|
||||
} else
|
||||
#endif /* TCL_THREADS */
|
||||
{
|
||||
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
|
||||
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
|
||||
Tcl_SetChannelError(rtPtr->chan, resObj);
|
||||
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
|
||||
*errorCodePtr = EINVAL;
|
||||
@@ -3285,7 +3285,7 @@ TransformFlush(
|
||||
} else
|
||||
#endif /* TCL_THREADS */
|
||||
{
|
||||
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
|
||||
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
|
||||
Tcl_SetChannelError(rtPtr->chan, resObj);
|
||||
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
|
||||
*errorCodePtr = EINVAL;
|
||||
|
||||
+15
-13
@@ -2646,8 +2646,9 @@ Tcl_FSGetCwd(
|
||||
norm = TclFSNormalizeAbsolutePath(interp,retVal);
|
||||
if (norm != NULL) {
|
||||
/*
|
||||
* Assign to global storage the pathname of the current directory
|
||||
* and copy it into thread-local storage as well.
|
||||
* Assign to global storage the pathname of the current
|
||||
* directory and copy it into thread-local storage as
|
||||
* well.
|
||||
*
|
||||
* At system startup multiple threads could in principle
|
||||
* call this function simultaneously, which is a little
|
||||
@@ -3789,10 +3790,12 @@ Tcl_FSListVolumes(void)
|
||||
|
||||
if (thisFsVolumes != NULL) {
|
||||
Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
|
||||
/* The refCount of each list returned by a `listVolumesProc` is
|
||||
* already incremented. Do not hang onto the list, though. It
|
||||
* belongs to the filesystem. Add its contents to * the result
|
||||
* we are building, and then decrement the refCount. */
|
||||
/*
|
||||
* The refCount of each list returned by a `listVolumesProc`
|
||||
* is already incremented. Do not hang onto the list, though.
|
||||
* It belongs to the filesystem. Add its contents to the
|
||||
* result we are building, and then decrement the refCount.
|
||||
*/
|
||||
Tcl_DecrRefCount(thisFsVolumes);
|
||||
}
|
||||
}
|
||||
@@ -4365,15 +4368,14 @@ Tcl_FSCreateDirectory(
|
||||
|
||||
int
|
||||
Tcl_FSCopyDirectory(
|
||||
Tcl_Obj *srcPathPtr, /*
|
||||
* The pathname of the directory to be copied.
|
||||
*/
|
||||
Tcl_Obj *srcPathPtr, /* The pathname of the directory to be
|
||||
* copied. */
|
||||
Tcl_Obj *destPathPtr, /* The pathname of the target directory. */
|
||||
Tcl_Obj **errorPtr) /* If not NULL, and there is an error, a place
|
||||
* to store a pointer to a new object, with
|
||||
* its refCount already incremented, and
|
||||
* containing the pathname name of file
|
||||
* causing the error. */
|
||||
* to store a pointer to a new object, with
|
||||
* its refCount already incremented, and
|
||||
* containing the pathname name of file
|
||||
* causing the error. */
|
||||
{
|
||||
int retVal = -1;
|
||||
const Tcl_Filesystem *fsPtr, *fsPtr2;
|
||||
|
||||
@@ -184,7 +184,7 @@ declare 41 {
|
||||
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
|
||||
}
|
||||
declare 42 {
|
||||
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
}
|
||||
# Removed in 8.5a2:
|
||||
#declare 43 {
|
||||
@@ -409,7 +409,7 @@ declare 98 {
|
||||
# Tcl_Obj *objPtr, int flags)
|
||||
#}
|
||||
declare 101 {
|
||||
CONST86 char *TclSetPreInitScript(const char *string)
|
||||
const char *TclSetPreInitScript(const char *string)
|
||||
}
|
||||
declare 102 {
|
||||
void TclSetupEnv(Tcl_Interp *interp)
|
||||
|
||||
+531
-716
File diff suppressed because it is too large
Load Diff
@@ -153,7 +153,7 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str,
|
||||
/* 41 */
|
||||
EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command);
|
||||
/* 42 */
|
||||
EXTERN CONST86 char * TclpGetUserHome(const char *name,
|
||||
EXTERN const char * TclpGetUserHome(const char *name,
|
||||
Tcl_DString *bufferPtr);
|
||||
/* Slot 43 is reserved */
|
||||
/* 44 */
|
||||
@@ -264,7 +264,7 @@ EXTERN int TclServiceIdle(void);
|
||||
/* Slot 99 is reserved */
|
||||
/* Slot 100 is reserved */
|
||||
/* 101 */
|
||||
EXTERN CONST86 char * TclSetPreInitScript(const char *string);
|
||||
EXTERN const char * TclSetPreInitScript(const char *string);
|
||||
/* 102 */
|
||||
EXTERN void TclSetupEnv(Tcl_Interp *interp);
|
||||
/* 103 */
|
||||
@@ -710,7 +710,7 @@ typedef struct TclIntStubs {
|
||||
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
|
||||
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
|
||||
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
|
||||
CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
|
||||
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
|
||||
void (*reserved43)(void);
|
||||
int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
|
||||
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
|
||||
@@ -769,7 +769,7 @@ typedef struct TclIntStubs {
|
||||
int (*tclServiceIdle) (void); /* 98 */
|
||||
void (*reserved99)(void);
|
||||
void (*reserved100)(void);
|
||||
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
const char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
|
||||
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
|
||||
TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
|
||||
@@ -1415,7 +1415,9 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
|
||||
#undef TclGuessPackageName
|
||||
#undef TclUnusedStubEntry
|
||||
#undef TclSetPreInitScript
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define TclSetPreInitScript Tcl_SetPreInitScript
|
||||
# define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0)
|
||||
#endif
|
||||
|
||||
|
||||
+14
-14
@@ -195,19 +195,19 @@ struct LimitHandler {
|
||||
};
|
||||
|
||||
/*
|
||||
* Values for bits in the LimitHandler flags field.
|
||||
* Values for the LimitHandler flags field.
|
||||
* LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
|
||||
* processed; handlers are never to be entered reentrantly.
|
||||
* LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
|
||||
* should not normally be observed because when a handler is
|
||||
* deleted it is also spliced out of the list of handlers, but
|
||||
* even so we will be careful.
|
||||
*/
|
||||
|
||||
enum {
|
||||
LIMIT_HANDLER_ACTIVE = 1, /* Whether the handler is currently being
|
||||
* processed; handlers are never to be entered
|
||||
* reentrantly. */
|
||||
LIMIT_HANDLER_DELETED = 2 /* Whether the handler has been deleted. This
|
||||
* should not normally be observed because
|
||||
* when a handler is deleted it is also
|
||||
* spliced out of the list of handlers, but
|
||||
* even so we will be careful. */
|
||||
};
|
||||
#define LIMIT_HANDLER_ACTIVE 0x01
|
||||
#define LIMIT_HANDLER_DELETED 0x02
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* Prototypes for local static functions:
|
||||
@@ -281,7 +281,7 @@ static Tcl_ObjCmdProc NRChildCmd;
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclSetPreInitScript --
|
||||
* Tcl_SetPreInitScript --
|
||||
*
|
||||
* This routine is used to change the value of the internal variable,
|
||||
* tclPreInitScript.
|
||||
@@ -296,12 +296,12 @@ static Tcl_ObjCmdProc NRChildCmd;
|
||||
*/
|
||||
|
||||
const char *
|
||||
TclSetPreInitScript(
|
||||
Tcl_SetPreInitScript(
|
||||
const char *string) /* Pointer to a script. */
|
||||
{
|
||||
const char *prevString = tclPreInitScript;
|
||||
tclPreInitScript = string;
|
||||
return(prevString);
|
||||
return prevString;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+18
-16
@@ -75,19 +75,21 @@ typedef struct Link {
|
||||
|
||||
/*
|
||||
* Definitions for flag bits:
|
||||
* LINK_READ_ONLY - 1 means errors should be generated if Tcl
|
||||
* script attempts to write variable.
|
||||
* LINK_BEING_UPDATED - 1 means that a call to Tcl_UpdateLinkedVar is
|
||||
* in progress for this variable, so trace
|
||||
* callbacks on the variable should be ignored.
|
||||
* LINK_ALLOC_ADDR - 1 means linkPtr->addr was allocated on the
|
||||
* heap.
|
||||
* LINK_ALLOC_LAST - 1 means linkPtr->valueLast.p was allocated on
|
||||
* the heap.
|
||||
*/
|
||||
|
||||
enum {
|
||||
LINK_READ_ONLY = 1, /* Errors should be generated if Tcl script
|
||||
* attempts to write variable.*/
|
||||
LINK_BEING_UPDATED = 2, /* A call to Tcl_UpdateLinkedVar is in
|
||||
* progress for this variable, so trace
|
||||
* callbacks on the variable should be
|
||||
* ignored. */
|
||||
LINK_ALLOC_ADDR = 4, /* linkPtr->addr was allocated on the heap. */
|
||||
LINK_ALLOC_LAST = 8 /* linkPtr->valueLast.p was allocated on the
|
||||
* heap. */
|
||||
};
|
||||
#define LINK_READ_ONLY 1
|
||||
#define LINK_BEING_UPDATED 2
|
||||
#define LINK_ALLOC_ADDR 4
|
||||
#define LINK_ALLOC_LAST 8
|
||||
|
||||
/*
|
||||
* Forward references to functions defined later in this file:
|
||||
@@ -108,11 +110,11 @@ static int SetInvalidRealFromAny(Tcl_Interp *interp,
|
||||
*/
|
||||
|
||||
static Tcl_ObjType invalidRealType = {
|
||||
"invalidReal", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL /* setFromAnyProc */
|
||||
"invalidReal", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL /* setFromAnyProc */
|
||||
};
|
||||
|
||||
/*
|
||||
|
||||
+141
-84
@@ -12,6 +12,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
|
||||
/*
|
||||
* The following structure describes a library that has been loaded either
|
||||
* dynamically (with the "load" command) or statically (as indicated by a call
|
||||
@@ -93,8 +94,20 @@ typedef struct InterpLibrary {
|
||||
* Prototypes for functions that are private to this file:
|
||||
*/
|
||||
|
||||
static void LoadCleanupProc(ClientData clientData,
|
||||
Tcl_Interp *interp);
|
||||
static void LoadCleanupProc(ClientData clientData,
|
||||
Tcl_Interp *interp);
|
||||
static int IsStatic (LoadedLibrary *libraryPtr);
|
||||
static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target,
|
||||
LoadedLibrary *library, int keepLibrary,
|
||||
const char *fullFileName, int interpExiting);
|
||||
|
||||
|
||||
static int
|
||||
IsStatic (LoadedLibrary *libraryPtr) {
|
||||
int res;
|
||||
res = (libraryPtr->fileName[0] == '\0');
|
||||
return res;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -331,7 +344,11 @@ Tcl_LoadObjCmd(
|
||||
pkgGuess += 3;
|
||||
}
|
||||
#endif /* __CYGWIN__ */
|
||||
if ((pkgGuess[0] == 't') && (pkgGuess[1] == 'c')
|
||||
if (((pkgGuess[0] == 't')
|
||||
#ifdef MAC_OSX_TCL
|
||||
|| (pkgGuess[0] == 'T')
|
||||
#endif
|
||||
) && (pkgGuess[1] == 'c')
|
||||
&& (pkgGuess[2] == 'l')) {
|
||||
pkgGuess += 3;
|
||||
}
|
||||
@@ -547,12 +564,10 @@ Tcl_UnloadObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_Interp *target; /* Which interpreter to unload from. */
|
||||
LoadedLibrary *libraryPtr, *defaultPtr;
|
||||
LoadedLibrary *libraryPtr;
|
||||
Tcl_DString pfx, tmp;
|
||||
Tcl_LibraryUnloadProc *unloadProc;
|
||||
InterpLibrary *ipFirstPtr, *ipPtr;
|
||||
int i, index, code, complain = 1, keepLibrary = 0;
|
||||
int trustedRefCount = -1, safeRefCount = -1;
|
||||
const char *fullFileName = "";
|
||||
const char *prefix;
|
||||
static const char *const options[] = {
|
||||
@@ -646,12 +661,11 @@ Tcl_UnloadObjCmd(
|
||||
* - Its prefix and file match the once we're looking for.
|
||||
* - Its file matches, and we weren't given a prefix.
|
||||
* - Its prefix matches, the file name was specified as empty, and there is
|
||||
* only no statically loaded library with the same prefix.
|
||||
* no statically loaded library with the same prefix.
|
||||
*/
|
||||
|
||||
Tcl_MutexLock(&libraryMutex);
|
||||
|
||||
defaultPtr = NULL;
|
||||
for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
|
||||
int namesMatch, filesMatch;
|
||||
|
||||
@@ -677,9 +691,6 @@ Tcl_UnloadObjCmd(
|
||||
if (filesMatch && (namesMatch || (prefix == NULL))) {
|
||||
break;
|
||||
}
|
||||
if (namesMatch && (fullFileName[0] == 0)) {
|
||||
defaultPtr = libraryPtr;
|
||||
}
|
||||
if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
|
||||
break;
|
||||
}
|
||||
@@ -741,6 +752,34 @@ Tcl_UnloadObjCmd(
|
||||
goto done;
|
||||
}
|
||||
|
||||
code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName, 0);
|
||||
|
||||
done:
|
||||
Tcl_DStringFree(&pfx);
|
||||
Tcl_DStringFree(&tmp);
|
||||
if (!complain && (code != TCL_OK)) {
|
||||
code = TCL_OK;
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
return code;
|
||||
}
|
||||
|
||||
static int
|
||||
UnloadLibrary(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Interp *target,
|
||||
LoadedLibrary *libraryPtr,
|
||||
int keepLibrary,
|
||||
const char *fullFileName,
|
||||
int interpExiting
|
||||
)
|
||||
{
|
||||
int code;
|
||||
InterpLibrary *ipFirstPtr, *ipPtr;
|
||||
LoadedLibrary *iterLibraryPtr;
|
||||
int trustedRefCount = -1, safeRefCount = -1;
|
||||
Tcl_LibraryUnloadProc *unloadProc = NULL;
|
||||
|
||||
/*
|
||||
* Ensure that the DLL can be unloaded. If it is a trusted interpreter,
|
||||
* libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
|
||||
@@ -749,28 +788,34 @@ Tcl_UnloadObjCmd(
|
||||
|
||||
if (Tcl_IsSafe(target)) {
|
||||
if (libraryPtr->safeUnloadProc == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"file \"%s\" cannot be unloaded under a safe interpreter",
|
||||
fullFileName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
|
||||
NULL);
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
if (!interpExiting) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"file \"%s\" cannot be unloaded under a safe interpreter",
|
||||
fullFileName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
|
||||
NULL);
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
unloadProc = libraryPtr->safeUnloadProc;
|
||||
} else {
|
||||
if (libraryPtr->unloadProc == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"file \"%s\" cannot be unloaded under a trusted interpreter",
|
||||
fullFileName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
|
||||
NULL);
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
if (!interpExiting) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"file \"%s\" cannot be unloaded under a trusted interpreter",
|
||||
fullFileName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
|
||||
NULL);
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
unloadProc = libraryPtr->unloadProc;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* We are ready to unload the library. First, evaluate the unload
|
||||
* function. If this fails, we cannot proceed with unload. Also, we must
|
||||
@@ -781,34 +826,69 @@ Tcl_UnloadObjCmd(
|
||||
* after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed.
|
||||
*/
|
||||
|
||||
code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
|
||||
if (!keepLibrary) {
|
||||
Tcl_MutexLock(&libraryMutex);
|
||||
trustedRefCount = libraryPtr->interpRefCount;
|
||||
safeRefCount = libraryPtr->safeInterpRefCount;
|
||||
Tcl_MutexUnlock(&libraryMutex);
|
||||
if (unloadProc == NULL) {
|
||||
code = TCL_OK;
|
||||
} else {
|
||||
code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
|
||||
if (!keepLibrary) {
|
||||
Tcl_MutexLock(&libraryMutex);
|
||||
trustedRefCount = libraryPtr->interpRefCount;
|
||||
safeRefCount = libraryPtr->safeInterpRefCount;
|
||||
Tcl_MutexUnlock(&libraryMutex);
|
||||
|
||||
if (Tcl_IsSafe(target)) {
|
||||
safeRefCount--;
|
||||
} else {
|
||||
trustedRefCount--;
|
||||
}
|
||||
if (Tcl_IsSafe(target)) {
|
||||
safeRefCount--;
|
||||
} else {
|
||||
trustedRefCount--;
|
||||
}
|
||||
|
||||
if (safeRefCount <= 0 && trustedRefCount <= 0) {
|
||||
code = TCL_UNLOAD_DETACH_FROM_PROCESS;
|
||||
if (safeRefCount <= 0 && trustedRefCount <= 0) {
|
||||
code = TCL_UNLOAD_DETACH_FROM_PROCESS;
|
||||
}
|
||||
}
|
||||
code = unloadProc(target, code);
|
||||
}
|
||||
code = unloadProc(target, code);
|
||||
|
||||
|
||||
if (code != TCL_OK) {
|
||||
Tcl_TransferResult(target, code, interp);
|
||||
goto done;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Remove this library from the interpreter's library cache.
|
||||
*/
|
||||
|
||||
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
|
||||
ipPtr = ipFirstPtr;
|
||||
if (ipPtr->libraryPtr == libraryPtr) {
|
||||
ipFirstPtr = ipFirstPtr->nextPtr;
|
||||
} else {
|
||||
InterpLibrary *ipPrevPtr;
|
||||
|
||||
for (ipPrevPtr = ipPtr; ipPtr != NULL;
|
||||
ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
|
||||
if (ipPtr->libraryPtr == libraryPtr) {
|
||||
ipPrevPtr->nextPtr = ipPtr->nextPtr;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
ckfree(ipPtr);
|
||||
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr);
|
||||
|
||||
|
||||
if (IsStatic(libraryPtr)) {
|
||||
goto done;
|
||||
}
|
||||
|
||||
/*
|
||||
* The unload function executed fine. Examine the reference count to see
|
||||
* if we unload the DLL.
|
||||
*/
|
||||
|
||||
|
||||
Tcl_MutexLock(&libraryMutex);
|
||||
if (Tcl_IsSafe(target)) {
|
||||
libraryPtr->safeInterpRefCount--;
|
||||
@@ -850,51 +930,29 @@ Tcl_UnloadObjCmd(
|
||||
* it's been unloaded.
|
||||
*/
|
||||
|
||||
if (libraryPtr->fileName[0] != '\0') {
|
||||
if (!IsStatic(libraryPtr)) {
|
||||
Tcl_MutexLock(&libraryMutex);
|
||||
if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) {
|
||||
/*
|
||||
* Remove this library from the loaded library cache.
|
||||
*/
|
||||
|
||||
defaultPtr = libraryPtr;
|
||||
if (defaultPtr == firstLibraryPtr) {
|
||||
iterLibraryPtr = libraryPtr;
|
||||
if (iterLibraryPtr == firstLibraryPtr) {
|
||||
firstLibraryPtr = libraryPtr->nextPtr;
|
||||
} else {
|
||||
for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
|
||||
libraryPtr = libraryPtr->nextPtr) {
|
||||
if (libraryPtr->nextPtr == defaultPtr) {
|
||||
libraryPtr->nextPtr = defaultPtr->nextPtr;
|
||||
if (libraryPtr->nextPtr == iterLibraryPtr) {
|
||||
libraryPtr->nextPtr = iterLibraryPtr->nextPtr;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Remove this library from the interpreter's library cache.
|
||||
*/
|
||||
|
||||
ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
|
||||
ipPtr = ipFirstPtr;
|
||||
if (ipPtr->libraryPtr == defaultPtr) {
|
||||
ipFirstPtr = ipFirstPtr->nextPtr;
|
||||
} else {
|
||||
InterpLibrary *ipPrevPtr;
|
||||
|
||||
for (ipPrevPtr = ipPtr; ipPtr != NULL;
|
||||
ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
|
||||
if (ipPtr->libraryPtr == defaultPtr) {
|
||||
ipPrevPtr->nextPtr = ipPtr->nextPtr;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
|
||||
ipFirstPtr);
|
||||
ckfree(defaultPtr->fileName);
|
||||
ckfree(defaultPtr->prefix);
|
||||
ckfree(defaultPtr);
|
||||
ckfree(ipPtr);
|
||||
ckfree(iterLibraryPtr->fileName);
|
||||
ckfree(iterLibraryPtr->prefix);
|
||||
ckfree(iterLibraryPtr);
|
||||
Tcl_MutexUnlock(&libraryMutex);
|
||||
} else {
|
||||
code = TCL_ERROR;
|
||||
@@ -911,12 +969,6 @@ Tcl_UnloadObjCmd(
|
||||
}
|
||||
|
||||
done:
|
||||
Tcl_DStringFree(&pfx);
|
||||
Tcl_DStringFree(&tmp);
|
||||
if (!complain && (code != TCL_OK)) {
|
||||
code = TCL_OK;
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
return code;
|
||||
}
|
||||
|
||||
@@ -989,6 +1041,8 @@ Tcl_StaticLibrary(
|
||||
libraryPtr->loadHandle = NULL;
|
||||
libraryPtr->initProc = initProc;
|
||||
libraryPtr->safeInitProc = safeInitProc;
|
||||
libraryPtr->unloadProc = NULL;
|
||||
libraryPtr->safeUnloadProc = NULL;
|
||||
Tcl_MutexLock(&libraryMutex);
|
||||
libraryPtr->nextPtr = firstLibraryPtr;
|
||||
firstLibraryPtr = libraryPtr;
|
||||
@@ -1137,17 +1191,20 @@ TclGetLoadedLibraries(
|
||||
|
||||
static void
|
||||
LoadCleanupProc(
|
||||
ClientData clientData, /* Pointer to first InterpLibrary structure
|
||||
TCL_UNUSED(ClientData), /* Pointer to first InterpLibrary structure
|
||||
* for interp. */
|
||||
TCL_UNUSED(Tcl_Interp *))
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
InterpLibrary *ipPtr, *nextPtr;
|
||||
InterpLibrary *ipPtr;
|
||||
LoadedLibrary *libraryPtr;
|
||||
|
||||
ipPtr = (InterpLibrary *)clientData;
|
||||
while (ipPtr != NULL) {
|
||||
nextPtr = ipPtr->nextPtr;
|
||||
ckfree(ipPtr);
|
||||
ipPtr = nextPtr;
|
||||
while (1) {
|
||||
ipPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
|
||||
if (ipPtr == NULL) {
|
||||
break;
|
||||
}
|
||||
libraryPtr = ipPtr->libraryPtr;
|
||||
UnloadLibrary(interp, interp, libraryPtr, 0 ,"", 1);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1192,7 +1249,7 @@ TclFinalizeLoad(void)
|
||||
* it has been unloaded.
|
||||
*/
|
||||
|
||||
if (libraryPtr->fileName[0] != '\0') {
|
||||
if (!IsStatic(libraryPtr)) {
|
||||
Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
|
||||
}
|
||||
#endif
|
||||
|
||||
+103
-80
@@ -306,7 +306,7 @@ Tcl_PushCallFrame(
|
||||
|
||||
/*
|
||||
* TODO: Examine whether it would be better to guard based on NS_DYING
|
||||
* or NS_KILLED. It appears that these are not tested because they can
|
||||
* or NS_TEARDOWN. It appears that these are not tested because they can
|
||||
* be set in a global interp that has been [namespace delete]d, but
|
||||
* which never really completely goes away because of lingering global
|
||||
* things like ::errorInfo and [::unknown] and hidden commands.
|
||||
@@ -986,20 +986,21 @@ Tcl_DeleteNamespace(
|
||||
}
|
||||
|
||||
/*
|
||||
* If the namespace is on the call frame stack, it is marked as "dying"
|
||||
* (NS_DYING is OR'd into its flags): the namespace can't be looked up by
|
||||
* name but its commands and variables are still usable by those active
|
||||
* call frames. When all active call frames referring to the namespace
|
||||
* have been popped from the Tcl stack, Tcl_PopCallFrame will call this
|
||||
* function again to delete everything in the namespace. If no nsName
|
||||
* objects refer to the namespace (i.e., if its refCount is zero), its
|
||||
* commands and variables are deleted and the storage for its namespace
|
||||
* structure is freed. Otherwise, if its refCount is nonzero, the
|
||||
* namespace's commands and variables are deleted but the structure isn't
|
||||
* freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
|
||||
* namespace resolution code to recognize that the namespace is "deleted".
|
||||
* The structure's storage is freed by FreeNsNameInternalRep when its
|
||||
* refCount reaches 0.
|
||||
* If the namespace is on the call frame stack, it is marked as "dying"
|
||||
* (NS_DYING is OR'd into its flags): Contents of the namespace are
|
||||
* still available and visible until the namespace is later marked as
|
||||
* NS_DEAD, and its commands and variables are still usable by any
|
||||
* active call frames referring to th namespace. When all active call
|
||||
* frames referring to the namespace have been popped from the Tcl
|
||||
* stack, Tcl_PopCallFrame calls Tcl_DeleteNamespace again. If no
|
||||
* nsName objects refer to the namespace (i.e., if its refCount is
|
||||
* zero), its commands and variables are deleted and the storage for
|
||||
* its namespace structure is freed. Otherwise, if its refCount is
|
||||
* nonzero, the namespace's commands and variables are deleted but the
|
||||
* structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
|
||||
* flags to allow the namespace resolution code to recognize that the
|
||||
* namespace is "deleted". The structure's storage is freed by
|
||||
* FreeNsNameInternalRep when its refCount reaches 0.
|
||||
*/
|
||||
|
||||
if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
|
||||
@@ -1013,16 +1014,16 @@ Tcl_DeleteNamespace(
|
||||
}
|
||||
}
|
||||
nsPtr->parentPtr = NULL;
|
||||
} else if (!(nsPtr->flags & NS_KILLED)) {
|
||||
} else if (!(nsPtr->flags & NS_TEARDOWN)) {
|
||||
/*
|
||||
* Delete the namespace and everything in it. If this is the global
|
||||
* namespace, then clear it but don't free its storage unless the
|
||||
* interpreter is being torn down. Set the NS_KILLED flag to avoid
|
||||
* interpreter is being torn down. Set the NS_TEARDOWN flag to avoid
|
||||
* recursive calls here - if the namespace is really in the process of
|
||||
* being deleted, ignore any second call.
|
||||
*/
|
||||
|
||||
nsPtr->flags |= (NS_DYING|NS_KILLED);
|
||||
nsPtr->flags |= (NS_DYING|NS_TEARDOWN);
|
||||
|
||||
TclTeardownNamespace(nsPtr);
|
||||
|
||||
@@ -1060,7 +1061,7 @@ Tcl_DeleteNamespace(
|
||||
* get killed later, avoiding mem leaks.
|
||||
*/
|
||||
|
||||
nsPtr->flags &= ~(NS_DYING|NS_KILLED);
|
||||
nsPtr->flags &= ~(NS_DYING|NS_TEARDOWN);
|
||||
}
|
||||
}
|
||||
TclNsDecrRefCount(nsPtr);
|
||||
@@ -1073,6 +1074,83 @@ TclNamespaceDeleted(
|
||||
return (nsPtr->flags & NS_DYING) ? 1 : 0;
|
||||
}
|
||||
|
||||
void
|
||||
TclDeleteNamespaceChildren(
|
||||
Namespace *nsPtr /* Namespace whose children to delete */
|
||||
)
|
||||
{
|
||||
Interp *iPtr = (Interp *) nsPtr->interp;
|
||||
Tcl_HashEntry *entryPtr;
|
||||
int i, unchecked;
|
||||
Tcl_HashSearch search;
|
||||
/*
|
||||
* Delete all the child namespaces.
|
||||
*
|
||||
* BE CAREFUL: When each child is deleted, it divorces itself from its
|
||||
* parent. The hash table can't be proplery traversed if its elements are
|
||||
* being deleted. Because of traces (and the desire to avoid the
|
||||
* quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
|
||||
* f97d4ee020]) copy to a temporary array and then delete all those
|
||||
* namespaces.
|
||||
*
|
||||
* Important: leave the hash table itself still live.
|
||||
*/
|
||||
|
||||
#ifndef BREAK_NAMESPACE_COMPAT
|
||||
unchecked = (nsPtr->childTable.numEntries > 0);
|
||||
while (nsPtr->childTable.numEntries > 0 && unchecked) {
|
||||
int length = nsPtr->childTable.numEntries;
|
||||
Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Namespace *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
|
||||
children[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
unchecked = 0;
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
if (!(children[i]->flags & NS_DYING)) {
|
||||
unchecked = 1;
|
||||
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
|
||||
TclNsDecrRefCount(children[i]);
|
||||
}
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, children);
|
||||
}
|
||||
#else
|
||||
if (nsPtr->childTablePtr != NULL) {
|
||||
unchecked = (nsPtr->childTable.numEntries > 0);
|
||||
while (nsPtr->childTable.numEntries > 0 && unchecked) {
|
||||
int length = nsPtr->childTablePtr->numEntries;
|
||||
Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Namespace *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
|
||||
children[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
unchecked = 0;
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
if (!(children[i]->flags & NS_DYING)) {
|
||||
unchecked = 1;
|
||||
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
|
||||
TclNsDecrRefCount(children[i]);
|
||||
}
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, children);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1181,62 +1259,7 @@ TclTeardownNamespace(
|
||||
nsPtr->commandPathSourceList = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Delete all the child namespaces.
|
||||
*
|
||||
* BE CAREFUL: When each child is deleted, it will divorce itself from its
|
||||
* parent. You can't traverse a hash table properly if its elements are
|
||||
* being deleted. Because of traces (and the desire to avoid the
|
||||
* quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
|
||||
* f97d4ee020]) we copy to a temporary array and then delete all those
|
||||
* namespaces.
|
||||
*
|
||||
* Important: leave the hash table itself still live.
|
||||
*/
|
||||
|
||||
#ifndef BREAK_NAMESPACE_COMPAT
|
||||
while (nsPtr->childTable.numEntries > 0) {
|
||||
int length = nsPtr->childTable.numEntries;
|
||||
Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Namespace *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
|
||||
children[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
|
||||
TclNsDecrRefCount(children[i]);
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, children);
|
||||
}
|
||||
#else
|
||||
if (nsPtr->childTablePtr != NULL) {
|
||||
while (nsPtr->childTablePtr->numEntries > 0) {
|
||||
int length = nsPtr->childTablePtr->numEntries;
|
||||
Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Namespace *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
children[i] = Tcl_GetHashValue(entryPtr);
|
||||
children[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
|
||||
TclNsDecrRefCount(children[i]);
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, children);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
TclDeleteNamespaceChildren(nsPtr);
|
||||
|
||||
/*
|
||||
* Free the namespace's export pattern array.
|
||||
@@ -2618,7 +2641,7 @@ Tcl_FindCommand(
|
||||
&simpleName);
|
||||
if ((realNsPtr != NULL) && (simpleName != NULL)) {
|
||||
if ((cxtNsPtr == realNsPtr)
|
||||
|| !(realNsPtr->flags & NS_DYING)) {
|
||||
|| !(realNsPtr->flags & NS_DEAD)) {
|
||||
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
|
||||
if (entryPtr != NULL) {
|
||||
cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
|
||||
@@ -2630,7 +2653,7 @@ Tcl_FindCommand(
|
||||
* Next, check along the path.
|
||||
*/
|
||||
|
||||
for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
|
||||
for (i=0 ; (cmdPtr == NULL) && i<cxtNsPtr->commandPathLength ; i++) {
|
||||
pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
|
||||
if (pathNsPtr == NULL) {
|
||||
continue;
|
||||
@@ -2639,7 +2662,7 @@ Tcl_FindCommand(
|
||||
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
|
||||
&simpleName);
|
||||
if ((realNsPtr != NULL) && (simpleName != NULL)
|
||||
&& !(realNsPtr->flags & NS_DYING)) {
|
||||
&& !(realNsPtr->flags & NS_DEAD)) {
|
||||
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
|
||||
if (entryPtr != NULL) {
|
||||
cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
|
||||
@@ -2657,7 +2680,7 @@ Tcl_FindCommand(
|
||||
TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
|
||||
&simpleName);
|
||||
if ((realNsPtr != NULL) && (simpleName != NULL)
|
||||
&& !(realNsPtr->flags & NS_DYING)) {
|
||||
&& !(realNsPtr->flags & NS_DEAD)) {
|
||||
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
|
||||
if (entryPtr != NULL) {
|
||||
cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
|
||||
@@ -3277,7 +3300,7 @@ NamespaceDeleteCmd(
|
||||
name = TclGetString(objv[i]);
|
||||
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
|
||||
if ((namespacePtr == NULL)
|
||||
|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
|
||||
|| (((Namespace *) namespacePtr)->flags & NS_TEARDOWN)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"unknown namespace \"%s\" in namespace delete command",
|
||||
TclGetString(objv[i])));
|
||||
|
||||
+3
-5
@@ -105,11 +105,9 @@ typedef struct {
|
||||
* Tcl_NewInstanceMethod.
|
||||
*/
|
||||
|
||||
enum {
|
||||
TCL_OO_METHOD_UNEXPORTED = 0,
|
||||
TCL_OO_METHOD_PUBLIC = 1,
|
||||
TCL_OO_METHOD_PRIVATE = 0x20
|
||||
};
|
||||
#define TCL_OO_METHOD_PUBLIC 1
|
||||
#define TCL_OO_METHOD_UNEXPORTED 0
|
||||
#define TCL_OO_METHOD_PRIVATE 0x20
|
||||
|
||||
/*
|
||||
* The type of some object (or class) metadata. This describes how to delete
|
||||
|
||||
+77
-112
@@ -51,15 +51,38 @@ typedef struct {
|
||||
* Extra flags used for call chain management.
|
||||
*/
|
||||
|
||||
enum {
|
||||
DEFINITE_PROTECTED = 0x100000,
|
||||
DEFINITE_PUBLIC = 0x200000,
|
||||
KNOWN_STATE = (DEFINITE_PROTECTED | DEFINITE_PUBLIC),
|
||||
SPECIAL = (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN),
|
||||
BUILDING_MIXINS = 0x400000,
|
||||
TRAVERSED_MIXIN = 0x800000,
|
||||
OBJECT_MIXIN = 0x1000000
|
||||
};
|
||||
#define DEFINITE_PROTECTED 0x100000
|
||||
#define DEFINITE_PUBLIC 0x200000
|
||||
#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
|
||||
#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
|
||||
#define BUILDING_MIXINS 0x400000
|
||||
#define TRAVERSED_MIXIN 0x800000
|
||||
#define OBJECT_MIXIN 0x1000000
|
||||
#define MIXIN_CONSISTENT(flags) \
|
||||
(((flags) & OBJECT_MIXIN) || \
|
||||
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
|
||||
|
||||
/*
|
||||
* Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
|
||||
* Itcl's special type of private.
|
||||
*/
|
||||
|
||||
#define IS_PUBLIC(mPtr) \
|
||||
(((mPtr)->flags & PUBLIC_METHOD) != 0)
|
||||
#define IS_UNEXPORTED(mPtr) \
|
||||
(((mPtr)->flags & SCOPE_FLAGS) == 0)
|
||||
#define IS_ITCLPRIVATE(mPtr) \
|
||||
(((mPtr)->flags & PRIVATE_METHOD) != 0)
|
||||
#define IS_PRIVATE(mPtr) \
|
||||
(((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
|
||||
#define WANT_PUBLIC(flags) \
|
||||
(((flags) & PUBLIC_METHOD) != 0)
|
||||
#define WANT_UNEXPORTED(flags) \
|
||||
(((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
|
||||
#define WANT_ITCLPRIVATE(flags) \
|
||||
(((flags) & PRIVATE_METHOD) != 0)
|
||||
#define WANT_PRIVATE(flags) \
|
||||
(((flags) & TRUE_PRIVATE_METHOD) != 0)
|
||||
|
||||
/*
|
||||
* Function declarations for things defined in this file.
|
||||
@@ -129,60 +152,7 @@ static const Tcl_ObjType methodNameType = {
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
/*
|
||||
* Inline functions that test flags.
|
||||
*/
|
||||
|
||||
static inline int
|
||||
MixinConsistent(
|
||||
int flags)
|
||||
{
|
||||
return (flags & OBJECT_MIXIN) ||
|
||||
(!(flags & BUILDING_MIXINS) == !(flags & TRAVERSED_MIXIN));
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsPublic(
|
||||
Method *mPtr)
|
||||
{
|
||||
return (mPtr->flags & PUBLIC_METHOD) != 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsUnexported(
|
||||
Method *mPtr)
|
||||
{
|
||||
return (mPtr->flags & SCOPE_FLAGS) == 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
IsPrivate(
|
||||
Method *mPtr)
|
||||
{
|
||||
return (mPtr->flags & TRUE_PRIVATE_METHOD) != 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
WantPublic(
|
||||
int flags)
|
||||
{
|
||||
return (flags & PUBLIC_METHOD) != 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
WantUnexported(
|
||||
int flags)
|
||||
{
|
||||
return (flags & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0;
|
||||
}
|
||||
|
||||
static inline int
|
||||
WantPrivate(
|
||||
int flags)
|
||||
{
|
||||
return (flags & TRUE_PRIVATE_METHOD) != 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -309,16 +279,16 @@ DupMethodNameRep(
|
||||
Tcl_Obj *srcPtr,
|
||||
Tcl_Obj *dstPtr)
|
||||
{
|
||||
StashCallChain(dstPtr, (CallChain *)
|
||||
TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
|
||||
StashCallChain(dstPtr,
|
||||
(CallChain *)TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
|
||||
}
|
||||
|
||||
static void
|
||||
FreeMethodNameRep(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
TclOODeleteChain((CallChain *)
|
||||
TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
|
||||
TclOODeleteChain(
|
||||
(CallChain *)TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -495,10 +465,10 @@ TclOOGetSortedMethodList(
|
||||
|
||||
if (oPtr->methodsPtr) {
|
||||
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
|
||||
if (IsPrivate(mPtr)) {
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
continue;
|
||||
}
|
||||
if (IsUnexported(mPtr) && !WantUnexported(flags)) {
|
||||
if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
|
||||
continue;
|
||||
}
|
||||
AddStandardMethodName(flags, namePtr, mPtr, &names);
|
||||
@@ -509,9 +479,9 @@ TclOOGetSortedMethodList(
|
||||
* Process method names due to private methods on the object's class.
|
||||
*/
|
||||
|
||||
if (WantUnexported(flags)) {
|
||||
if (WANT_UNEXPORTED(flags)) {
|
||||
FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
|
||||
if (IsUnexported(mPtr)) {
|
||||
if (IS_UNEXPORTED(mPtr)) {
|
||||
AddStandardMethodName(flags, namePtr, mPtr, &names);
|
||||
}
|
||||
}
|
||||
@@ -581,7 +551,7 @@ TclOOGetSortedClassMethodList(
|
||||
* Process private method names if we should. [TIP 500]
|
||||
*/
|
||||
|
||||
if (WantPrivate(flags)) {
|
||||
if (WANT_PRIVATE(flags)) {
|
||||
AddPrivateMethodNames(&clsPtr->classMethods, &names);
|
||||
flags &= ~TRUE_PRIVATE_METHOD;
|
||||
}
|
||||
@@ -645,7 +615,7 @@ SortMethodNames(
|
||||
|
||||
strings = (const char **)ckalloc(sizeof(char *) * namesPtr->numEntries);
|
||||
FOREACH_HASH(namePtr, isWanted, namesPtr) {
|
||||
if (!WantPublic(flags) || (PTR2INT(isWanted) & IN_LIST)) {
|
||||
if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
|
||||
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
|
||||
continue;
|
||||
}
|
||||
@@ -796,7 +766,7 @@ AddPrivateMethodNames(
|
||||
Tcl_Obj *namePtr;
|
||||
|
||||
FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
|
||||
if (IsPrivate(mPtr)) {
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
int isNew;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
|
||||
@@ -812,13 +782,13 @@ AddStandardMethodName(
|
||||
Method *mPtr,
|
||||
Tcl_HashTable *namesPtr)
|
||||
{
|
||||
if (!IsPrivate(mPtr)) {
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
int isNew;
|
||||
Tcl_HashEntry *hPtr =
|
||||
Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
|
||||
|
||||
if (isNew) {
|
||||
int isWanted = (!WantPublic(flags) || IsPublic(mPtr))
|
||||
int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
|
||||
? IN_LIST : 0;
|
||||
|
||||
isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
|
||||
@@ -866,7 +836,7 @@ AddInstancePrivateToCallContext(
|
||||
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
|
||||
if (hPtr != NULL) {
|
||||
mPtr = (Method *)Tcl_GetHashValue(hPtr);
|
||||
if (IsPrivate(mPtr)) {
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
|
||||
donePrivate = 1;
|
||||
}
|
||||
@@ -916,9 +886,9 @@ AddSimpleChainToCallContext(
|
||||
|
||||
if (hPtr != NULL) {
|
||||
mPtr = (Method *)Tcl_GetHashValue(hPtr);
|
||||
if (!IsPrivate(mPtr)) {
|
||||
if (WantPublic(flags)) {
|
||||
if (!IsPublic(mPtr)) {
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
if (WANT_PUBLIC(flags)) {
|
||||
if (!IS_PUBLIC(mPtr)) {
|
||||
blockedUnexported = 1;
|
||||
} else {
|
||||
flags |= DEFINITE_PUBLIC;
|
||||
@@ -946,7 +916,7 @@ AddSimpleChainToCallContext(
|
||||
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
|
||||
if (hPtr != NULL) {
|
||||
mPtr = (Method *)Tcl_GetHashValue(hPtr);
|
||||
if (!IsPrivate(mPtr)) {
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
|
||||
flags);
|
||||
}
|
||||
@@ -1009,7 +979,7 @@ AddMethodToCallChain(
|
||||
* This is also where we enforce mixin-consistency.
|
||||
*/
|
||||
|
||||
if (mPtr == NULL || mPtr->typePtr == NULL || !MixinConsistent(flags)) {
|
||||
if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -1025,8 +995,8 @@ AddMethodToCallChain(
|
||||
* should be sufficient for [incr Tcl] support though.
|
||||
*/
|
||||
|
||||
if (!WantUnexported(callPtr->flags)
|
||||
&& IsUnexported(mPtr)
|
||||
if (!WANT_UNEXPORTED(callPtr->flags)
|
||||
&& IS_UNEXPORTED(mPtr)
|
||||
&& (mPtr->declaringClassPtr != NULL)
|
||||
&& (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
|
||||
return;
|
||||
@@ -1186,7 +1156,7 @@ TclOOGetCallContext(
|
||||
if (cacheInThisObj == NULL) {
|
||||
cacheInThisObj = methodNameObj;
|
||||
}
|
||||
if (flags & (SPECIAL|FILTER_HANDLING) || (oPtr->flags & FILTER_HANDLING)) {
|
||||
if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
|
||||
hPtr = NULL;
|
||||
doFilters = 0;
|
||||
|
||||
@@ -1220,7 +1190,7 @@ TclOOGetCallContext(
|
||||
*/
|
||||
|
||||
const Tcl_ObjIntRep *irPtr;
|
||||
const int reuseMask = (WantPublic(flags) ? ~0 : ~PUBLIC_METHOD);
|
||||
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
|
||||
|
||||
if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) {
|
||||
callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
|
||||
@@ -1248,7 +1218,7 @@ TclOOGetCallContext(
|
||||
}
|
||||
|
||||
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
|
||||
callPtr = (CallChain *) Tcl_GetHashValue(hPtr);
|
||||
callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
|
||||
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
|
||||
callPtr->refCount++;
|
||||
goto returnContext;
|
||||
@@ -1260,7 +1230,7 @@ TclOOGetCallContext(
|
||||
doFilters = 1;
|
||||
}
|
||||
|
||||
callPtr = (CallChain *) ckalloc(sizeof(CallChain));
|
||||
callPtr = (CallChain *)ckalloc(sizeof(CallChain));
|
||||
InitCallChain(callPtr, oPtr, flags);
|
||||
|
||||
cb.callChainPtr = callPtr;
|
||||
@@ -1365,7 +1335,7 @@ TclOOGetCallContext(
|
||||
if (oPtr->flags & USE_CLASS_CACHE) {
|
||||
if (oPtr->selfCls->classChainCache == NULL) {
|
||||
oPtr->selfCls->classChainCache =
|
||||
(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
|
||||
(Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
|
||||
|
||||
Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
|
||||
}
|
||||
@@ -1373,8 +1343,7 @@ TclOOGetCallContext(
|
||||
(char *) methodNameObj, &i);
|
||||
} else {
|
||||
if (oPtr->chainCache == NULL) {
|
||||
oPtr->chainCache = (Tcl_HashTable *)
|
||||
ckalloc(sizeof(Tcl_HashTable));
|
||||
oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
|
||||
|
||||
Tcl_InitObjHashTable(oPtr->chainCache);
|
||||
}
|
||||
@@ -1400,8 +1369,7 @@ TclOOGetCallContext(
|
||||
}
|
||||
|
||||
returnContext:
|
||||
contextPtr = (CallContext *)
|
||||
TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
|
||||
contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
|
||||
contextPtr->oPtr = oPtr;
|
||||
|
||||
/*
|
||||
@@ -1468,9 +1436,9 @@ TclOOGetStereotypeCallChain(
|
||||
hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
|
||||
(char *) methodNameObj);
|
||||
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
|
||||
const int reuseMask = (WantPublic(flags) ? ~0 : ~PUBLIC_METHOD);
|
||||
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
|
||||
|
||||
callPtr = (CallChain *) Tcl_GetHashValue(hPtr);
|
||||
callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
|
||||
if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
|
||||
callPtr->refCount++;
|
||||
return callPtr;
|
||||
@@ -1482,9 +1450,9 @@ TclOOGetStereotypeCallChain(
|
||||
hPtr = NULL;
|
||||
}
|
||||
|
||||
callPtr = (CallChain *) ckalloc(sizeof(CallChain));
|
||||
callPtr = (CallChain *)ckalloc(sizeof(CallChain));
|
||||
memset(callPtr, 0, sizeof(CallChain));
|
||||
callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | FILTER_HANDLING);
|
||||
callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
|
||||
callPtr->epoch = fPtr->epoch;
|
||||
callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
|
||||
callPtr->objectEpoch = clsPtr->thisPtr->epoch;
|
||||
@@ -1537,8 +1505,7 @@ TclOOGetStereotypeCallChain(
|
||||
} else {
|
||||
if (hPtr == NULL) {
|
||||
if (clsPtr->classChainCache == NULL) {
|
||||
clsPtr->classChainCache = (Tcl_HashTable *)
|
||||
ckalloc(sizeof(Tcl_HashTable));
|
||||
clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitObjHashTable(clsPtr->classChainCache);
|
||||
}
|
||||
hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
|
||||
@@ -1601,7 +1568,7 @@ AddClassFiltersToCallContext(
|
||||
* override how filters work to extend their behaviour.
|
||||
*/
|
||||
|
||||
if (MixinConsistent(flags)) {
|
||||
if (MIXIN_CONSISTENT(flags)) {
|
||||
FOREACH(filterObj, clsPtr->filters) {
|
||||
int isNew;
|
||||
|
||||
@@ -1691,7 +1658,7 @@ AddPrivatesFromClassChainToCallContext(
|
||||
if (hPtr != NULL) {
|
||||
Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (IsPrivate(mPtr)) {
|
||||
if (IS_PRIVATE(mPtr)) {
|
||||
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
|
||||
flags);
|
||||
return 1;
|
||||
@@ -1776,10 +1743,10 @@ AddSimpleClassChainToCallContext(
|
||||
if (hPtr != NULL) {
|
||||
Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
|
||||
|
||||
if (!IsPrivate(mPtr)) {
|
||||
if (!IS_PRIVATE(mPtr)) {
|
||||
if (!(flags & KNOWN_STATE)) {
|
||||
if (flags & PUBLIC_METHOD) {
|
||||
if (!IsPublic(mPtr)) {
|
||||
if (!IS_PUBLIC(mPtr)) {
|
||||
return privateDanger;
|
||||
}
|
||||
flags |= DEFINITE_PUBLIC;
|
||||
@@ -1854,15 +1821,14 @@ TclOORenderCallChain(
|
||||
* method (or "object" if it is declared on the instance).
|
||||
*/
|
||||
|
||||
objv = (Tcl_Obj **)
|
||||
TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
|
||||
objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
|
||||
for (i = 0 ; i < callPtr->numChain ; i++) {
|
||||
struct MInvoke *miPtr = &callPtr->chain[i];
|
||||
|
||||
descObjs[0] =
|
||||
miPtr->isFilter ? filterLiteral :
|
||||
callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
|
||||
IsPrivate(miPtr->mPtr) ? privateLiteral :
|
||||
IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
|
||||
methodLiteral;
|
||||
descObjs[1] =
|
||||
callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
|
||||
@@ -2061,9 +2027,8 @@ AddSimpleClassDefineNamespaces(
|
||||
|
||||
static inline void
|
||||
AddDefinitionNamespaceToChain(
|
||||
Class *const definerCls, /* What class defines this entry. */
|
||||
Tcl_Obj *const namespaceName,
|
||||
/* The name for this entry (or NULL, a
|
||||
Class *const definerCls, /* What class defines this entry. */
|
||||
Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a
|
||||
* no-op). */
|
||||
DefineChain *const definePtr,
|
||||
/* The define chain to add the method
|
||||
@@ -2082,7 +2047,7 @@ AddDefinitionNamespaceToChain(
|
||||
* mixin-consistency.
|
||||
*/
|
||||
|
||||
if (namespaceName == NULL || !MixinConsistent(flags)) {
|
||||
if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -2123,12 +2088,12 @@ AddDefinitionNamespaceToChain(
|
||||
if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
|
||||
DefineEntry *staticList = definePtr->list;
|
||||
|
||||
definePtr->list = (DefineEntry *)
|
||||
ckalloc(sizeof(DefineEntry) * definePtr->size);
|
||||
definePtr->list =
|
||||
(DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size);
|
||||
memcpy(definePtr->list, staticList,
|
||||
sizeof(DefineEntry) * definePtr->num);
|
||||
} else {
|
||||
definePtr->list = (DefineEntry *) ckrealloc(definePtr->list,
|
||||
definePtr->list = (DefineEntry *)ckrealloc(definePtr->list,
|
||||
sizeof(DefineEntry) * definePtr->size);
|
||||
}
|
||||
}
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user