Compare commits

..
246 Commits
Author SHA1 Message Date
jan.nijtmans 8c30acc36f Experiment: build onefiledist using the (experimental) UCRT64 mingw-w64 environment 2021-07-21 08:19:39 +00:00
jan.nijtmans 6cc9524fbb Merge 8.6 2021-07-21 08:12:33 +00:00
jan.nijtmans edf67bd765 Merge 8.5 2021-07-21 08:00:58 +00:00
jan.nijtmans 97e8fa6621 Use msys2/setup-msys2@v2 rule to install msys2, working around limitations in msys2 2021-07-20 15:32:15 +00:00
jan.nijtmans b1f4ab80a0 Merge 8.6 2021-07-17 11:18:00 +00:00
jan.nijtmans 04619d69b8 Fix [592a25a505]: Tcl_PutEnv() crashes on Windows 2021-07-17 11:16:11 +00:00
jan.nijtmans 9804d03e1f Proposed fix for [592a25a505]: Tcl_PutEnv() crashes on Windows 2021-07-16 15:52:34 +00:00
jan.nijtmans 9b4bad2783 Merge 8.6 2021-07-16 06:58:45 +00:00
jan.nijtmans f58326fab5 Merge 8.5 2021-07-16 06:41:58 +00:00
jan.nijtmans c47c440be2 -eofchar should only be effective on input, not on output, since it could result in CTRL-Z be written when closing the file. (backported from 8.6) 2021-07-16 06:07:43 +00:00
jan.nijtmans 1523ce53c1 comment clean-up 2021-07-16 06:04:38 +00:00
jan.nijtmans 68dc740f26 Fix [1a89eba3761f62ee]: Add "exit" Windows shell built-in to auto_execok 2021-07-14 16:06:32 +00:00
jan.nijtmans 6e3371ad0a Fix build on Linux/Sparc with 32 bit userspace. See: [https://github.com/libtom/libtommath/issues/509] for the upstream libtommath fix 2021-07-14 15:54:56 +00:00
jan.nijtmans e5bb3b3829 finally -> finallyIndex, preventing conflicts with Tru64 headers (reported by Jay K) 2021-07-13 07:56:44 +00:00
jan.nijtmans 6bdb76c461 merge 8.6 2021-07-08 12:28:56 +00:00
jan.nijtmans 3d82d5537c Add \DUSE_NMAKE=1 to C-flags when nmake is used 2021-07-08 12:17:30 +00:00
jan.nijtmans 259220cf73 Set -DUSE_NMAKE=1 when compiling under nmake. Update .gitattributes and (for Fossil) binary-glob and crlf-glob 2021-07-08 12:00:07 +00:00
jan.nijtmans 4df980c07b TCL_THREADS=0 means no threads too 2021-06-29 16:03:49 +00:00
jan.nijtmans f0048561b7 Use fstat64() in stead of fstat() on platforms which support it. 2021-06-29 14:52:29 +00:00
jan.nijtmans 7573820525 Merge 8.6 2021-06-28 14:38:11 +00:00
jan.nijtmans 5175765beb Update many tools/encoding/*.txt files to the latest version, but leave out character changes. Only add the new "cns11643" encoding, which belongs to the same group as big5 2021-06-28 14:33:00 +00:00
jan.nijtmans 35315e5c2e Update many tools/encoding/*.txt files to the latest version, but leave out character changes. Only add the new "cns11643" encoding, which belongs to the same group as big5 2021-06-28 14:22:00 +00:00
jan.nijtmans 25a30f2db0 Tweak TIP #590 impl on MacOS: Shared library could start with capital 2021-06-25 21:30:32 +00:00
pooryorick a6691785d8 fix typos in previous commit 2021-06-23 21:31:40 +00:00
pooryorick 458f106fdb possible fix for [dcb888ed85adeb86] with kevent() 2021-06-23 18:49:57 +00:00
jan.nijtmans 501954d5aa Merge 8.6 2021-06-23 12:26:39 +00:00
jan.nijtmans 814c9b57aa Now really merge [bug-f9800d52bd61f240] (previous commit contains test-cases only) 2021-06-23 12:20:59 +00:00
pooryorick d7d411426d merge [bug-f9800d52bd61f240] 2021-06-23 07:43:54 +00:00
pooryorick 76238b9ab7 possible fix for [dcb888ed85adeb86] with kevent() 2021-06-22 18:26:58 +00:00
jan.nijtmans 617e57260f Merge 8.5 2021-06-22 13:20:38 +00:00
jan.nijtmans ad4b60ef7c More code cleanup, eliminating various compiler warnings with stricter flags. No need to even use strmove at all. 2021-06-22 13:19:31 +00:00
jan.nijtmans 7403235131 Merge 8.5 2021-06-22 09:03:17 +00:00
jan.nijtmans 30db6ce78e Fix [bad6cc213d]: A format string vulnerability in Tcl nmakehelp.c allows code execution via a crated file.
Also change a memcpy() to a memmove(), because the range could be overlapping
2021-06-22 09:02:00 +00:00
pooryorick 6f34bcda8f Improve logic and cleanup for tests coroutine-7.13 and coroutine-7.14 2021-06-21 21:21:50 +00:00
jan.nijtmans cb849ffbeb Merge 8.6 2021-06-21 12:34:20 +00:00
jan.nijtmans a8e1d5aae3 Backport ISSUE_TEMPLATE and PULL_REQUEST_TEMPLATE from 8.7 2021-06-21 12:31:39 +00:00
jan.nijtmans b632599a22 Merge 8.6 2021-06-21 12:08:28 +00:00
jan.nijtmans 3f913d322f Change a lot of url's (as far as possible) from http:// to https:// 2021-06-21 12:00:29 +00:00
jan.nijtmans cdae95cf66 Backout merge of "bug-f9800d52bd61f240" branch, which is - apparently - not ready to be merged yet.
This is causing failures on all platforms: [https://github.com/tcltk/tcl/runs/2872891537?check_suite_focus=true]
2021-06-21 10:27:02 +00:00
jan.nijtmans f36b113b00 eol-spacing 2021-06-21 09:45:43 +00:00
jan.nijtmans 954fcc121d renumber testcases 2021-06-21 09:40:59 +00:00
jan.nijtmans c60ee515ee Fix [048dd20b4171c8da]: cesu-8 encoding fails on \u80 2021-06-21 09:29:18 +00:00
pooryorick 0008ef8d9b merge bug-f9800d52bd61f240 2021-06-21 05:47:02 +00:00
pooryorick 7357ee63c3 test for issue [5106fddd4400e5b9b], failure to yieldto is not the same thing as
not calling yieldto in the first place
2021-06-21 05:40:22 +00:00
pooryorick e0456ccfdf merge bug-f9800d52bd61f240 2021-06-20 22:57:40 +00:00
pooryorick 70c2b0e817 Fix for [f9800d52bd61f240], vwait is not NRE-enabled, and yieldto cannot find
the right splicing spot
2021-06-20 22:47:14 +00:00
jan.nijtmans 55076a6af2 Undo change in [b70eeebb0d196bb2]: It breaks the "make html" target in github actions. See also [1e10b17023] 2021-06-19 23:37:07 +00:00
jan.nijtmans ee4adbec91 Assume chan-io-41.6 and chan-io-41.8 are UNIX-only. See [9be2726881c41893], those are failing on Windows now 2021-06-19 23:32:03 +00:00
jan.nijtmans eff036def9 Fix windows build failure, caused by [f8608fc420] 2021-06-19 23:24:24 +00:00
jan.nijtmans d825807d46 Fix [f8608fc420]: linux : dynamic location of the tcl zipfs 2021-06-18 19:39:39 +00:00
dgp a444785129 Bump version number to distinguish from release. 2021-06-18 18:11:29 +00:00
dgp 9deb1f2b0a close fork 2021-06-18 17:38:27 +00:00
dgp a8606e7ce9 merge release 2021-06-18 17:37:05 +00:00
jan.nijtmans 7dd17bbcbf Merge 8.6 2021-06-18 14:22:23 +00:00
jan.nijtmans 8c5e1ee93f Update all "cp" and "iso8859-?" encodings to the latest version. This adds 3 new codepoints to iso8859-7, and adds a full new encoding iso8859-11 2021-06-18 12:46:32 +00:00
jan.nijtmans e809cadb0a Update all "cp" and "iso8859-?" encodings to the latest version. This adds 3 new codepoints to iso8859-7, and adds a full new encoding iso8859-11. 2021-06-18 12:24:06 +00:00
jan.nijtmans ce199db516 Hm. tcltk-man2html.tcl cannot handle $(PATCH_LEVEL). Don't bother for now. 2021-06-18 10:44:08 +00:00
jan.nijtmans cd814a13ac Fix "make html-tcl" target, broken by this commit: [b70eeebb0d196bb2] (in core-8-7-a5-rc branch only) 2021-06-18 10:15:01 +00:00
dgp a6a453f3b8 Revert to the code of RC2, so that only timestamps and changes file entries
are different.
2021-06-17 15:52:08 +00:00
dgp 8cfc027811 Add another ticket to the changes file, noting its incompatility. 2021-06-17 15:44:09 +00:00
pooryorick 06938f94df tests for [dcb888ed85adeb86] 2021-06-17 10:25:25 +00:00
pooryorick 597edf50b5 Fix for [dcb888ed85adeb86]: epoll, special files, directories, links, epoll_ctl operation not permitted, and abort 2021-06-17 08:53:04 +00:00
pooryorick 79b57974dc Re-apply fix for [67a5eabbd3d1]: refchan, coroutine, and postevent from the "watch" proc 2021-06-16 16:06:00 +00:00
dgp acfe572897 merge 8.7 2021-06-16 02:26:17 +00:00
jan.nijtmans 9b3ea0f675 Fix [18f4a94d03] by backing out [9bcec7cd880540c3] 2021-06-15 14:54:15 +00:00
jan.nijtmans 9251a05e68 Fix [18f4a94d03] by backing out [9bcec7cd880540c3] 2021-06-15 14:52:02 +00:00
jan.nijtmans 7413757522 Fix [18f4a94d03] by backout out [9bcec7cd880540c3] 2021-06-15 12:56:58 +00:00
jan.nijtmans 3fcf24bf05 Adapt iso8859-7.enc to latest version, and fix testcase 2021-06-15 08:50:23 +00:00
jan.nijtmans 693567f0d8 Add new encoding iso8859-11 2021-06-15 08:28:20 +00:00
jan.nijtmans 98f26e503e Update encodings (cp/iso) to latest version from unicode.org. *.enc-files not re-generated yet 2021-06-15 08:17:52 +00:00
dgp 1dfd77778e Change the arguments of the make html target to take the right default
actions for producing a Tcl/Tk release.
2021-06-13 17:01:00 +00:00
dgp 4b9ec1f4aa bump release date 2021-06-12 16:49:02 +00:00
dgp bd52e4af47 merge 8.7 2021-06-11 17:49:50 +00:00
jan.nijtmans 729c97255b Merge 8.6 2021-06-11 13:59:23 +00:00
jan.nijtmans 60abdd9b58 Fix [d6b10a9256]: Two files under compat/zlib/contrib/ are CRLF 2021-06-11 13:57:40 +00:00
jan.nijtmans 5b8c40a4b1 Somehow "zip -A" appears not to work in the github actions environment. Try to find out why. 2021-06-11 13:48:03 +00:00
jan.nijtmans 21904bcbde Ubuntu 16 is [https://github.com/actions/virtual-environments/issues/3287|deprecated] 2021-06-11 08:45:01 +00:00
jan.nijtmans 4427df1ae8 protect all usage of dladdr() with !defined(NO_DLFCN_H) 2021-06-11 06:59:13 +00:00
jan.nijtmans 19c1bb0cf6 Fix copying of public_suffix_list.dat.gz in win/Makefile.in. Thanks, Paul! 2021-06-11 06:33:33 +00:00
dgp b67894a411 merge 8.7 2021-06-10 15:56:43 +00:00
jan.nijtmans d1e77398a8 Experiment: use dladdr() on Linux to locate the shared library. Won't work on other platforms! WIP 2021-06-10 14:49:08 +00:00
jan.nijtmans f271e62139 (cherry-pick): Update dist target to renamed file.
Also sync win/tcl.m4 with Tk (no change in generated win/configure)
2021-06-10 08:52:12 +00:00
dgp 4476f831f5 Update dist target to renamed file. 2021-06-09 20:32:46 +00:00
dgp 3618ecdad8 merge 8.7 2021-06-09 16:26:41 +00:00
jan.nijtmans ac2c528c36 Rename effective_tld_names.txt to public_suffix_list.dat, that's how it is named now. 2021-06-09 09:25:58 +00:00
jan.nijtmans 751750005b Update effective_tld_names.txt.gz to latest version (from https://publicsuffix.org/list/public_suffix_list.dat) 2021-06-09 09:13:53 +00:00
jan.nijtmans 5b7381172b Merge 8.6 2021-06-09 07:17:45 +00:00
jan.nijtmans 0d6faa1ccd Fix compiler warning seen with static builds (--disable-shared): "FLT_RADIX" is not defined, evaluates to 0 [-Wundef] 2021-06-09 07:16:18 +00:00
jan.nijtmans 4d31e6c26e Merge 8.6 2021-06-08 14:23:52 +00:00
jan.nijtmans 3b3080a9f6 Name TKSCRIPTZIPNAME the same way as TCLSCRIPTZIPNAME 2021-06-08 14:22:59 +00:00
jan.nijtmans 1b914f66bf Don't create a lot of empty directories any more while installing 2021-06-08 13:25:22 +00:00
jan.nijtmans 9b86fa3762 HP_UX -> HP-UX and another apparent typo 2021-06-08 12:04:28 +00:00
jan.nijtmans 31de1a727a re-generate unix/configure with autoconf-2.59 2021-06-08 12:01:44 +00:00
jan.nijtmans f0316438a9 Use -fPIC by default on DragonFly/FreeBSD, but not on OSF1/HP-UX. Backported (with typo correct) from 8.7 2021-06-08 11:49:55 +00:00
jan.nijtmans 02c12ad919 Add full "libtommath" to "make dist" in stead of only the header-files and src-files. Reported by Harald Oehlmann. 2021-06-08 08:55:00 +00:00
jan.nijtmans a1f7ab6047 DragonFly/FreeBSD need -fPIC 2021-06-08 08:37:17 +00:00
jan.nijtmans 6c09446693 If the test suite needs a file, it needs to go in the distribution (cherry-pick) 2021-06-08 06:20:10 +00:00
dgp 9882c08b41 ....and with the right path. 2021-06-07 17:16:20 +00:00
dgp 1fb36494e2 If the test suite needs a file, it needs to go in the distribution. 2021-06-07 17:14:49 +00:00
dgp cb796d6e08 merge 8.7 2021-06-04 21:01:50 +00:00
dgp 557c437637 update changes 2021-06-04 21:01:37 +00:00
dgp c0ef486e3d Update docs to reflect http 2.10 2021-06-04 19:55:07 +00:00
dgp 7a14d36614 Revise http version number from unusual 2.10.0a1 to conventional 2.10a1 2021-06-04 19:43:08 +00:00
jan.nijtmans 7e1bd9ece3 Add winspool library to LIBS_GUI on Windows. Not used yet (but most likely it will be used in 8.7 final) 2021-06-02 07:45:25 +00:00
dgp 4d0c2de9fe more changes 2021-05-28 18:12:51 +00:00
jan.nijtmans d2275e354d compete TIP list in "changes" 2021-05-28 10:09:04 +00:00
dgp 28821a3fc8 merge 8.7 2021-05-27 15:47:34 +00:00
jan.nijtmans 40e5a934ab Merge 8.6. Make c++ compile (with g++-11) warning-free 2021-05-27 12:13:41 +00:00
jan.nijtmans a5ee3631c3 Fix "possibly uninitialized variable" warning, seen with gcc-11 (however harmless) 2021-05-27 10:31:51 +00:00
jan.nijtmans 0c51650ae9 Fix [a73c79081e]: Doc fix in tcl.h. Recommend int32_t in stead of wchar_t 2021-05-26 11:23:19 +00:00
jan.nijtmans 6d2f85de20 Fix [a73c79081e]: Doc fix in tcl.h, by not suggesting wchar_t any more for Tcl_UniChar. 2021-05-26 10:47:20 +00:00
jan.nijtmans dbcca14632 Fix [a73c79081e]: Doc fix in tcl.h, by not suggesting wchar_t any more for Tcl_UniChar. 2021-05-26 10:45:17 +00:00
jan.nijtmans 9d13d5e64b One more macos-11.0 -> macos-11 2021-05-26 10:01:11 +00:00
jan.nijtmans 1233589701 Merge 8.6 2021-05-26 09:57:58 +00:00
jan.nijtmans cd326bf172 macos-11.0 -> macos-11 2021-05-26 09:56:44 +00:00
dgp b6d01a333a merge 8.7 2021-05-25 13:15:32 +00:00
jan.nijtmans 6ef2d21d52 Merge 8.6 2021-05-25 09:38:06 +00:00
jan.nijtmans e7ff6cacbc Fix [3f9b4e0c81]: CrtObjCmd.3, NRE.3, SplitList.3: constify cmdName, list
(actually quite a few more where the documentation didn't match the header files ....)
2021-05-25 09:30:20 +00:00
jan.nijtmans 08902d8a97 Fix [https://core.tcl-lang.org/tk/info/8b679f597b1d17ad|8b679f597b] for Tcl too: LIB_RUNTIME_DIR could contain multiple paths, DYLIB_INSTALL_DIR cannot handle that 2021-05-25 09:10:51 +00:00
jan.nijtmans a4006968d9 Fix [https://core.tcl-lang.org/tk/info/8b679f597b1d17ad|8b679f597b] for Tcl too: LIB_RUNTIME_DIR could contain mulitple paths, DYLIB_INSTALL_DIR cannot handle that 2021-05-25 08:59:15 +00:00
jan.nijtmans d6aac61b03 merge-mark 2021-05-21 07:19:11 +00:00
jan.nijtmans 703055871b Make all "pkg?" package names lowercase (was: ""Pkg?"), as we now recommend lowercase package names. Let's provide good examples then. 2021-05-21 07:07:21 +00:00
dgp 500d59bd30 merge 8.7 2021-05-20 19:08:47 +00:00
jan.nijtmans fd0aa4c0fc Merge 8.6, except [688fcc7082] because it gives a merge conflict 2021-05-20 12:35:19 +00:00
jan.nijtmans 3a1e408464 Make all "pkg?" package names lowercase (was: ""Pkg?"), as we now recommend lowercase package names. Let's provide good examples then. 2021-05-20 12:26:27 +00:00
jan.nijtmans d80a12f061 Fix [52cc90776c]: Warning when compile with gcc v9.3.0 2021-05-20 12:21:33 +00:00
dgp 1368d760bc merge 8.7 2021-05-19 14:57:55 +00:00
pooryorick 9b49520dc2 fix for [e39cb3f462631a99], namespace is removed from other namespace paths
before deletion is complete
2021-05-19 10:46:54 +00:00
pooryorick 0f48a8bc92 update documentation and macro names 2021-05-19 10:44:18 +00:00
pooryorick 93e207f19d new test for issue [e39cb3f462631a99], namespace is removed from other
namespace paths before deletion is complete
2021-05-19 07:15:10 +00:00
pooryorick a201f0f383 Fix for issue [e39cb3f462631a99], namespace is removed from other namespace
paths before deletion is complete
2021-05-18 22:09:41 +00:00
jan.nijtmans 1c9f5c8741 Make pkgua package thread-safe 2021-05-18 12:23:32 +00:00
jan.nijtmans 39ef112133 Make Pkgua package thread-safe and properly clean up everything when being unloaded. Based on pyk-tclUnload branch, but extended for thread-safety (Thanks!) 2021-05-18 12:02:55 +00:00
pooryorick f14d3b58cf Fix [28027d8bb7745fb0], memory leaks in tclUnload.c . 2021-05-18 10:58:18 +00:00
pooryorick 0187ddfaf3 merge 8.7 2021-05-18 10:51:33 +00:00
pooryorick 9649c9074c Break TclDeleteNamespaceChildren out of TclTeardownNamespace. 2021-05-18 10:36:11 +00:00
pooryorick 05b875c564 Remove unneeded cmdPtr increment and decrement. 2021-05-18 10:25:47 +00:00
pooryorick d3e0d5789c Remove the refCount increment that accompanied the decrement removed in the
last commit.
2021-05-18 10:24:17 +00:00
pooryorick 11b101cd27 Additional test for [688fcc7082fa99a4], imported command trace memory error. 2021-05-18 06:03:40 +00:00
pooryorick 5bdefd0c25 Remove unnecessary refCount decrement. 2021-05-17 21:34:25 +00:00
pooryorick a8516aa629 Fix for [688fcc7082fa99a4], trace on imported alias deletes alias and then
calls import and triggers memory error.
2021-05-17 21:30:57 +00:00
pooryorick d9bbe48c46 Additional test for [688fcc7082fa99a4]. 2021-05-17 21:29:25 +00:00
jan.nijtmans 12502ae524 Eliminate "unused parameter" warning 2021-05-17 11:49:26 +00:00
jan.nijtmans 932e04d6db Merge 8.6 2021-05-17 11:35:43 +00:00
jan.nijtmans 962b2df00b Eliminate use of TCL_STORAGE_CLASS in pkg?.c: just use DLLEXPORT macro directly.
Fix gcc warnings (with stricter gcc flags) in pkg?.c
2021-05-17 11:28:51 +00:00
pooryorick d4d8fe187b use [info sharedlibextension] for instead of ".so" 2021-05-17 07:39:20 +00:00
pooryorick e4e1451d4a Break TclDeleteNamespaceChildren out of TclTeardownNamespace. 2021-05-16 19:09:47 +00:00
pooryorick 3634214bbb Eliminate compiler warnings about unused parameters. 2021-05-16 10:03:55 +00:00
pooryorick 7ee82af4aa Fix [28027d8bb7745fb0], memory leaks in tclUnload.c, 2021-05-15 21:56:03 +00:00
pooryorick e7d3979e0a Delete associated data after running Tcl_InterpDeleteProc instead of before. Remove redundant/cyclic call to Tcl_DeleteAssocData. 2021-05-15 19:04:09 +00:00
pooryorick 1134511a98 When deleting an interp, delete associated data after running the corresponding
Tcl_InterpDeleteProc instead of before to allow the Tcl_InterpDeleteProc to
make use of the data.

In TcltestObj.c/VarPtrDeleteProc, remove call to Tcl_DeleteAssocData that is
redundant and cylic.
2021-05-15 18:42:40 +00:00
pooryorick 71008a6aa8 Add valgrind option --keep-deguginfo=yes 2021-05-15 18:27:20 +00:00
pooryorick 0f818acbb7 Add valgrind option --keep-deguginfo=yes 2021-05-15 18:24:59 +00:00
pooryorick 4bd04113a8 merge core-8-branch 2021-05-15 10:10:04 +00:00
fvogel 6a484fdaef Fix errors in man pages build 2021-05-15 09:32:23 +00:00
fvogel 4c055148da Fix errors in man pages build 2021-05-15 09:31:45 +00:00
pooryorick 2174632a4b Fix for issue [463b7a93be0a2ddd], Tcl_Unload, make gdb-test, segmentation fault. 2021-05-15 09:09:42 +00:00
pooryorick 60a9b8775d Merge bug-fb2a411b91973d3b. 2021-05-15 09:07:08 +00:00
pooryorick 0d6bc7fc83 Separate library unloading routine from [unload] command processing. 2021-05-15 07:55:55 +00:00
pooryorick 7d899dfff0 Fix more leaks in tclZipfs.c. Valgrind now reports no more leaks in tclZipfs.c 2021-05-14 20:58:14 +00:00
pooryorick 2fea9a2bbd Fix more leaks in Zipfs finalization. 2021-05-14 20:49:34 +00:00
pooryorick 7987c596f2 Fix for issue [463b7a93be0a2ddd], Tcl_Unload, make gdb-test, segmentation fault 2021-05-14 18:50:33 +00:00
jan.nijtmans 9fecbcc106 Respect TIP #587 in dde test-cases. 2021-05-14 13:54:50 +00:00
jan.nijtmans ad6b4e6f8f Backout [217391dc7f] and [b05e314d7a]. For the reason, see: [https://github.com/tcltk/tcl/runs/2573477656?check_suite_focus=true]: Test file error: alloc: invalid block: 0x558a6e095990: 20 6e 2021-05-13 17:47:41 +00:00
pooryorick 737753205d Fix quoting issues in gdb-test and lldb targets. 2021-05-13 15:22:50 +00:00
pooryorick 7caa74e545 Fix remaining leaks in Zipfs finalization. 2021-05-13 12:49:23 +00:00
pooryorick f87cb71e7a On exit deallocate up some memory allocated in ZipFS. 2021-05-12 21:08:49 +00:00
dgp 65df3cd9fe Merge 8.7 2021-05-07 13:40:29 +00:00
jan.nijtmans 7cf2f6d102 Better error-message "illegal byte sequence" when trying to read from invalid/incomplete UTF-8 2021-05-07 12:27:27 +00:00
jan.nijtmans ed61282e22 Remove TODO comment which is already done 2021-05-07 11:01:49 +00:00
jan.nijtmans 75afeeeffa Merge 8.6 2021-05-06 15:06:50 +00:00
jan.nijtmans 6607e4e824 Handle POSIX error EILSEQ: "invalid byte sequence" 2021-05-06 15:04:40 +00:00
oehhar eb45f86b3f Ticket[535705]: encoding manpage example is about outdated source command. It is replaced by a simple example. 2021-05-06 12:53:52 +00:00
oehhar b72fcddfe2 Ticket[535705]: encoding manpage example is about outdated source command. It is replaced by a simple example. 2021-05-06 12:50:38 +00:00
dgp d261590825 merge 8.7 2021-05-03 20:36:15 +00:00
dgp 713ea0845e Bump to version 8.7a5 for release. 2021-05-03 20:33:07 +00:00
jan.nijtmans e2a1c2f11c Merge 8.6 2021-05-03 19:44:49 +00:00
jan.nijtmans 6f6229ef6e Fix [24b9181478]: Fix unsafe buffer lifetime 2021-05-03 19:42:03 +00:00
jan.nijtmans 7476029a04 Fix [24b9181478]: Fix unsafe buffer lifetime 2021-05-03 19:36:22 +00:00
jan.nijtmans 471313fea0 TIP #597: "string is unicode" and better utf-8/utf-16/cesu-8 encodings 2021-04-30 07:20:06 +00:00
jan.nijtmans a3201caebd unofficial -> snapshot 2021-04-29 12:30:30 +00:00
jan.nijtmans 9cf2b1031b Merge 8.7 2021-04-29 09:58:44 +00:00
jan.nijtmans c5e9409992 Prevent compiler warning 2021-04-29 09:58:08 +00:00
jan.nijtmans 2e4a20524c Merge 8.7 2021-04-29 09:54:42 +00:00
jan.nijtmans d4ed243e68 Unbreak build with -DTCL_NO_DEPRECATED 2021-04-29 09:51:54 +00:00
jan.nijtmans 4c5c001bc8 Merge 8.7 2021-04-28 14:30:11 +00:00
pooryorick 71dcf14194 Add test for upvar a linked variable to itself. 2021-04-28 14:01:22 +00:00
jan.nijtmans ce299372a0 CONST86 -> const 2021-04-28 13:04:27 +00:00
jan.nijtmans ef9154f143 Rename TclSetPreInitScript() to Tcl_SetPreInitScript(). Tiny part of TIP #596, the only part meant for 8.7. 2021-04-28 12:42:17 +00:00
pooryorick c7fcbf756c Make tcltests.tcl continue to function even if tclTest.c isn't available. 2021-04-27 10:48:58 +00:00
pooryorick 81d499ea31 Fix for io-28.6. 2021-04-26 23:06:14 +00:00
pooryorick 4de3a63efd Fix typo in tcltests.tcl. 2021-04-26 23:02:14 +00:00
pooryorick b6d1ba3fdb Fix typo in tcltests.tcl. 2021-04-26 23:01:03 +00:00
pooryorick 28437b46c3 Add io-28.6 an io-28.7 to test closing a channel within a channel event
handler.
2021-04-26 22:53:42 +00:00
pooryorick 4fa09fa5d6 merge pyk-tcltests 2021-04-26 22:52:22 +00:00
pooryorick f2e08d25db Add test constaints "debug", "purify", and "debugpurify" 2021-04-26 22:48:15 +00:00
dkf 42a77f7b4b Document our reference count management 2021-04-25 20:22:05 +00:00
dkf 9bf722e8da Documenting our reference count management 2021-04-25 20:21:07 +00:00
dkf 5003483b1d Documenting our reference count management 2021-04-25 15:24:14 +00:00
dkf c1cc3a7238 Documenting our reference count management 2021-04-25 13:58:22 +00:00
pooryorick 5a5cb4c044 Fix for issue [f6fbc71cd160d779], with "make valgrind", safe-zipfs-5.5 fails
with the error, 'can't set "path": variable is array'
2021-04-25 13:24:09 +00:00
dkf 4aa680d80d Documenting our reference count management 2021-04-25 12:01:10 +00:00
dkf b63d1213ed Documenting our reference count management 2021-04-25 11:20:35 +00:00
dkf 2453c29945 Documenting our reference count management 2021-04-25 10:56:32 +00:00
dkf 8a32e272a4 Documenting our reference count management 2021-04-25 07:44:59 +00:00
dkf c1a1d841e7 Documenting our reference count management 2021-04-24 20:07:57 +00:00
dkf ae32db3ffa Documenting our reference count management 2021-04-24 12:51:07 +00:00
dkf bd778f8dd4 Documenting our reference count management 2021-04-24 11:24:23 +00:00
dkf 103d88f85a Documenting our reference count management 2021-04-24 09:04:19 +00:00
dkf aa6c33b39d Start of documenting our reference count management 2021-04-23 20:24:00 +00:00
jan.nijtmans 52b58d0c7d Merge 8.6 2021-04-21 09:27:04 +00:00
jan.nijtmans 93b4c9bd6b Fix default-pkgindex rule in makefile.vc, for generation of TEA extensions for Tcl 9 (see: TIP #595) 2021-04-21 09:24:10 +00:00
jan.nijtmans cfdc6e47f4 Unbreak Windows build (windows 32-bit only, not checked by GITHUB actions) 2021-04-21 08:43:03 +00:00
pooryorick bc8789e840 Fix for [1f4af0a127369d4a1], tclZipfs storage cleanup issue. 2021-04-20 19:33:57 +00:00
pooryorick 14ead72e1a Fixes for Valgrind issues similar to [ec06d0db3225afca]. 2021-04-20 13:45:27 +00:00
pooryorick a6e0a802ec Fix for issue [ec06d0db3225afca]. 2021-04-20 10:29:16 +00:00
jan.nijtmans 830d7561f9 Merge 8.6 2021-04-19 16:34:54 +00:00
jan.nijtmans 6f8c6e12dd Complete TIP #595 for rules.vc 2021-04-19 16:27:30 +00:00
jan.nijtmans 6f23bf98b4 Remove unused testConstraint 2021-04-19 12:50:20 +00:00
jan.nijtmans 3bfe6dba24 More testcases (cesu-8) 2021-04-19 07:24:18 +00:00
jan.nijtmans 82d0339a65 renumber testcases 2021-04-16 20:45:56 +00:00
jan.nijtmans 3c9c7e0621 Remove wtf-8/wtf-16/tcl-8 encodings 2021-04-16 20:34:33 +00:00
jan.nijtmans e83fde690f Merge 8.7 2021-04-14 08:40:16 +00:00
jan.nijtmans 4ef5cbaad7 Merge 8.7 2021-04-13 10:18:40 +00:00
jan.nijtmans 85469e495c Merge 8.7 2021-04-13 08:08:23 +00:00
jan.nijtmans 05fa595fc5 Merge 8.7 2021-04-13 07:22:56 +00:00
jan.nijtmans 72fd932a99 Merge 8.7 2021-04-12 09:37:20 +00:00
jan.nijtmans 42b705be81 merge-mark 2021-04-09 15:34:45 +00:00
jan.nijtmans aa4f7bcd47 Deprecate/remove "string bytelength" 2021-04-09 15:19:51 +00:00
jan.nijtmans 1f4a8eb5d1 Merge 8.7 2021-04-09 14:43:34 +00:00
jan.nijtmans 2e7b2436f1 Add "tcl-8" encoding 2021-04-08 11:14:56 +00:00
jan.nijtmans c7711541ec Merge 8.7 2021-04-08 08:56:38 +00:00
jan.nijtmans c6799de46b Merge 8.7 2021-04-06 09:08:54 +00:00
jan.nijtmans 4b405eefc8 Merge 8.7 2021-04-01 10:34:31 +00:00
jan.nijtmans 6b90b986b2 Fix testcase for TCL_UTF_MAX=4 2021-03-31 06:53:27 +00:00
jan.nijtmans 3175cb43a5 Re-use TCL_ENCODING_MODIFIED flag value for TCL_ENCODING_LE too, since they are used for different encoders. 2021-03-31 06:40:02 +00:00
jan.nijtmans 48a57e0116 Bugfix (backported from encodings-with-flags branch): Use correct byte/char positions in error-situation 2021-03-30 14:14:02 +00:00
jan.nijtmans 269722c410 Merge 8.7 2021-03-30 13:39:22 +00:00
jan.nijtmans 0b884f11fa Merge 8.7 2021-03-30 09:01:16 +00:00
jan.nijtmans 958892fdd0 Finish CESU-8 encoder/decoder 2021-03-29 09:51:54 +00:00
jan.nijtmans 1806e5755f Make a start with CESU-8 encoder/decoder. Not finished yet 2021-03-28 22:01:51 +00:00
jan.nijtmans ce82e0c22d Merge 8.7 2021-03-28 21:03:48 +00:00
jan.nijtmans 74f570670c Add wtf-16 encodings to the set. With testcases 2021-03-17 12:46:31 +00:00
jan.nijtmans 9d25ea9cd7 Merge 8.7 2021-03-17 12:04:05 +00:00
jan.nijtmans b51e777fe9 Fix documentation 2021-03-10 15:00:44 +00:00
jan.nijtmans a5a30fa3e2 TIP #597 implementation: "string is unicode" and new wtf-8 encoding 2021-03-10 12:55:25 +00:00
214 changed files with 26388 additions and 6083 deletions
+1 -1
View File
@@ -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 -1
View File
@@ -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 -2
View File
@@ -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:
+25 -19
View File
@@ -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'
+8 -7
View File
@@ -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.
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
+3 -3
View File
@@ -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
+80 -5
View File
@@ -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 -
+186 -186
View File
@@ -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
+275 -275
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
+12
View File
@@ -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
+12
View File
@@ -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
+8
View File
@@ -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
View File
@@ -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
View File
@@ -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,
+4
View File
@@ -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
View File
@@ -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
+9
View File
@@ -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
+67
View File
@@ -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:
+12
View File
@@ -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
+11
View File
@@ -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
+21
View File
@@ -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
View File
@@ -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
+9
View File
@@ -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
View File
@@ -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
View File
@@ -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
+6
View File
@@ -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
View File
@@ -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
View File
@@ -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
+21
View File
@@ -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
+25
View File
@@ -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
+4
View File
@@ -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
View File
@@ -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
+20 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
+22
View File
@@ -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
+18
View File
@@ -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
+6
View File
@@ -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
+8
View File
@@ -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
+4
View File
@@ -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"
+6
View File
@@ -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
View File
@@ -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
View File
@@ -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
+27
View File
@@ -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
+21
View File
@@ -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
View File
@@ -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.
+27
View File
@@ -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
+7
View File
@@ -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
+25
View File
@@ -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.
+9
View File
@@ -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)
+8
View File
@@ -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,
+7 -1
View File
@@ -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.
+6
View File
@@ -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
View File
@@ -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
View File
@@ -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)
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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]
+2 -2
View File
@@ -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:
+3
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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(
-2
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
File diff suppressed because it is too large Load Diff
+210 -242
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
File diff suppressed because it is too large Load Diff
+5
View File
@@ -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) */
+1 -1
View File
@@ -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) {
+4 -3
View File
@@ -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
View File
@@ -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);
+2 -2
View File
@@ -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.
*/
+10
View File
@@ -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
View File
@@ -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
View File
File diff suppressed because it is too large Load Diff
+6 -9
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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;
+2 -2
View File
@@ -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
View File
File diff suppressed because it is too large Load Diff
+6 -4
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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