Compare commits

...
812 Commits
Author SHA1 Message Date
pooryorick 95d7850d9e merge trunk 2018-05-05 11:39:20 +00:00
José Ignacio Marín b97b608974 Update TZ info to tzdata2018e. 2018-05-04 19:07:22 +00:00
José Ignacio Marín 215b091d17 Update TZ info to tzdata2018e. 2018-05-04 19:06:55 +00:00
José Ignacio Marín 096a011c43 Update TZ info to tzdata2018e. 2018-05-04 19:06:09 +00:00
oehhar 7a91dd767e Syntax error in msgcat documentation fixed. Ticket [af69c6966d] 2018-05-03 16:24:05 +00:00
dgp ce396e8f68 close fork 2018-05-02 13:53:48 +00:00
oehhar ccf2e7a979 Syntax error in msgcat documentation fixed. Ticket [af69c6966d] 2018-05-02 12:22:44 +00:00
jan.nijtmans 48a249a15e merge 8.7 2018-05-01 18:43:55 +00:00
jan.nijtmans c326a21131 merge 8.6 2018-05-01 18:42:05 +00:00
jan.nijtmans 51208ca53e Implement special "string totitle" for Extended Georgian characters (new behavior in Unicode 11) 2018-05-01 18:41:27 +00:00
dgp 71938f034c merge 8.5 2018-04-30 12:14:25 +00:00
dgp 0fc27b893e Contain platform-specific things in the constraint-controlled parts of the test. 2018-04-30 12:11:14 +00:00
sebres debcb2bf01 amend after merge 8.5 2018-04-30 11:52:12 +00:00
sebres 6ef77228ca merge core-8-5-branch (fix-1613456fff) 2018-04-30 11:36:31 +00:00
sebres ddfce0ed3f merge fix-1613456fff, closes [1613456fffffffff] and [27b682284974d0cd] 2018-04-30 11:10:14 +00:00
jan.nijtmans 678622482a Merge 8.7 (= upgrade to Unicode 11 beta) 2018-04-29 21:15:10 +00:00
jan.nijtmans bfc5a0090f Upgrade everything to Unicode 11 (still in beta, expected in june 2018) 2018-04-29 21:14:21 +00:00
jan.nijtmans c23982e3c2 Now really fix [9f3c253df5eec5669673d05fe3a51e4afcf99418|9f3c253df5] : Tcl build broken on Win. (tested on Visual Studio 2017) 2018-04-29 20:02:48 +00:00
jan.nijtmans a85834a18e Merge 8.7 2018-04-26 08:33:30 +00:00
jan.nijtmans 9e733498f1 Update test-cases, so they are selected or not for -DTCL_UTF_MAX=6. Now all relevant test-cases pass for TCL_UTF_MAX=6 builds on UNIX (but not yet on Windows)! 2018-04-26 08:32:19 +00:00
jan.nijtmans 36aca800d0 Fix MSVC build [9f3c253df5] 2018-04-25 21:57:27 +00:00
dgp a14cef18c0 merge 8.7 2018-04-25 11:49:20 +00:00
dgp 859bcc9f86 merge 8.6 2018-04-25 11:48:43 +00:00
dgp c876decde3 Doc typo fix from Andy Goth. 2018-04-25 11:48:14 +00:00
andy b104b5ce6e Merge fork 2018-04-24 23:00:56 +00:00
dgp a794e440ae Merge 8.7 2018-04-24 13:51:12 +00:00
dgp fec8aee1a1 Merge 8.6 (bug-fix and test-case for Tcl_UtfAtIndex with TCL_UTF_MAX=4)
((Replacement checkin for earlier attempt with botched timestamp))
2018-04-24 13:45:57 +00:00
jan.nijtmans 4519681dcd Bug-fix in Tcl_UtfAtIndex (for TCL_UTF_MAX=4 only). With test-case (in "string totitle") demonstrating the bug. 2018-04-23 23:23:00 +00:00
jan.nijtmans 1905291fed merge 8.7 2018-04-23 15:07:29 +00:00
jan.nijtmans 27c2e432b5 Some better surrogate handling in encodings. Not spotted before ... 2018-04-23 15:06:40 +00:00
jan.nijtmans 9acb063268 Add some state to encodings, so we can do better surrogate handling for TCL_UTF_MAX >= 4. Backported from TIP #389. 2018-04-23 14:56:44 +00:00
dgp 09a6e8adca merge 8.7 2018-04-23 13:53:04 +00:00
dgp 523d6ea42c Dup test name. 2018-04-23 13:51:05 +00:00
bll 95f2469359 Rework 'array for' to pass the arrayNameObj to the NRE routines
rather than saving it in the ArraySearch structure (which will
not work).
Create ArrayPopulateSearch to consolidate duplicate code.
2018-04-23 12:58:41 +00:00
dgp d513bef710 merge 8.7 2018-04-22 13:28:42 +00:00
dgp dc6bc431e9 merge 8.6 2018-04-22 13:27:45 +00:00
dgp 8e06fd796b [46a2410650] compiled [unset] was bypassing cleanup of active array search.
Overdue thanks to Andy Goth for tests and report.
2018-04-22 13:22:20 +00:00
dgp ae76fbd559 DeleteArray has only one caller. It is called on the "dummy" variable
that is created during unset, and which cannot be reached by resolving
any name. It cannot have VAR_SEARCH_ACTIVE set because the sole thing that
sets that flag is an [array startsearch] applied to a named variable.
2018-04-20 20:17:17 +00:00
dgp 751fe9de93 merge 8.7 2018-04-20 16:55:30 +00:00
dgp 24d501cb0d TIP 421 Implementation. 2018-04-20 16:02:47 +00:00
jan.nijtmans 0569fc46c8 merge 8.7 2018-04-20 10:18:29 +00:00
jan.nijtmans ca5638e01f TIP #389 implementation. 2018-04-20 10:16:31 +00:00
jan.nijtmans 1734eed89f Slightly improved (more fail-safe) surrogate handling for TCL_UTF_MAX>3. Backported from latest TIP 389 implementation. (to be used for androwish) 2018-04-19 22:29:00 +00:00
dgp 5c2ea0542f Adapt [array for] to use the refactored routines. 2018-04-19 17:46:37 +00:00
dgp 346eec1892 merge 8.7 2018-04-19 17:40:10 +00:00
oehhar ddb7bbe66c correct msgcat test numbering for section util from 15.x (used twice) to 18.x 2018-04-19 11:48:28 +00:00
dgp 697d8c5398 merge 8.7 2018-04-19 02:51:50 +00:00
dgp 567fb6cc27 merge 8.6 2018-04-19 02:45:38 +00:00
dgp 75bd116527 Fold TclArraySet() into its only caller. tclEnv.c no longer calls it 2018-04-19 02:01:29 +00:00
dgp 7ac6487eda merge 8.5 2018-04-19 01:41:13 +00:00
dgp df94eecf11 An [array set] from a dict can only take shortcuts when the dict is "pure",
that is, has no string rep.
2018-04-19 01:39:38 +00:00
dgp 8d0340e39e Refactor error reporting when value is not an expected array variable name. 2018-04-18 23:41:48 +00:00
dgp 61f580bd36 Refactor to bring the test for existence of an array variable into
LocateArray().
2018-04-18 23:31:07 +00:00
dgp 08c1a8dd34 cleanup of refactor 2018-04-18 21:03:53 +00:00
dgp fb91d4b68b Refactor the common operations of looking up and checking traces on an array
variable into a single routine LocateArray().
2018-04-18 19:21:33 +00:00
oehhar 327595170b http::geturl now returns full error stack information if the initial socket command fails Ticket [ff82755e15] 2018-04-18 11:59:57 +00:00
jan.nijtmans 28ac086633 Slightly better unmatched-surrogates handling. Unmatched High surrogates will still be silently removed, but Unmatched Low surrogates will pass through as-is now. Inspired by Kevin Kenny's remarks. Thanks! 2018-04-17 21:49:00 +00:00
dgp 6b8039a952 Refactor array trace handling into a common routine TclCheckArrayTraces(). 2018-04-17 20:29:02 +00:00
dgp 62ea5e49a1 Array trace firing must come before argument checking might raise error. 2018-04-17 19:14:01 +00:00
dgp 5dff80f2fe Gentler fallback. 2018-04-17 18:54:36 +00:00
dgp f316d7539c [array set] must fire array traces. Don't disrupt that by reporting argument
errors too early.
2018-04-17 18:34:41 +00:00
dgp bdc679352c merge 8.7 2018-04-17 14:39:42 +00:00
dgp 31a291920a merge 8.6 2018-04-17 14:39:12 +00:00
dgp 05845fbe5f merge 8.5 2018-04-17 14:38:28 +00:00
dgp 80e5aed49e Restore build success to the TCL_REMOVE_OBSOLETE_TRACES configuration. 2018-04-17 14:32:30 +00:00
dgp 47fc4afd86 Satisfy test var-23.14 2018-04-17 11:11:35 +00:00
dgp 08d704bbb1 Test of shimmer segfault. 2018-04-17 03:48:47 +00:00
dgp 2d5be38603 Memleak fix from Brad Lanam. 2018-04-16 14:15:22 +00:00
dgp e42804a0c2 merge 8.7 2018-04-16 13:41:14 +00:00
jan.nijtmans 368acc3d50 Fix [9f3c253df5eec5669673d05fe3a51e4afcf99418|9f3c253df5]: Tcl build broken on Win. Re-introduce TCL_NORETURN1, apparently still needed on MSVC. 2018-04-15 23:06:00 +00:00
andy 4f69e81ae0 Fix documentation typo 2018-04-12 01:58:52 +00:00
dgp 994ba283c9 merge 8.7 2018-04-11 16:17:44 +00:00
dgp 019016e71a merge 8.7 2018-04-11 12:45:01 +00:00
sebres 9856afd590 win: some test-cases missing constraint for testexcept (if compiled without test) 2018-04-11 11:28:41 +00:00
sebres a9ef86f152 win: fix several test-cases for windows platform 2018-04-09 19:50:12 +00:00
sebres 24a04c0819 amend to [5acb57c7aec45e05]: set code to TCL_ERROR, because primitives from tclIOUtil return -1 2018-04-09 10:04:23 +00:00
dgp 4647cfb665 merge 8.6 2018-04-07 17:07:09 +00:00
dgp ff7812fe97 merge 8.5 2018-04-07 16:56:53 +00:00
dgp 689f5653f9 Correct out-of-date documentation for [string is]. 2018-04-07 16:55:53 +00:00
sebres 9077b8ce60 [27b682284974d0cd] command "file delete": avoid possible race condition if file/directory deleted after call of lstat, so bypass ENOENT error code.
Thanks to Rainer Müller (aka raimue)
2018-04-06 17:28:56 +00:00
dgp 50698aacbf merge 8.7 2018-04-05 17:59:28 +00:00
dgp 634c443219 Plug memleak in [format] applied to bignums. 2018-04-05 17:22:09 +00:00
dgp 43507f353b Plug memleak when [scan] raises an error. 2018-04-05 16:37:35 +00:00
dgp b86f569b11 merge 8.7 2018-04-05 15:38:14 +00:00
dgp eb8817687f [string cat] was failing to NUL terminate string reps.
Stopped "string" values triggering false valgrind alarms when tests make
use of [tcl::unsupported::representation].
2018-04-05 15:37:40 +00:00
dgp 754c5a5fe1 merge 8.7 2018-04-05 13:36:34 +00:00
dgp 0ad3b13e26 Failed to mutex protect all multi-thread access to the hash tables in the
[tcl::process] implementation. This was causing segfaults in thread-8.1.
2018-04-05 13:34:58 +00:00
dgp d525fa6f68 merge 8.7 2018-03-30 21:10:04 +00:00
dgp 4cc60d34fb merge 8.7 2018-03-30 20:08:10 +00:00
dgp a5d6e9657a Refactor the [lrange] machinery into a single routine TclListObjRange().
Apply some optimizations. Contribution from pspjuth.
2018-03-30 19:22:17 +00:00
dgp a27e0ef2ce merge 8.7 2018-03-30 19:11:39 +00:00
jan.nijtmans 220d2d7d9c Remove MINGW32 from the UNIX makefile, since Mingw should always build from the "win" directory. Better to avoid confusion. 2018-03-26 20:21:00 +00:00
jan.nijtmans e1e6b685fd merge 8.7 2018-03-25 19:21:11 +00:00
jan.nijtmans 08dc58ce40 No need any more on 64-bit cygwin for special *Long* stub entries. 2018-03-25 19:20:28 +00:00
jan.nijtmans cc19135f2e merge 8.7 2018-03-25 17:43:52 +00:00
jan.nijtmans 3abde0eac5 workaround for TclFormatInt on CYGWIN is no longer necessary now. 2018-03-25 17:43:09 +00:00
José Ignacio Marín 2cf7904bd2 Update TZ info to tzdata2018d. 2018-03-24 10:22:06 +00:00
José Ignacio Marín 29f8e6add3 Update TZ info to tzdata2018d. 2018-03-24 10:21:29 +00:00
José Ignacio Marín 05c789647a Update TZ info to tzdata2018d. 2018-03-24 10:20:43 +00:00
sebres da169b1600 minor fix on comment (restored getFileSecurityProc back, because getNamedSecurityInfoProc not used) 2018-03-22 17:45:32 +00:00
sebres 570af63547 win: fixes check of file permissions (readable, writable, executable) - more faster and stable solution without direct check of security permissions by optimal terms;
additionally corrected executable extensions (missing .ps1/.cmd) in useWide case.
2018-03-22 16:22:04 +00:00
dgp 84fe9556f1 merge 8.7 2018-03-20 19:58:27 +00:00
dgp 919a1c67ab TIP 503 implementation. 2018-03-20 19:54:32 +00:00
dgp dc07332444 Merge over testing improvements from the TIP 475 work.
Test files string.test and stringComp.test had become out of sync.
Use one file to maintain even coverage.
2018-03-20 19:25:54 +00:00
dgp bac2aebf10 Test and fix for botch in binary string replace. 2018-03-20 16:10:49 +00:00
jan.nijtmans c20405e576 Merge-mark (here makefile.vc still had the correct CRLF line-endings) 2018-03-15 21:02:00 +00:00
jan.nijtmans df06afadcf Bring back makefile.vc to CRLF line-endings, as all other *.vc files 2018-03-15 20:58:00 +00:00
dgp 7435702d63 merge 8.7 2018-03-15 15:34:00 +00:00
dgp c120622483 merge 8.7 2018-03-15 14:37:55 +00:00
dgp a8ffcb0b4c merge 8.7 2018-03-15 14:18:39 +00:00
dgp 795355ee43 merge 8.7 2018-03-15 11:11:33 +00:00
dgp aa199edba6 merge 8.6 2018-03-15 11:08:08 +00:00
dgp c5e979695a Missing test cleanups that break later tests. 2018-03-15 10:58:13 +00:00
dgp 2977f2ab44 merge 8.7 2018-03-15 00:01:37 +00:00
dgp 5d355c0fd9 Memleak and lifetime management fixes for components of the OO system. 2018-03-14 23:54:31 +00:00
dgp e6e44fb3b8 Merge rest of 8.7 except the botched apply/backout dance. 2018-03-14 23:47:46 +00:00
dgp 6fcbcd9f12 Merge in 8.7 changes not already here. 2018-03-14 23:43:32 +00:00
dgp 4751bcf256 Rebase the memleak work. 2018-03-14 22:39:38 +00:00
dgp 99ab923ed5 Memleak and lifetime management fixes for components of the OO system. 2018-03-14 22:17:51 +00:00
dgp 72c721f3e7 merge 8.6 2018-03-14 21:51:13 +00:00
dgp 6d4320b5fb A few test hygiene fixes. 2018-03-14 20:59:01 +00:00
pooryorick 73de582148 Further work to improve Object reference accounting in order to plug leaks. 2018-03-14 20:43:20 +00:00
dgp 8ecdd7277d merege 8.7 2018-03-14 18:09:20 +00:00
dgp d0bce3e99f merge 8.6 2018-03-14 18:08:55 +00:00
sebres 1bf60bab3c optimize compiled (INST_STR_TRIM): use new function TclTrim instead of combination of TclTrimLeft/TclTrimRight 2018-03-14 17:23:24 +00:00
dgp 93e9d2457c merge 8.7 2018-03-14 17:21:29 +00:00
dgp 43f670e530 unused variable fix 2018-03-14 17:20:53 +00:00
sebres 77ab9f868a merge 8.5 2018-03-14 17:19:23 +00:00
sebres 6e7c474da7 TclTrim: special case for TrimRight on single char result of TrimLeft (this char is already verified within TrimLeft, so bypass TrimRight at all) 2018-03-14 17:17:44 +00:00
dgp 3f7e1dc18f merge 8.7 2018-03-14 16:17:48 +00:00
dgp 2d87ed6d29 New routine TclStringReplace() serves as a common implementation for both
compiled and direct eval paths of [string replace].
One routine to debug, optimize, convert to new data structures, etc.

This routine will also make a good core engine for [string insert].

With this refactoring done, the value of the INST_STR_REPLACE instruction
is no longer clear.  Until now, the value of compiling to it was that it
routed you through the "better" of the two implementations.  An
instruction that does nothing different from what invocation to the
direct eval fallback would do does not have obvious value.
2018-03-14 15:17:27 +00:00
dgp 6111cf68fe merge 8.7 2018-03-14 05:51:18 +00:00
dgp 3cda2dc805 merge mark 2018-03-14 05:41:55 +00:00
dgp 0a3e263036 cherry pick the desirable part of the merge. 2018-03-14 05:41:19 +00:00
dgp 864d754a8a backout the latest merge 2018-03-14 04:45:29 +00:00
dgp b16ec6f23b Backout recent patch working on Object and Namespace refcounts.
It creates new leaks and memory corruption according to valgrind,
and the preceding checkin did not.  Keep developing on the memleak branch
and it can merge again when valgrind and memleak tests both like it.
2018-03-14 04:26:41 +00:00
dgp 17e2ed6919 silence compiler warning 2018-03-14 01:31:10 +00:00
dgp 15bfd5756e merge 8.6 2018-03-14 01:30:16 +00:00
dgp 0d0b8e03ed merge 8.5 2018-03-14 00:53:13 +00:00
dgp fd2d896c8f TclTrim must write to *trimRight even when making a quick exit. 2018-03-14 00:45:14 +00:00
dgp f597744c5f Make TclTrim* routines robust against some malformation in inputs.
Better than access violations and panics!
2018-03-14 00:03:59 +00:00
dgp 261fbdac7e A few minor revisions. 2018-03-13 23:56:22 +00:00
pooryorick ec5288cc2e Audit and correct Object reference counting issues. 2018-03-13 20:46:08 +00:00
pooryorick 90f38b1023 Audit and correct Object reference counting issues. 2018-03-13 20:41:23 +00:00
sebres 64eaafad72 remove unexpected panic by TclTrimLeft/TclTrimRight, handling rewritten:
- instead of check the NTS-byte after string (may cause segfault by access violation if out of range),
  it checks now the end-character is well-formed utf8-sequence;
- both work well now on non-NTS strings (without null character at end);
- additionally fixed wrong offsets (trim-length if last char malformed in case of out of range);
new function TclTrim introduced (as combination of TclTrimLeft/TclTrimRight).
2018-03-13 18:52:45 +00:00
dgp f8081ac245 merge 8.7 2018-03-13 17:30:00 +00:00
dgp 62079a5c69 merge 8.6 2018-03-13 17:14:40 +00:00
dgp 41ed3e0e2b close fork 2018-03-13 16:29:50 +00:00
dgp 9ac074bd09 Fix bugs in msgcat that prevent clean test suite run. 2018-03-13 16:28:43 +00:00
oehhar bbae63cfa9 tip 499 msgcat custom preferences: documentation added 2018-03-13 16:13:02 +00:00
dgp a275b8a5ea Rewrite the [string replace] compiler to take advantage of the richer
set of encoded index values.
2018-03-13 16:03:39 +00:00
oehhar 962427e8cd tip490 oo for msgcat: added documentation 2018-03-13 14:53:16 +00:00
dgp debafda1e7 Repair the INST_STR_REPLACE instruction. 2018-03-13 04:01:03 +00:00
dgp 1af314024c Merge new test and comments from 8.5 to demo that INST_STR_REPLACE is bad. 2018-03-13 03:26:42 +00:00
dgp 23178bb208 Tidy up and comment [string replace] and its corner cases. 2018-03-13 03:15:28 +00:00
dgp a14ab9eecb merge 8.7 2018-03-12 16:00:11 +00:00
dgp 2ae2445072 msgcat 1.7.0 features need foundation of Tcl 8.7. 2018-03-12 15:57:54 +00:00
dgp ccb7c3b60b merge 8.7 2018-03-12 14:49:44 +00:00
dgp 8bd4a8cf2c Revert change that broke usage with Tcl 9 2018-03-12 14:41:20 +00:00
dgp 5ff641a603 merge 8.6 2018-03-12 14:17:52 +00:00
dgp 71618ce230 Implement TIP 499: Custom locale search list for msgcat 2018-03-12 14:14:46 +00:00
dgp f35817ce5a Undo setting of execute permissions. 2018-03-12 14:07:26 +00:00
dgp 3af272b07a Implement TIP 490: msgcat for TclOO 2018-03-12 13:58:21 +00:00
dgp 67a242e003 msgcat 1.7 uses [tailcall], so requires Tcl 8.6. 2018-03-12 13:48:35 +00:00
dgp 4ba8623115 Implement TIP 462: Add New [::tcl::process] Ensemble for Subprocess Management 2018-03-12 13:38:46 +00:00
dgp 410bda416e merge 8.7 2018-03-12 13:24:15 +00:00
dgp 861217dbe3 Convert DOS -> unix line endings. 2018-03-12 13:07:50 +00:00
dgp a28f176470 It is confusingly stupid to use variable "length" to hold an actual length
in part of a routine, and hold an end index value later.
2018-03-12 02:48:59 +00:00
dgp 9b9635f82e merge 8.7 2018-03-11 22:34:51 +00:00
dgp c5ae3a0a2d merge 8.7 2018-03-11 21:42:22 +00:00
dgp 45f5143205 merge 8.6 2018-03-11 21:29:10 +00:00
dgp de9c1aff4a plug memleaks 2018-03-11 21:15:27 +00:00
dgp e7a5b8aaa5 Prevent leaks of the Object structs of oo::object and oo::class. 2018-03-11 21:14:41 +00:00
dgp cd39f34fa5 Attempt at providing the missing instance squelcher. 2018-03-11 18:08:00 +00:00
dgp c7e8d507d9 merge 8.7 2018-03-11 12:33:16 +00:00
dgp e7be4a19a0 merge 8.6 2018-03-11 12:22:00 +00:00
dgp a0374a6e61 plug memleak of constructed package requirement. 2018-03-11 12:14:05 +00:00
dgp 3f3c89a947 Screen out empty list value so that assertions are true. 2018-03-11 12:13:11 +00:00
dgp d660f467cb merge 8.7 2018-03-10 16:03:02 +00:00
dgp 6b5d0e5d8d merge 8.6 2018-03-10 15:45:00 +00:00
dgp d9dbcf5afb Remove unused argument. 2018-03-10 15:41:04 +00:00
dgp 4dc5255a8e [db36fa5122] Upgrade the index value parsing and encoding machinery. Refactor many systems to make consistent use of it. Repairs many indexing errors in corner cases. 2018-03-10 14:55:14 +00:00
dgp e7a86d967c Use LIST_MAX instead of computing an end index. 2018-03-10 14:44:05 +00:00
dgp 6fce39545c rename tests to make room for new tests in 8.7 2018-03-10 14:37:36 +00:00
dgp 87fd09e44a [db36fa5122] Upgrade the index value parsing and encoding machinery.
Refactor many systems to make consistent use of it. Repairs many indexing
errors in corner cases.
2018-03-09 22:18:30 +00:00
dgp cd4e0ec5de Restore safety for legacy bytecode. 2018-03-09 21:18:19 +00:00
dgp 954522812e Return routine to file scope. 2018-03-09 21:07:12 +00:00
dgp db9b0eccf3 merge 8.6 2018-03-09 20:58:20 +00:00
dgp 06c3fd0c5b Newer utility routine is more suitable. 2018-03-09 20:46:54 +00:00
dgp c13e34da37 Update the command compilers and bytecode execution engine to use new machinery. 2018-03-09 20:34:33 +00:00
dgp a9d546dfbc Use new machinery to repair index value flaws in [lsort]. 2018-03-09 19:40:01 +00:00
dgp 6798b2404f Refactor the index value encode/decode machinery for broader use.
Make use of it to fix index value flaws in [lsearch].
2018-03-09 19:23:42 +00:00
dgp 5fd318bc35 More demonstration tests of index value encoding flaws. 2018-03-09 17:30:30 +00:00
dgp 88812125b1 New tests demonstrating index value encoding flaws in [lsearch]. 2018-03-09 15:28:35 +00:00
dgp 947fb98db5 Stop failing error ordering tests in compiled [lreplace]. 2018-03-08 21:58:30 +00:00
dgp ed53b715ac Another error ordering test. 2018-03-08 19:43:57 +00:00
dgp b8b87e5280 New test expose flaw in error ordering. 2018-03-08 19:28:58 +00:00
dgp 0c5bd7480e Streamline index decoding in INST_LIST_RANGE_IMM execution.
Eliminte the internals intrusion in the unshared in-place operations case.
Tcl_ListObjReplace() really ought to be good enough.
2018-03-08 18:57:16 +00:00
dgp 64038c5656 Rollback the stealth change to [lreplace a 1 1] in Tcl 8.6.6. [409ea17e37].
Scratch rewrite of the [lreplace] compiler.
2018-03-08 17:26:49 +00:00
dgp 101ac8bca7 Reduce the "clever" factor. (Fine line between clever and stupid.) 2018-03-08 02:28:49 +00:00
dgp 30e7e05895 Streamline index decoding in INST_STR_RANGE_IMM execution. 2018-03-07 21:45:12 +00:00
jan.nijtmans cb242c0d50 Merge 8.7 2018-03-07 21:41:00 +00:00
jan.nijtmans b4d6691add Merge 8.6 2018-03-07 21:21:00 +00:00
dgp ce6aa3ea08 When index parsing alone tells you a [string range] is empty, just push it. 2018-03-07 21:02:44 +00:00
jan.nijtmans 3492c92f3d Improve -DTCL_NO_DEPRECATED compiles. It now can handle loading stub-enabled extensions with incompatible magic number (backported from trunk) 2018-03-07 20:24:00 +00:00
dgp d7f41b448c Express INST_LIST_INDEX_IMM index processinig in terms of TCL_INDEX_END so
that consistencies are maintained, and hardcoded values are a bit demystified.
2018-03-07 19:55:23 +00:00
jan.nijtmans 405b9175e6 Fix handling of "pkgIndex" file in "package files" command. This was broken as well, as result of NRE-enabling the "package" command. 2018-03-07 19:35:00 +00:00
dgp 2c44354d13 Establish 4 symbols for categories of parsed index values:
TCL_INDEX_START = 0		The start index.
    TCL_INDEX_END = -2		The "end" index.
    TCL_INDEX_BEFORE = -1	All indices less than start.
    TCL_INDEX_AFTER = INT_MAX	All indices greater than "end".

Then use these symbols among callers of TclGetIndexFromToken() so that
index value parsing can directly implement the callers sense of when
out of range indices ought to be treated the same as start or end positions.
2018-03-07 18:39:44 +00:00
dgp 612199cbe9 Rework TclGetIndexFromToken to make use of TclGetEndOffsetFromObj, and
to lay out the index value encoding cases.
2018-03-07 17:02:50 +00:00
sebres f337281f75 amend to [58716e0e92]: now the duplication is really pointless, so eliminated 2018-03-07 15:10:44 +00:00
dgp 7fe003f8d2 Remove pointless duplication. 2018-03-07 14:16:08 +00:00
dgp f003df5624 Tests of [assemble] use of compiled index values. 2018-03-07 13:40:54 +00:00
dgp 9fb9471807 Incorporate sebres work on the same ticket. Good stuff! 2018-03-07 12:08:40 +00:00
jan.nijtmans 0254080ca0 Fix the "package files" command. Due to the NRE enabling of "package" it always started to return an empty list. 2018-03-06 22:53:00 +00:00
sebres 8c2cbf3211 test cases for "lsort": coverage for "missing from sublist" error case with negative index (-1-1, -2) 2018-03-06 22:27:47 +00:00
sebres c68d043691 try to fix [db36fa5122]: better compiled variants of several indices-related commands, test-cases extended 2018-03-06 21:59:53 +00:00
dgp 720c8de452 rework error handling to keep test suite happy. 2018-03-06 20:59:44 +00:00
dgp 596e89b17d Have assembler use same index value parser as the bytecode compiler. 2018-03-06 20:27:39 +00:00
dgp 847a048c18 New internal routine TclGetEndOffsetFromObj. 2018-03-06 20:09:00 +00:00
bll a735b5d3ac array for:
Add missing ObjCmdProc wrapper around the NR proc.
2018-03-06 18:42:25 +00:00
bll d2d193de11 array for: updated documentation: value variable is not optional, add
specifics about when array for terminates.
2018-03-06 18:21:34 +00:00
dgp da8fbb89c4 various bits of ranting commentary 2018-03-06 17:38:44 +00:00
bll 77d58c5993 tip-421: array for:
a) Fix bug starting search (name not set).
  b) Fix error message for array change on iteration.
2018-03-06 17:19:40 +00:00
dgp 6bb961ffc6 merge 8.7 2018-03-06 13:46:24 +00:00
dgp 24c4a4cc6e Remove all the code supporting legacy opcodes.
Restructure to pave the way for re-ordering the opcode table, if we can
agree that some other order is better.
2018-03-06 13:37:22 +00:00
dgp 683e97521e merge 8.7 2018-03-06 13:21:10 +00:00
dgp 0d33258649 merge 8.6 2018-03-06 12:59:23 +00:00
dgp e5f3c1495b Compiler warning in a --enable-symbols=compile build 2018-03-06 12:10:45 +00:00
dgp 057d325d35 Remove disabled code and reformat. 2018-03-06 12:02:11 +00:00
dgp 54654ae7e4 Convert macros to enums - constrained by need for matching table. 2018-03-06 05:27:21 +00:00
dgp a6dd04e6da experiment 2018-03-06 04:08:54 +00:00
dgp 14a3439dd8 Remove all code supporting legacy instructions. 2018-03-05 22:16:03 +00:00
dgp 695856b85c unbreak 2018-03-05 20:58:32 +00:00
dgp d07756fc70 WIP removing bytecode instructions that are no longer issued. 2018-03-05 20:30:38 +00:00
dgp 79c79df0e1 merge 8.7 2018-03-05 20:05:45 +00:00
dgp f406561f40 Take the next step in TIPs 330 and 336, ending in 8.7 the USE_INTERP_RESULT and
USE_INTERP_ERRORLINE directives to escape need to migrate to 8.6 interfaces.
2018-03-05 20:00:06 +00:00
dgp 80c3bfdcaa Last bit of TIP 503 implementation. 2018-03-05 19:29:12 +00:00
sebres 465d28aa75 merge core-8-5-branch (fixes [1873ea0ee4f01b26]: wrong initialization of std-channels ...) 2018-03-05 17:43:42 +00:00
dgp 96e07632d9 merge 8.7 2018-03-05 17:41:24 +00:00
sebres 6c0170972f fixes [1873ea0ee4f01b26]: wrong initialization of std-channels, if no std-handles available at all (e. g. non-console application, like "tk") 2018-03-05 17:37:21 +00:00
dgp 2e1e641d75 merge 8.7 2018-03-05 17:16:50 +00:00
dgp 4d47b7f97f TIP 351 Implementation. 2018-03-05 17:07:14 +00:00
dgp b1e6769ef3 Rebase TIP 421 implementation to core-8-branch (8.7). var-23.1[01] segfaults! 2018-03-05 16:49:07 +00:00
jan.nijtmans aef69d0b0f Merge 8.7 2018-03-01 22:37:00 +00:00
jan.nijtmans 0e5d21e88f Re-generate tclTomMath.h. Fix win32 build (due to the use of uint8_t) 2018-03-01 22:27:00 +00:00
jan.nijtmans bfb19782c9 Merge 8.7 2018-03-01 21:06:20 +00:00
jan.nijtmans 0c568099ee Update libtommath to latest "develop" 2018-03-01 20:55:16 +00:00
jan.nijtmans 5753c7a42b Lots of code cleanup, mainly [https://github.com/libtom/libtommath/pull/102|Pull request #102] 2018-03-01 20:43:31 +00:00
dgp 914d6e1546 merge 8.6 2018-03-01 20:13:25 +00:00
dgp 683dada217 Some comments info for the next folks who come wandering in. 2018-03-01 20:07:29 +00:00
dgp 2cd8bf554e Refactor to eliminate duplicate routine parsing tokens as indices. 2018-03-01 16:48:55 +00:00
dgp e9c0312caf We have LLONG_MIN and LLONG_MAX to denote range limits of Tcl_WideInt.
Use them consistently. Also fix a few TIP 484 bugs.
2018-03-01 04:13:15 +00:00
jan.nijtmans b31a3b3d70 Merge 8.7 2018-02-27 21:12:00 +00:00
jan.nijtmans 9a809e614a Use mp_isneg() in stead of mp_cmp_d() when the output of this function is simply compared with MP_LT. 2018-02-27 20:48:00 +00:00
jan.nijtmans 0bceead396 No need to set/restore tcl_precision in this test-case 2018-02-27 20:30:00 +00:00
dgp fa036d2b99 merge 8.7 2018-02-23 18:10:09 +00:00
dgp 6faf2feff2 Don't let presence of a string rep prevent optimizations on "pure" bytearrays. 2018-02-23 17:49:23 +00:00
dgp 9090aca429 Remove tests of "end-offset" Tcl_ObjType, taken private. 2018-02-23 17:17:47 +00:00
dgp fe83175465 [8e6a9ac221] Stop false matching with bytearrays. (string-11.55) 2018-02-23 17:02:08 +00:00
dgp 468041eef8 [8e6a9ac221] Stop false matching with bytearrays. (string-11.55) 2018-02-23 17:00:03 +00:00
dgp 85233a4693 [8e6a9ac221] Stop false matching with bytearrays. (string-11.55) 2018-02-23 16:55:49 +00:00
dgp 4ad7747c62 Cease registration of the "end-offset" Tcl_ObjType. Give it file scope.
Remove the updateStringProc that can never be called.
2018-02-23 15:44:10 +00:00
jan.nijtmans f5bf130f05 merge core-8-branch 2018-02-22 20:09:33 +00:00
jan.nijtmans 812174d578 Correctly distinguish between internalrep.longValue (in case of boolean) and internalre.wideValue (in case of int). Add comment warning for that 2018-02-22 20:03:56 +00:00
dgp 471d356605 [89dfecb6b7] Make thread IDs in testing commands consistent. 2018-02-22 18:59:59 +00:00
dgp 455b61dce3 [89dfecb6b7] Make thread IDs in testing commands consistent. 2018-02-22 18:57:20 +00:00
jan.nijtmans 701d9dbe89 Use internalRep.wideValue as internal representation for booleans. This simplifies the handling of "int" resp "boolean", sharing its internal representation. 2018-02-15 19:54:00 +00:00
dgp 64ef84994a merge 8.7 2018-02-15 18:30:34 +00:00
jan.nijtmans 2d54b68224 Distingish between boolean and int when checking whether a boolean is true or not: The internal representation might be either long or wideInt. 2018-02-15 18:02:00 +00:00
dgp cce4368ace Revert recent commit that changed behavior of TclGetIntForIndex() for a
small subset of cases of overflow in index arithmetic.  This changed the
public behavior of indexes.

I favor what's being done. I only want to do the complete work on a 
feature branch (coming soon), and consider what aspects may benefit from
a TIP, and how we should future-proof the work against expanding ranges
for valid index values in Tcl 9. This touches on issues partially raised in 
TIP 297.
2018-02-15 17:21:46 +00:00
dgp 7a1cc7e3b3 Guarantee the buffer is large enough it will not be overrun. 2018-02-15 15:58:36 +00:00
dgp 0b90c0b92e Stop seeking out the libieee.a library and linking to it when found. 2018-02-15 15:14:56 +00:00
dgp dda81853f3 Stop seeking out the libieee.a library and linking to it when found.
The latest release of the GNU C library, glibc-2.27 has done away with
the libieee.a library. This prompts a review of why Tcl has been using it.

Since Tcl 8.4.0, Tcl has stopped using the matherr() machinery, so we don't
need it anymore for that.

Since Tcl 8.5.0, Tcl post-processes ERANGE for itself when floating point
underflow or overflow can sensibly produce a 0.0 or Inf result instead of
raising an error. We no longer need to configure the system math library to
silence these reports.

A conseqeunce of this change is that TCL_LIBS will no longer include the
linker option -lieee .  This can potentially change the behavior of programs
that embed libtcl.  If so, though, those same programs are going to also have
behavior changed as the new glibc release gets into routine use. We're doing
those programs a favor by stopping masking the discovery that they need to
be updated.
2018-02-15 15:08:17 +00:00
dgp 0af226b20a merge-mark 2018-02-15 13:52:23 +00:00
pooryorick 919808c6a5 merge pyk-backport-to-8-6
DGP: This checkin creates two memleaks, detected by test compile-12.1

That test leaks the allocations at

    tclOO.c, line 401   AllocObject(...)

    tclOODefineCmds.c, line 8143    Tcl_NewObjectInstance()
2018-02-15 10:52:44 +00:00
pooryorick beff988e79 Rearrange a few lines TclRenameCommand to reduce operations. 2018-02-15 10:23:53 +00:00
pooryorick e8f10bd44e merge pyk-TclOO 2018-02-15 10:14:14 +00:00
pooryorick fa3a1e4638 Udate Tcl_ObjectDeleted to reflect recent changes. 2018-02-15 10:05:27 +00:00
pooryorick 74c5043b5a TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. 2018-02-15 09:47:35 +00:00
pooryorick dafcde1702 Fix syntax error in previous commit. 2018-02-15 09:40:40 +00:00
pooryorick e16817b409 Add the check for wrong arguments back to TclOO_Object_Destroy, remove
inadvertant increment of Namespace->refCount.
2018-02-15 09:34:49 +00:00
pooryorick 03a4436237 Streamline TclOO object cleanup routines. 2018-02-15 09:30:29 +00:00
pooryorick e52e074e4f Add TCL_CREATE_NS_IF_UNKNOWN back into Tcl_CreateEnsemble(). 2018-02-15 09:20:50 +00:00
pooryorick 0b5a1c79b7 Fix for [6bca38d59b], TclOO segmentation fault cleaning up objects that that
have mixed themselves into themselves.
2018-02-15 09:10:02 +00:00
pooryorick 0c44c5003d Fix for issue [6cf568a21b]: Tcl_Eval() causes new segfault (TclOO object
creation by qualified name).
2018-02-15 08:53:15 +00:00
pooryorick 2b9b50b436 Minor refactoring of TclOO object reference count booking during object
creation.
2018-02-15 08:38:27 +00:00
pooryorick 80fc86a116 Eliminate some duplicate code in tclOO.c/Tcl_NewObjectInstance(). 2018-02-15 06:45:34 +00:00
pooryorick 1da12398f2 Streamline TclOO object cleanup routines. 2018-02-15 06:35:02 +00:00
pooryorick 4322dab97e merge pyk-command-named-colon 2018-02-15 06:01:09 +00:00
pooryorick 3243dfedd1 Move return type to its own line. 2018-02-15 05:11:15 +00:00
pooryorick fa5058cbca merge (cherrypick): Add missing parenthesis to an expression in TclEnsureNamespace. 2018-02-15 04:56:48 +00:00
jan.nijtmans 494a47ee6e Merge core-8-branch 2018-02-14 22:42:00 +00:00
jan.nijtmans e62743b6ee Move TclGetBooleanFromObj to tclInt.h, so multiple source files can use it. Change some internal variables from int to size_t. 2018-02-14 22:22:00 +00:00
pooryorick ade95255b9 Fix segmentation fault in TclOO that was noted in [16fe1b5807]. Update
coroutine and TclOO object creation routines to use TclCreateObjCommandInNs.
2018-02-14 21:47:57 +00:00
jan.nijtmans f9a0feeb4b fix test-cases, account for differences between Tcl 8.7 and 9.0 2018-02-14 20:59:37 +00:00
jan.nijtmans fcfee868a9 merge core-8-branch 2018-02-14 20:43:51 +00:00
jan.nijtmans 0b96f3fb32 Merge TIP #476 2018-02-14 20:22:45 +00:00
jan.nijtmans 3971514c1b Better range checking in "string index". Add test-case to prove point. 2018-02-14 20:17:22 +00:00
pooryorick e6dd74e90e Lift the restriction on command names names that begin with ":". 2018-02-14 19:07:16 +00:00
pooryorick cf4de002dc New empty branch for other branches that bring changes from core-8-branch back
to core-8-6-branch.
2018-02-14 19:07:14 +00:00
dgp c64afc94f1 merge 8.7 2018-02-14 15:33:29 +00:00
dgp e4364f45cc merge 8.7 2018-02-14 14:50:24 +00:00
dgp 55898c44b9 Fix regression in [expr {0%$bignum}]. 2018-02-14 14:38:15 +00:00
pooryorick b9b319fad2 merge pyk-backport-to-8-6 2018-02-14 14:19:31 +00:00
pooryorick 5d5bd4cd55 Modify TclCreateProc to handle arbitrary argument names, not just ASCII. 2018-02-14 14:05:04 +00:00
pooryorick 1e854210b7 Rewrite documentation in comments for brevity and clarity. 2018-02-14 13:37:27 +00:00
pooryorick 7d25e385a2 Modify test oo-11.6 to not use [self], which is not avaiable until 8.7. 2018-02-14 13:00:28 +00:00
dgp c329006b1a More tests for bignum modulus regressions 2018-02-14 12:52:35 +00:00
dgp 40e9ab2e65 More tests for bignum modules regressions. 2018-02-14 12:52:06 +00:00
dgp dc74da2f56 merge-mark 2018-02-14 12:50:22 +00:00
pooryorick c6eb0cc51d Unit test for issue 3c32a3f8bd, Segmentation fault in
TclOO.c/ReleaseClassContents() for a class mixed into one of its instances.
2018-02-14 12:31:33 +00:00
pooryorick a7c17bc224 Fix bug 3c32a3f8bd, segmentation fault in TclOO.c/ReleaseClassContents()
for a class mixed into one of its instances.
2018-02-14 12:14:38 +00:00
pooryorick 2606a3a7db Fix for issue 9fd5c629c1, TclOO - aborts when a trace on command deletion
deletes the object's namespace.
2018-02-14 10:57:38 +00:00
pooryorick ea6e8c9dcd Fix for issue 9fd5c629c1, TclOO - aborts when a trace on command deletion
deletes the object's namespace.
2018-02-14 10:46:08 +00:00
dgp 01a9d5c7cc merge mark 2018-02-13 21:00:24 +00:00
dgp 4a6163c6a6 test expr-32.7 for bignum modulus range. FAILING for now. Error in TIP 484. 2018-02-13 20:59:36 +00:00
dgp 396c1a637c New test expr-32.7 for bignum modulus range. 2018-02-13 20:51:57 +00:00
pooryorick 1553090bc3 Add remaining wrapper to the NR functions, remaining calls to
TCL_NRAddCallback, and a test for a package require script that yields.

DGP: This checkin introduces a memleak, detected by test compExpr-7.1.
2018-02-12 12:40:34 +00:00
pooryorick f4babdb0ac Adapt signature of PkgRequireCore to conform to Tcl_ObjCmdProc, and call it in
Tcl_PkgRequireProc on an NRE trampoline via Tcl_NRCallObjProc.  Additional
callbacks still needed to fully NRE-enable [package require].
2018-02-12 10:44:44 +00:00
pooryorick 4c79bcbe64 Preparation to provide TclNRPackageObjectCmd: Eliminate the loop in
PkgRequireCore so that TclNRAddCallback can be added at the needed spots.
2018-02-12 10:14:02 +00:00
pooryorick 568724e468 Change the signature of PkgRequireCore in preparation to provide
TclNRPackageObjCmd.
2018-02-11 19:35:27 +00:00
pooryorick ad022e6d3b Remove restriction on defining the class of a TclOO object not explicitly
instantiated from ::oo::class.
2018-02-11 19:29:08 +00:00
pooryorick 5765c1e392 Refine documentation for Tcl_NR* functions. 2018-02-11 19:19:46 +00:00
dgp 967136cc0f merge 8.7 2018-02-09 18:52:04 +00:00
sebres 0031252bf1 small code review: resolve conversion warnings (possible loss of data, signed/unsigned comparison) 2018-02-09 10:09:42 +00:00
jan.nijtmans 4d73b33b87 Fix [9280abbaf57fca3e|9280abbaf5]: Compiling core-8-branch with msvc6 32 bit results in compile error in tclInt.h. Thanks to sebres for the fix. 2018-02-08 20:43:00 +00:00
sebres e2877119cd fixes [9280abbaf57fca3eb40a89403d9d891853209bb6]: compare of LLONG_MAX == LONG_MAX does not possible in preprocessor
(because LLONG_MAX could be complex expression), use `defined(TCL_WIDE_INT_IS_LONG)` instead of.
2018-02-08 14:41:06 +00:00
sebres 451c384456 merge core-8-6-branch 2018-02-08 14:03:59 +00:00
sebres 4f65558ad0 win/nmakehlp.c: removed unneeded dependencies to shlwapi (the same is easily implemented by standard win-api) 2018-02-08 14:02:15 +00:00
oehhar ffae8c82da Do not allow prefixed subcommands for mcutil 2018-02-08 12:45:50 +00:00
oehhar 4cff9271ac Add subcommand mcpreferences to export getpreferences and getsystemlocale functions 2018-02-08 09:49:28 +00:00
oehhar 3f2c5cd5aa TIP 499: Custom locale search for msgcat 2018-02-07 19:25:30 +00:00
jan.nijtmans 5335ab79e5 remove unused stub entries (now that those are macros)
Moved checkin off trunk onto dev branch jn-unused-stubs
because it causes many test suite segfaults, apparently
releated to Tcl_Channels.

Moved back onto trunk. segfaults came from a prior install
of the Thread package that became imcompatible with this
change in the stubs table.  Will followup on TCLCORE.
2018-02-06 22:43:00 +00:00
jan.nijtmans 6ce7eb980b merge core-8-branch 2018-02-06 20:54:35 +00:00
dgp 185cdc39c6 TIP 484: Merge 'int' and 'wideInt' Obj-type to a single 'int' 2018-02-06 20:07:13 +00:00
dgp 365ee5bb13 TIP 493: Cease Distribution of http 1.0 2018-02-06 19:55:18 +00:00
dgp f674720166 Merge the NRE-enabling of [package require]. 2018-02-06 19:43:12 +00:00
dgp a37e29cf85 Rework a set of TclString*() routines for consistency. 2018-02-06 19:35:36 +00:00
dgp fde3c52d29 Rework TclStringReverse to consistent standard form. 2018-02-06 19:10:45 +00:00
dgp 99ca63a80a TclStringLast fixed. 2018-02-06 18:33:41 +00:00
dgp 25fcbf685d Rename TclStringFind to TclStringFirst. Repair its operations on bytearrays.
Stop trying to operate on utf-8 until we nail that down better.
2018-02-06 17:26:40 +00:00
pooryorick 2567185fd2 Add remaining wrapper to the NR functions, remaining calls to
TCL_NRAddCallback, and a test for a package require script that yields.
2018-02-06 11:16:51 +00:00
dgp ca5e7c5b63 Revise the TclStringCat() interface to follow a common pattern. 2018-02-05 16:34:28 +00:00
dgp 836fa11775 Revise TclStringRepeat() interface so that in place operations are done only
by caller request. Establish a re-usable pattern.
2018-02-05 16:10:02 +00:00
dgp 3be49723fc Improved overflow prevention. 2018-02-05 13:41:26 +00:00
dgp da7f77f96f Improved overflow prevention. 2018-02-05 13:33:21 +00:00
pooryorick 98887219c2 Refine documentation for Tcl_NR* functions. 2018-02-03 18:15:06 +00:00
José Ignacio Marín 6bd80d67e4 Update TZ info to tzdata2018c. 2018-02-02 09:21:35 +00:00
José Ignacio Marín 93310b9171 Update TZ info to tzdata2018c. 2018-02-02 09:21:05 +00:00
José Ignacio Marín b618278c9f Update TZ info to tzdata2018c. 2018-02-02 09:19:41 +00:00
apnadkarni e905a75c0f Fix INCLUDE_INSTALL_DIR def when building against Tcl source. Bump rules.vc to 1.2 2018-02-02 06:18:24 +00:00
apnadkarni 73eb8eb8d1 Fix INCLUDE_INSTALL_DIR def when building against Tcl source. Bump rules.vc to 1.2 2018-02-02 06:17:05 +00:00
apnadkarni adf9cf5543 Fixed def for INCLUDE_INSTALL_DIR when building against Tcl source. Bumped to 1.2. 2018-02-02 06:07:26 +00:00
pooryorick 77821adfe8 Fix segmentation fault triggered by test package-3.12. Adapt signature of
PkgRequireCore to conform to Tcl_ObjCmdProc, and call it in Tcl_PkgRequireProc
on an NRE trampoline via Tcl_NRCallObjProc.  Additional callbacks still needed
to fully NRE-enable [package require].
2018-01-31 00:07:22 +00:00
jan.nijtmans ee2574ddce merge core-8-branch 2018-01-29 15:04:33 +00:00
dgp 4f918b61b0 merge 8.7 2018-01-29 13:18:39 +00:00
pooryorick 1a98844412 Preparation to provide TclNRPackageObjectCmd: Eliminate the loop in
PkgRequireCore so that TclNRAddCallback can be added at the needed spots.

This checkin creates a crash in test package-3.12 .

Pushing the work off the 8.7.* branch and onto a feature branch for now.
2018-01-28 18:21:09 +00:00
pooryorick 876f2d5b63 Change the signature of PkgRequireCore in preparation to provide
TclNRPackageObjCmd.
2018-01-28 14:37:53 +00:00
pooryorick fa7659336c Remove restriction on defining the class of a TclOO object not explicitly
instantiated from ::oo::class.
2018-01-27 18:17:09 +00:00
dgp 175fe8c23f Fix segfault due to shimmering in [join $l $l]. (Test join-4.1). 2018-01-27 01:45:27 +00:00
dgp a0c6bf8d92 Regression test for shimmering danger in [join]. 2018-01-27 01:38:21 +00:00
jan.nijtmans d98ee54c8d merge core-8-branch.
Also add range checks to Tcl_GetUniChar() and Tcl_Range(), as suggested by Don Porter.
2018-01-26 16:20:29 +00:00
jan.nijtmans 2eba1ce11e Rename (internal) TclNewWideObj macro to TclNewIntObj. Change Tcl_SetIntObj/Tcl_SetLongObj to macro's referencing Tcl_SetWideIntObj (since all of those do the same now) 2018-01-26 13:29:01 +00:00
jan.nijtmans 6cd01fd0f8 Merge core-8-branch. Also some minor performance improvement: Turn Tcl_NewLongObj/Tcl_NewIntObj/Tcl_DBNewLongObj into macro's refering to their WideInt equivalent, since all of those do exactly the same now. 2018-01-26 12:32:12 +00:00
jan.nijtmans e543dbc09c merge core-8-branch 2018-01-26 10:26:06 +00:00
dgp 46e8af13b6 Dup test name 2018-01-25 22:11:34 +00:00
dgp b0fce7a700 merge 8.7 2018-01-25 21:58:51 +00:00
dgp d20d1e603b test suite debugging 2018-01-25 21:35:01 +00:00
dgp 19c0142741 lifetime management of files generated by tests 2018-01-25 21:28:41 +00:00
dgp 189d0a83d2 lifetime management of files generated by tests 2018-01-25 21:15:36 +00:00
dgp aa4c401952 test name continuity 2018-01-25 20:41:26 +00:00
dgp f08ea44564 Dup test names 2018-01-25 20:28:15 +00:00
pspjuth 83df36ac41 Allow -stride 1. 2018-01-25 20:05:54 +00:00
dgp eb9e2858c1 merge 8.7 2018-01-25 16:51:29 +00:00
jan.nijtmans 68214211b7 Document "L" length modifier and (new) %a/%A specifiers. 2018-01-24 12:02:05 +00:00
jan.nijtmans 32aa419154 merge core-8-branch 2018-01-24 10:01:29 +00:00
jan.nijtmans 92aca935b3 merge core-8-6-branch 2018-01-24 10:00:34 +00:00
jan.nijtmans e403ff8f45 Documentation fix: there is no "O" conversion, just "o" for octal. Also, "b" conversions normally don't produce a sign. 2018-01-24 09:59:15 +00:00
jan.nijtmans 8a7371192a merge core-8-branch. Improve documentation (format.n). 2018-01-24 08:47:24 +00:00
jan.nijtmans 6904b0f77f merge core-8-branch 2018-01-23 15:51:00 +00:00
jan.nijtmans 010f610a80 Don't register oldBooleanType any more. And rename "booleanString" to "boolean" in tclBooleanType. 2018-01-23 15:02:28 +00:00
jan.nijtmans 0abda82b1e In Tcl 9.0, don't register oldBooleanType any more. And rename "booleanString" to "boolean" in tclBooleanType. Many extensions (e.g. [http://cyqlite.sourceforge.net/cgi-bin/sqlite/info/451bb2c1f8554eee|sqlite]) still test for "boolean", although that stopped working already for a long time.
In Tcl 8.7, do the same when compiled with -DTCL_NO_DEPRECATED.
2018-01-23 14:52:34 +00:00
dgp 102d58a165 merge mark 2018-01-22 13:43:05 +00:00
dgp 92c0d0a011 typo 2018-01-22 13:38:47 +00:00
jan.nijtmans fb10dc69ee make the old "int" type "static", since it's just used in a single file. 2018-01-22 09:54:40 +00:00
jan.nijtmans 03a71b0706 Put old "int" type back. Not used by Tcl anymore, but this restores compatibility with Tk < 8.6.9 and some extensions: "nsf", "tdbcload", "tclxml" and "VecTcl"
(this workaround was used by "boolean" as well, when its internal implementation changed, there's still an oldBooleanType because of that)
2018-01-22 09:18:19 +00:00
jan.nijtmans a4953f93f4 merge core-8-branch 2018-01-22 08:41:16 +00:00
jan.nijtmans 3c6933efc0 merge core-8-branch. Declare CONST86 as deprecated in Tcl 9.0 2018-01-20 16:08:21 +00:00
jan.nijtmans 1c35ed873a Follow-up to previous commit (TIP #485 implementation). Actually remove Tcl_Backslash and Tcl_EvalTokens when compiling with -DTCL_NO_DEPRECATED. 2018-01-20 16:02:31 +00:00
jan.nijtmans a43cab006e No longer use (the undocumented) CONST86 anywhere, just keep the define in tcl.h. 2018-01-19 16:08:02 +00:00
jan.nijtmans 93fa41f6c7 Now really remove Tcl_EvalTokens/Tcl_Backslash as promised in the TIP.
And remove library/tzdata/SystemV/* which contains non-standard timezones. See: [d3c5f2eb2ff63f10] They were originally gone since the tzdata2014f update, but it's unwise to do that in a patch release.
Some documentation updates.
2018-01-19 15:17:45 +00:00
dgp bed15f1d81 merge 8.7 2018-01-18 14:05:07 +00:00
jan.nijtmans ac67b57981 merge core-8-branch 2018-01-18 09:46:29 +00:00
stu eb5da6ae82 OpenBSD now has AI_ADDRCONFIG. 2018-01-17 19:01:03 +00:00
jan.nijtmans 4786f9814b clean-up some more remainings of the Itcl hack. Taken over from "novem". 2018-01-17 16:01:42 +00:00
jan.nijtmans d695e02d2f Remove obsolete documentation (belonging to now-removed functions). Remove obsolete 8.4 bytecodes. And a few other (internal) macro's which are no longer in use. 2018-01-17 14:17:21 +00:00
jan.nijtmans 1c58e29da2 Remove Tcl_CaseObjCmd from tclInt.h as well (was missing in previous commit) 2018-01-17 12:56:22 +00:00
jan.nijtmans ed6aa022a6 TIP #485 implementation, Tcl 9.0 part: Realy remove code which was declared deprecated in 8.7 2018-01-17 12:45:01 +00:00
jan.nijtmans 7ea11c7f98 TIP #485 implementation, Tcl 8.6 part: If Tcl is compiled with -DTCL_NO_DEPRECATED, all Deprecated API (as in the TIP) will be gone. 2018-01-17 11:47:37 +00:00
jan.nijtmans e755aba59f merge core-8-6-branch (typo's) 2018-01-17 10:07:42 +00:00
jan.nijtmans 5fea88381c typo's (found by Gustaf Neumann). Thanks! 2018-01-17 10:06:30 +00:00
oehhar 7c60d44ce6 Comment updated 2018-01-16 14:53:41 +00:00
oehhar e89d1e331e Solve case where msgcat is called within a class definition script (works only for 8.7) 2018-01-16 14:13:14 +00:00
jan.nijtmans 9a892a33b7 merge core-8-branch 2018-01-16 08:40:47 +00:00
jan.nijtmans 8e6fe27ecc merge core-8-branch 2018-01-15 11:41:56 +00:00
oehhar e841295386 Install msgcat 1.7 in library folder 8.6 instead 8.5. It uses tailcall and will not work with 8.5 2018-01-13 17:17:39 +00:00
oehhar 87c12599bf Test numbering and naming corrected 2018-01-13 17:14:22 +00:00
oehhar eaacc9bb56 Changed msgcat version from 1.6.2 to 1.7.0 -> this is not a patch release 2018-01-13 16:44:38 +00:00
oehhar ecaec63f48 Extended command msgcat::mcexists by switch "-namespace ns" to explicitly specify namespace 2018-01-13 15:23:38 +00:00
jan.nijtmans f0b9b9fbb6 merge core-8-branch 2018-01-12 16:30:03 +00:00
oehhar e1ffd3f005 Implement the "mcn" command as "mc" with explicit namespace. 2018-01-12 14:52:25 +00:00
oehhar 2cfe8bb561 Use the test "[namespace which self] ne "::oo::Helpers::self"" to check if we are within an object (undocumented test proposed by dkf on clt 2018-01-12 2018-01-12 14:13:03 +00:00
oehhar e9f2695255 replace "return [uplevel 1 [list [namespace origin ..." by tailcall 2018-01-12 14:03:04 +00:00
jan.nijtmans 0019582fd2 merge core-8-branch 2018-01-12 11:18:48 +00:00
jan.nijtmans c8219a9a29 Fix [11ae2be95d]: tip-389 branch: string range errors with code points greater than U+FFFF 2018-01-12 10:03:58 +00:00
oehhar 1fda13591a Corrected test cleanups 2018-01-11 16:46:09 +00:00
jan.nijtmans 27e7f096b2 merge core-8-branch. Remove left-over debugging code. Test-case string-5.21 still fails. 2018-01-11 15:59:17 +00:00
jan.nijtmans 244885a03e merge core-8-6-branch 2018-01-11 15:45:20 +00:00
jan.nijtmans 45e646472d Fix behavior of Tcl_GetRange() and "string range" regarding surrogates, when Tcl is compiled with -DTCL_UTF_MAX=4. Partial fix for bug [11ae2be95dac9417]. Also, fix typo. 2018-01-11 15:44:05 +00:00
jan.nijtmans eb3422673f Add test-cases for bug [11ae2be95dac9417], and make a start fixing it. Almost works. 2018-01-11 14:11:38 +00:00
oehhar 3b5858bcd2 TIP490: oo for msgcal: new solution enable any command for oo, new command mcpackagenamespacege 2018-01-10 23:17:43 +00:00
jan.nijtmans d34c6b6526 merge core-8-branch 2018-01-10 14:33:54 +00:00
jan.nijtmans 2a8fce94bd merge core-8-branch 2018-01-10 14:03:26 +00:00
jan.nijtmans 48d6a20861 Re-implement Tcl_WinTCharToUtf/Tcl_WinUtfToTChar in pure win32 api, even for TCL_UTF_MAX=3. We can do that now safely, because of the changed handling of valid 4-byte UTF-8 characters in the previous commit. 2018-01-10 14:02:03 +00:00
jan.nijtmans 04d3db5592 Don't use TclUtfToUniChar here: it doesn't give any advantage over Tcl_UtfToUniChar 2018-01-10 09:32:51 +00:00
jan.nijtmans 3889f63614 merge core-8-branch 2018-01-10 08:27:03 +00:00
jan.nijtmans 498f069f0e Fix [https://core.tcl.tk/tk/info/00a27923ee26437611e1ed83f96e15b6caabcd8b|00a27923ee]: (Tcl part, remaining is in Tk) text/entry dysfunctional when pasting an emoji on MacOSX.
This changes the handling of incoming valid 4-byte UTF-8 sequences: Those are no longer split in 4 separate characters (as was done for invalid byte sequences) but replaced by a single ' replacement character' .
2018-01-10 08:25:13 +00:00
jan.nijtmans 48456596ff (partial) fix for [https://core.tcl.tk/tk/info/00a27923ee26437611e1ed83f96e15b6caabcd8b|00a27923ee]: text/entry dysfunctional when pasting an emoji on MacOSX.
Don't handle incoming valid 4-byte UTF-8 characters as invalid byte sequences (since they aren't), but as being the Unicode replacement character.
2018-01-09 11:15:14 +00:00
dkf 6d9902632c Some refactoring and tidying up of comments. 2018-01-09 00:10:22 +00:00
pooryorick fafc11d6e0 Merge pyk-TclOO branch. See [90657479e8] 2018-01-08 18:27:57 +00:00
pooryorick 4a5058fc1b Udate Tcl_ObjectDeleted to reflect recent changes. 2018-01-08 18:21:40 +00:00
pooryorick b40ed15606 Rearrange a few lines TclRenameCommand to reduce operations. 2018-01-08 17:36:00 +00:00
pooryorick 7e4261e22c Rearrange a few lines TclRenameCommand to reduce operations. 2018-01-08 17:03:07 +00:00
jan.nijtmans eb1212a3c1 merge core-8-6-branch 2018-01-04 13:01:18 +00:00
jan.nijtmans 063db11523 (cherry-pick): Use http 2 instead of http 1 for Safe Base testing. 2018-01-04 13:00:22 +00:00
jan.nijtmans 26b5bf3eca (cherry-pick): Use http 2 instead of http 1 for Safe Base testing. 2018-01-04 12:58:31 +00:00
dgp 904582dd30 merge 8.7 2018-01-04 02:40:00 +00:00
dgp 6c799d891d Minimal fixes to stop the [package files] machinery writing to freed mem.
This contribution needs a careful review from someone who actually knows
how Tcl_Preserve, etc. work.
2018-01-04 02:32:46 +00:00
dgp 32f3dce79d merge 8.7 2018-01-03 15:11:25 +00:00
pspjuth fc03549d34 Doc for lsearch -stride 2018-01-02 23:05:25 +00:00
pspjuth 54590627ee Add -stride to lsearch. TIP#351 2018-01-02 22:03:02 +00:00
pspjuth 651697f7cd Refactored lrange to common function. 2017-12-29 18:58:01 +00:00
dgp daa36e9a1b Use http 2 instead of http 1 for Safe Base testing. 2017-12-29 17:47:50 +00:00
dgp b0898beca6 Remove http 1.0 tests. 2017-12-29 17:38:10 +00:00
dgp a922e9fd15 Remove http 1.0 files from fossil management. 2017-12-29 16:54:50 +00:00
dgp 6631e46bd3 Remove handling of http 1.0 package files from Makefiles. 2017-12-29 16:49:47 +00:00
pspjuth 0f6d3fd959 Optimise lrange for unshared object. 2017-12-28 23:54:57 +00:00
jan.nijtmans 815ebb9a0f merge core-8-branch 2017-12-28 21:17:22 +00:00
jan.nijtmans d08f08a24d merge core-8-branch 2017-12-28 21:16:13 +00:00
jan.nijtmans 4a038240c4 merge core-8-6-branch 2017-12-28 21:15:20 +00:00
jan.nijtmans ad43c617e3 Fix bug introduced in [0dd0d14489258621] (only for TCL_UTF_MAX > 3): If len parameter = -1, returned size includes terminating 0-byte. So, account for that.
Also, fix some comments which were not accurate any more, now that Windows 95/98 is not supported any more.
2017-12-28 21:14:40 +00:00
jan.nijtmans 7a13be75b6 merge core-8-branch 2017-12-28 20:29:10 +00:00
jan.nijtmans 7172ae9071 merge core-8-branch 2017-12-28 18:53:23 +00:00
jan.nijtmans a27cc004d2 merge core-8-6-branch 2017-12-28 18:51:12 +00:00
jan.nijtmans 301f6bcb83 Fix handling of surrogates (when TCL_UTF_MAX > 3) in Tcl_UtfNcmp()/Tcl_UtfNcasecmp()/TclUtfCasecmp(). Backported from core-8-branch, where this was fixed already. 2017-12-28 18:49:24 +00:00
jan.nijtmans 9a7ce78e96 Make Tcl_WinTCharToUtf/Tcl_WinUtfToTChar work when TCL_UTF_MAX > 3, mainly when sizeof(Tcl_UniChar) != 2. 2017-12-28 18:45:16 +00:00
jan.nijtmans ca634be831 merge core-8-branch 2017-12-28 16:53:34 +00:00
jan.nijtmans e71f41cf89 merge core-8-branch.
Re-implement Tcl_WinTCharToUtf/Tcl_WinUtfToTChar using only win32 API.
2017-12-27 20:24:13 +00:00
pooryorick b0e6ac7da9 merge core-8-branch 2017-12-26 17:27:28 +00:00
pooryorick 63224df965 TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. 2017-12-26 12:54:00 +00:00
pooryorick 9a9b619c9f TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. 2017-12-26 12:27:14 +00:00
apnadkarni b067895cc4 Merged core-8-branch: replace ifdef TCLDIR with compare against empty string 2017-12-26 03:33:35 +00:00
apnadkarni 0b3bf9e30d Merged core-8-6-branch: replace ifdef TCLDIR with compare against empty string 2017-12-26 03:32:05 +00:00
apnadkarni 82cd662f00 Safer to compare TCLDIR against "" rather than ifdef as recursive nmakes
can pass TCLDIR as defined but with an empty value.
2017-12-26 03:30:22 +00:00
jan.nijtmans 9977b3e79c merge core-8-branch 2017-12-23 20:18:01 +00:00
jan.nijtmans e754f70125 merge core-8-branch 2017-12-23 18:41:29 +00:00
jan.nijtmans cae732bd8d merge core-8-6-branch (changes file only) 2017-12-23 18:40:21 +00:00
jan.nijtmans f2f7b85f88 merge release 2017-12-23 18:33:36 +00:00
apnadkarni 2a5955ee50 Merge nmake rules 1.1 2017-12-23 08:05:02 +00:00
apnadkarni 444ba0a874 Merge nmake rules 1.1 2017-12-23 08:02:20 +00:00
apnadkarni 71df313773 Look for Tcl and Tk import libraries with or without "t" suffix convention
when building extensions. Bump nmake rules version to 1.1 accordingly.
2017-12-23 07:56:49 +00:00
jan.nijtmans 264c508ca4 merge core-8-branch 2017-12-22 15:48:07 +00:00
jan.nijtmans 189c6453b4 Change a few (internal) refCount/mask variables to unsigned type. 2017-12-22 15:45:05 +00:00
jan.nijtmans 5a190dd003 Remove use of compiler option "opt:nowin98". Don't use "t" as suffix any more when building extensions (but still use it for Tcl and Tk). 2017-12-21 13:23:38 +00:00
jan.nijtmans 7fdcf0c76d merge-mark 2017-12-21 07:51:08 +00:00
jan.nijtmans 5bcb4bc9a0 merge-mark 2017-12-21 07:50:27 +00:00
pooryorick 28361a2bfe Further fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a
deletion trace deletes its namespace: segmentation fault.
2017-12-20 18:28:10 +00:00
pooryorick c1f84789ba Fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion
trace deletes its namespace: segmentation fault.
2017-12-20 18:26:40 +00:00
pooryorick 5e11793221 Further fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a
deletion trace deletes its namespace: segmentation fault.
2017-12-20 18:25:08 +00:00
pooryorick 7835ba29c7 Further fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a
deletion trace deletes its namespace: segmentation fault.
2017-12-20 18:22:59 +00:00
jan.nijtmans a15b801bfb Remove the Tcl_FindHashEntry/Tcl_CreateHashEntry stub entries, as those are actually macro's. 2017-12-20 12:30:23 +00:00
jan.nijtmans 1b40a62611 Change hash/index/mask fields to type "unsigned int", because that's how hash values are generally stored. This eliminates the need for PTR2UINT/UINT2PTR in various places. 2017-12-20 12:02:34 +00:00
pooryorick dc40e6f797 Fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion
trace deletes its namespace: segmentation fault.
2017-12-20 11:28:25 +00:00
pooryorick 2bfe68441a Fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion
trace deletes its namespace: segmentation fault.
2017-12-20 09:19:59 +00:00
dgp 82512215ff [586e71dce4] Exeception handling at level #0 by EvalObjv 2017-12-19 21:00:55 +00:00
dgp b6f5c15189 [586e71dce4] Exeception handling at level #0 by EvalObjv 2017-12-19 21:00:17 +00:00
dgp 1725b74695 merge 8.6; update changes 2017-12-19 20:53:27 +00:00
dgp e10cd2e0a5 [586e71dce4] Exeception handling at level #0 by EvalObjv 2017-12-19 20:48:52 +00:00
jan.nijtmans 34c238c152 merge core-8-branch 2017-12-19 15:46:25 +00:00
jan.nijtmans 07c71d17a2 Somewhat better backwards compatibility on 64-bit platforms. 2017-12-19 15:20:32 +00:00
dgp f4cc39572c update changes 2017-12-19 14:46:31 +00:00
jan.nijtmans 051a7ec3ae merge core-8-branch 2017-12-19 12:26:54 +00:00
jan.nijtmans a430544f4a merge core-8-branch. Also change some internal refCount's from int to size_t. 2017-12-19 12:23:19 +00:00
jan.nijtmans ee66488c36 Make TclEnsureNamespace() MODULE_SCOPE. Also change some refCount fields from type "int" to "unsigned int" for increased range. 2017-12-19 11:23:13 +00:00
jan.nijtmans f64bba0499 Minor simplification on Cygwin, since we only support Windows NT now 2017-12-19 11:21:33 +00:00
jan.nijtmans dbe18af9ea No need any more to check for "Windows NT" here, since the minimum is XP now. 2017-12-18 14:33:11 +00:00
dgp 9acbab2c0e merge 8.6 2017-12-18 14:06:37 +00:00
jan.nijtmans 52dc6e55e5 merge core-8-6-branch 2017-12-18 13:58:05 +00:00
jan.nijtmans 0fb81cb5dd (cherry-pick): Added assoc, ftype and move as auto_execok shell built-ins on Windows. 2017-12-18 13:56:30 +00:00
jan.nijtmans 0a2389d0ab merge core-8-branch 2017-12-18 11:48:35 +00:00
jan.nijtmans 03e581e857 merge core-8-6-branch. Remove win/coffbase.txt, which isn't used any more. 2017-12-18 11:47:35 +00:00
jan.nijtmans e0360a8c34 Add win/rules-ext.vc and win/targets.vc to "make dist". Reported by Paul Overmeier. Thanks! 2017-12-18 11:41:31 +00:00
jan.nijtmans 4a98f5042e merge-mark 2017-12-15 21:28:35 +00:00
jan.nijtmans aecff8b1e7 Revert a few more (int -> size_t) transitions, which could effect extensions (such as Itcl 3.4) which use internal Tcl header files. Better wait until 9.0 for this.
What we _can_ do is change some (internal) fields to 'unsigned': that doubles the epoch range without further danger. Thanks, Don, for pointing this out!
2017-12-15 21:27:14 +00:00
dgp 62545de5ce merge mark 2017-12-15 17:04:26 +00:00
dgp 67f6f5cdb1 Revert the (int -> size_t) transition of the "cmdEpoch" field of
the struct Command that was part of [ff3f6a12a8d099ef], and related changes.

This change broke the ability of Itcl 3.4 built against Tcl 8.6 headers
to successfully [load] into and operate in a Tcl 8.7 interp.

"Command" is a private struct, and Itcl 3 should have respected that, but
it has not, and changing the size of the cmdEpoch field broke the ability
of Itcl 3 to operate on later fields of the struct, notably the deleteProc,
which it makes extensive use of.

I believe we should keep the change in the Tcl 9 sources.
2017-12-15 16:50:50 +00:00
jan.nijtmans ab6e69444f Merge TIP #488 implementation.
Some clean-up in tommath implementation (remove internal stub entries which are no longer needed)
2017-12-15 15:02:42 +00:00
jan.nijtmans 4fb66d5d55 Mark TclPrecTraceProc() as deprecated, and remove it when compiling with -DTCL_NO_DEPRECATED. See TIP #488 2017-12-15 14:46:11 +00:00
dgp 50bb6253da merge 8.6 2017-12-14 13:32:50 +00:00
jan.nijtmans 556dc3036e Fix (harmless) compiler warning with Visual Studio 2017-12-14 12:02:13 +00:00
pooryorick 3ddcb1cfb5 Fix syntax error in previous commit. 2017-12-13 12:56:02 +00:00
apnadkarni 8bc8d823bb core-8-branch merge: Use nmakehlp -L to locate directories 2017-12-13 10:34:58 +00:00
apnadkarni 191ea171cb core-8-6-branch merge: Use nmakehlp -L to locate directories 2017-12-13 10:31:02 +00:00
apnadkarni 48549d55b0 Updated nmake system to make use of the new nmakehlp -L option for
locating dependencies.
2017-12-13 10:03:54 +00:00
apnadkarni 0ebe3d394d Add -L option to nmakehlp to locate directories 2017-12-12 17:34:13 +00:00
apnadkarni 137a89f1e2 Add -L option to nmakehlp to locate directories 2017-12-12 17:33:21 +00:00
apnadkarni 8c866ee6be Add -L option to nmakehlp to locate directories 2017-12-12 17:32:21 +00:00
pooryorick 0239e7e77f Add the check for wrong arguments back to TclOO_Object_Destroy, remove
inadvertant increment of Namespace->refCount.
2017-12-11 23:50:22 +00:00
apnadkarni 5501e78098 Merge from core-8-branch - install stubs and headers where present 2017-12-11 16:42:41 +00:00
apnadkarni dddf400b7e Merge from core-8-6-branch - install stubs and headers where present 2017-12-11 16:40:30 +00:00
apnadkarni c220b0dcfa Allow standard targets to be selectively disabled.
Automatic install for extension stubs and public headers if present.
Print installation dir, remove useless partial print of preprocessor defines.
2017-12-11 16:26:24 +00:00
pooryorick 2555e0d7e6 Streamline TclOO object cleanup routines. 2017-12-10 21:45:26 +00:00
jan.nijtmans 5de1c8c6a5 merge core-8-branch 2017-12-10 14:39:00 +00:00
jan.nijtmans dfeacc8edb Fix [040586323610be22f8617962377324f4ddc9bc02|0405863236]: wrong field checked in struct pollfd in TclUnixWaitForFile 2017-12-10 14:35:02 +00:00
pooryorick e58661a87e Ensure that an automatically-named TclOO object has the same name as its
namespace.
2017-12-10 00:01:01 +00:00
jan.nijtmans 5b605792cb merge core-8-branch.
Remove stub entry for TclWinGetPlatformId(), as it is no longer needed. Is a macro now.
2017-12-09 16:13:58 +00:00
jan.nijtmans 9ef7f0a940 merge core-8-6-branch 2017-12-09 15:32:46 +00:00
jan.nijtmans 5cddfdcda6 Undo latest change to tcl.rc, since the autoconf-based windows build doesn't know about PRJLIBNAME 2017-12-09 15:31:58 +00:00
apnadkarni 5724764152 TIP477 merge: reformed nmake build system 2017-12-08 16:54:18 +00:00
apnadkarni 54ae4feac8 TIP477 merge: nmake build reform 2017-12-08 15:27:49 +00:00
apnadkarni a2c5ea2c08 Merge TIP 477 implementation 2017-12-08 13:54:42 +00:00
jan.nijtmans ae26eec096 merge 8.7 2017-12-07 12:36:16 +00:00
jan.nijtmans a3daf1a6d1 TIP #487: Stop support for Pre-XP Windows 2017-12-07 12:14:23 +00:00
dgp 6c313a5846 update changes 2017-12-07 02:01:30 +00:00
dgp bbaba520ab changes WIP 2017-12-06 21:59:13 +00:00
dgp a0a62d119d merge 8.6 2017-12-06 21:03:02 +00:00
dgp 2623503549 merge 8.7 2017-12-06 20:48:49 +00:00
dgp 7573551ccb Plug memleak recently put into [package require]. 2017-12-06 20:48:12 +00:00
dgp 5d11ad1e8a Plug memleak recently put into [package require]. 2017-12-06 20:46:47 +00:00
dgp cd525c7bb1 Plug memleak recently put into [package require]. 2017-12-06 20:44:32 +00:00
dgp a7bb7b19d6 merge 8.7 2017-12-06 20:03:07 +00:00
dgp 4644a04ee3 merge 8.6 2017-12-06 20:02:46 +00:00
dgp 0af956fe7e merge 8.6 2017-12-06 19:58:40 +00:00
dgp 9ba4b4f901 [0e4d88b650] Added enough refcounting to stop make valgrind complaints about
"Invalid read".  This is not a complete fix. Things are still broken.
A working system of Namespace lifetime management looks like an 8.7 project.
2017-12-06 19:57:59 +00:00
jan.nijtmans cf3348e41c (cherry-pick from core-8-6-8-rc): Duplicate test names 2017-12-06 16:04:22 +00:00
dgp 7b04f399b0 Duplicate test names 2017-12-06 15:30:27 +00:00
dgp 3aab0c568b Start RC branch for Tcl 8.6.8 2017-12-06 15:27:28 +00:00
dgp 1e64c9f8b2 Adapt the bytearray accommodation of Tcl_CharLength() for 8.7+. 2017-12-06 13:28:48 +00:00
dgp 21877b851c Adapt the bytearray accommodation of Tcl_CharLength() for 8.7+. 2017-12-06 13:28:12 +00:00
dgp b68bab17c0 [ce3a211dcb] Failed file normalize when tail is empty string. 2017-12-06 13:07:23 +00:00
dgp d7ed325913 [ce3a211dcb] Failed file normalize when tail is empty string. 2017-12-06 13:06:47 +00:00
dgp 07aa7381a9 [ce3a211dcb] Failed file normalize when tail is empty string. 2017-12-06 13:05:51 +00:00
dgp bb1c5fe833 [ce3a211dcb] Failed file normalize when tail is empty string. 2017-12-06 13:02:32 +00:00
jan.nijtmans 3f1dfde45f Don't do same test twice 2017-12-06 12:17:33 +00:00
jan.nijtmans c15cc5c510 merge 8.7 2017-12-06 12:10:35 +00:00
jan.nijtmans 99e890b52c merge core-8-branch 2017-12-06 12:00:24 +00:00
dgp b6b032fc3b [4f6a1ebd64] Stop crash when same value passed to the -map and -subcommands options of ensemble configuration. 2017-12-05 15:59:09 +00:00
dgp 72f0f0b346 [4f6a1ebd64] Stop crash when same value passed to the -map and -subcommands options of ensemble configuration. 2017-12-05 15:52:55 +00:00
dgp f3af86c67e [4f6a1ebd64] Stop crash when same value passed to the -map and -subcommands options of ensemble configuration. 2017-12-05 15:27:21 +00:00
dgp 3eef9fcea1 Factor clearing of ensemble subcommand table into utility routine. 2017-12-05 15:12:05 +00:00
dgp 906cf353b2 [4f6a1ebd64] Stop crash when same value passed to the -map and -subcommands options of ensemble configuration. 2017-12-05 14:57:05 +00:00
dgp 8a44c35e8c Another revised fix, much closer to sebres' patch now. 2017-12-05 14:36:33 +00:00
apnadkarni 3e34d38b2d Use PRJ_PACKAGE_TCLNAME instead of PROJECT when generating TEA based pkgindex 2017-12-05 14:29:47 +00:00
dgp 92f8ce13df [4f6a1ebd64] Different fix for the problem. Re-order the filling of the
subcommand table so there is no longer a conflict where multiple intreps of
a single value are sought. If the mapDict and exportList are the same,
then each key in the mapDict is known to be an element of the exportList
without needing to check.
2017-12-04 18:36:14 +00:00
jan.nijtmans 200910b9c1 merge core-8-branch. Various cleanup: unused structure names, unused #defines. Change some "epoch"-related fields from int to size_t. Nothing functional. 2017-12-01 13:53:51 +00:00
jan.nijtmans f0d821a83c merge core-8-6-branch 2017-12-01 12:48:26 +00:00
jan.nijtmans b8fbe8c1d3 Fix [4f51e1c5dcf75de22f5907f7b66361e4bcab02e2|4f51e1c5dc]: patch to correct linker flag sequence 2017-12-01 12:47:12 +00:00
jan.nijtmans 0bd09c4106 remove many test-cases related to tcl_precision 2017-12-01 12:24:25 +00:00
jan.nijtmans ff91f80124 TIP 488: Remove tcl_precision 2017-12-01 11:55:28 +00:00
jan.nijtmans 9b47336cbd merge core-8-branch 2017-12-01 11:33:27 +00:00
jan.nijtmans e802927981 Remove stub entries for Tcl_EvalObj()/Tcl_GlobalEvalObj(). Since those functions are actually macro's translating to Tcl_EvalObjEx(), those stub entries don't serve any purpose any more. 2017-12-01 11:03:43 +00:00
jan.nijtmans 1a237e67df Simpler solution for Itcl 3.4 build (compatibilty) problem. Thanks to Don Porter for bringing this to my attention! 2017-12-01 10:38:04 +00:00
dgp 9d4d161834 merge 8.7 2017-11-30 17:29:55 +00:00
dgp db726dc570 [5808081213] Permit all bytearrays (including impure ones) to report length without shimmering 2017-11-30 17:21:12 +00:00
dgp 4bbfdee3db [5808081213] Permit all bytearrays (including impure ones) to report length without shimmering 2017-11-30 17:10:37 +00:00
jan.nijtmans 88233497ab merge core-8-branch 2017-11-30 16:18:54 +00:00
jan.nijtmans b96b6a46ba merge core-8-branch 2017-11-30 16:08:03 +00:00
jan.nijtmans 0efada5548 Eliminate use of certain unnecessary struct names. Also white-spacing. Nothing functional. 2017-11-30 16:03:01 +00:00
jan.nijtmans 111f52def6 merge-mark 2017-11-30 15:27:45 +00:00
jan.nijtmans 99798b2202 Fix build of test-suite, after previous commit 2017-11-30 15:24:39 +00:00
jan.nijtmans 9dd792a540 8.[67] -> 9.0 in a few more places 2017-11-30 14:48:03 +00:00
jan.nijtmans 20bbe0a790 merge core-8-branch 2017-11-30 14:38:32 +00:00
jan.nijtmans f327b7e9dc merge core-8-6-branch.
Provide compatibility macro's, compensating for the internal stub table change, so Itcl 3.4 builds again. Thanks to Don Porter for bringing this to my attention!
2017-11-30 14:36:16 +00:00
jan.nijtmans d7d31d6041 Don't provide the setFromAnyProc through the invalidRealType objType. This is a Tcl internal type, extensions shouldn't be able to convert their own Tcl_Obj to this. This shouldn't have been exposed to begin with. Tcl itself never calls it this way. 2017-11-30 14:14:01 +00:00
jan.nijtmans 94b624f11c merge core-8-branch 2017-11-30 13:23:10 +00:00
jan.nijtmans 72998869a3 Fix [8e1e31eac0fd6b6c4452bc108a98ab08c6b64588|8e1e31eac0]: lsort treats NUL chars strangely. Also fix various initializations, which only make a difference when TCL_UTF_MAX == 4.
Add new test-cases which demonstrate the fix. For TCL_UTF_MAX == 4, surrogates will now be handled as expected as well when sorting.
2017-11-30 13:14:43 +00:00
pooryorick c47ba70f45 Add TCL_CREATE_NS_IF_UNKNOWN back into Tcl_CreateEnsemble(). 2017-11-29 18:35:51 +00:00
dgp 5a9014a650 Follow header file conventions. 2017-11-29 15:19:04 +00:00
sebres e68b491806 Cherry-picked test-cases from [046a5af026]: fix for issue [4f6a1ebd64]: ensemble: segmentation fault when -subcommand and
-map values are the same object.
2017-11-29 13:59:42 +00:00
jan.nijtmans a6a61c4ca6 merge core-8-branch 2017-11-29 12:32:38 +00:00
jan.nijtmans 4190501ec7 merge core-8-6-branch 2017-11-29 12:28:21 +00:00
jan.nijtmans e87d0bcdf4 Fix Tcl_UtfFindFirst()/Tcl_UtfFindLast(), which were broken by [83c0c569d6]. Not detected, because those functions aren't used anywhere in Tcl.
So, added new test-cases, makeing sure this doesn't happen again.
2017-11-29 12:27:22 +00:00
pooryorick c032f5043e Fix for [6bca38d59b], TclOO segmentation fault cleaning up objects that that
have mixed themselves into themselves.
2017-11-29 12:01:21 +00:00
jan.nijtmans 7ecb945209 Merge core-8-branch. Also, use a different value for TCL_STUB_MAGIC when TCL_UTF_MAX>4. 2017-11-29 11:49:49 +00:00
jan.nijtmans 79b5a0a716 merge core-8-6-branch 2017-11-29 11:05:15 +00:00
jan.nijtmans 4fc9a4c991 Update some functions in tclUtf.c to handle surrogate pairs when TCL_UTF_MAX == 4. Also update documentation to distinguish better between "Tcl_UniChar" and "Unicode character": Those are not necessary the same when TCL_UTF_MAX == 4.
No change when TCL_UTF_MAX == 4 or TCL_UTF_MAX == 6.
2017-11-29 11:04:20 +00:00
jan.nijtmans 03c66864aa Fix [8e1e31eac0fd6b6c4452bc108a98ab08c6b64588|8e1e31eac0]: lsort treats NUL chars strangely 2017-11-29 09:49:31 +00:00
jan.nijtmans 3af16acbcb Treat invalid UTF-8 characters in the range 0x80-0x9F as cp1252: See [https://en.wikipedia.org/wiki/UTF-8]. To be added to TIP #389 2017-11-29 08:59:49 +00:00
jan.nijtmans eef0b72b5e merge core-8-branch 2017-11-29 08:41:05 +00:00
pooryorick 8396e878da Fix for issue [6cf568a21b]: Tcl_Eval() causes new segfault (TclOO object
creation by qualified name).
2017-11-28 23:33:14 +00:00
pooryorick fe65a79d19 Minor refactoring of TclOO object reference count booking during object
creation.
2017-11-28 15:43:41 +00:00
pooryorick a8a602d3ff Eliminate some duplicate code in tclOO.c/Tcl_NewObjectInstance(). 2017-11-27 23:30:57 +00:00
pooryorick 2930169517 Streamline TclOO object cleanup routines. 2017-11-27 19:45:40 +00:00
jan.nijtmans d95ab0247a missed some more failing test-cases 2017-11-27 14:11:16 +00:00
jan.nijtmans 20dedcd841 Fix test-cases in safe.test, failing due to changes in min/max math functions. 2017-11-27 13:52:18 +00:00
pooryorick 14c8dabffe merge (cherrypick): Add missing parenthesis to an expression in TclEnsureNamespace. 2017-11-25 21:40:19 +00:00
pooryorick 811ec68434 Add missing parenthesis to an expression in TclEnsureNamespace. 2017-11-25 18:24:10 +00:00
pooryorick c2e98a86d4 merge pyk-command-named-colon 2017-11-25 16:53:59 +00:00
pooryorick 48fb6e2c88 Fix for issue [4f6a1ebd64]: ensemble: segmentation fault when -subcommand and
-map values are the same object.
2017-11-25 16:36:22 +00:00
pooryorick 9b1ecce298 Move return type to its own line. 2017-11-23 18:24:09 +00:00
jan.nijtmans ca83d59e10 merge core-8-branch.
now really remove the math-related functions when compiling with -DTCL_NO_DEPRECATED. Also no longer supply Tcl_Value, Tcl_ValueType and TCL_RESULT_SPACE.
2017-11-23 13:56:21 +00:00
jan.nijtmans 160a58238a If compiled with -DTCL_NO_DEPRECATED, remove stub entry for TclWinGetPlatformId() 2017-11-23 12:21:35 +00:00
jan.nijtmans dd0e9cf6b1 Remove more pre-XP stuff. 2017-11-23 12:04:33 +00:00
jan.nijtmans 3c23d21835 Re-base "stop-ce" branch to core-8-branch. This is what will be proposed for 8.7 in TIP #487. 2017-11-23 08:30:10 +00:00
pspjuth 121654ecd8 merge core-8-branch 2017-11-21 22:47:44 +00:00
pspjuth fac696b394 merge pspjuth-cminmax 2017-11-21 22:46:35 +00:00
jan.nijtmans 9215c2610c Drop Windows CE support, since it doesn't appear to work anyway. 2017-11-21 14:59:04 +00:00
jan.nijtmans 119652bd95 deprecate VOID/CHAR/SHORT/LONG (windows-only) as well. 2017-11-21 09:48:36 +00:00
jan.nijtmans 011dd7b0f6 Revert [d874801c57]: putting back "string bytelength". It turns out to be too complicated to take along with the other deprecations in TIP #485 2017-11-21 09:13:08 +00:00
jan.nijtmans 52b098ca11 Deprecate support for macro's like CONST, CONST84, _ANSI_ARGS_, INLINE, TCL_VARARGS 2017-11-20 16:26:03 +00:00
jan.nijtmans 82877a8aa3 merge core-8-branch. Deprecate support for "string bytelength" 2017-11-20 16:01:05 +00:00
jan.nijtmans 61536390c5 Fix executable flags 2017-11-20 13:05:36 +00:00
jan.nijtmans 3a7618f91e merge core-8-branch 2017-11-20 12:58:54 +00:00
jan.nijtmans d0e9170c39 Remove TclCopyChannelOld() function. Should have been part of [b03c4194f001be0b|this] earlier commit. 2017-11-20 12:13:29 +00:00
jan.nijtmans a1bc5b8a2b If Tcl is compiled with -DTCL_NO_DEPRECATED, remove a lot of (internal) stub entries which correspond to functions which will be removed in Tcl 9.
This commit should have been part of [7849f573c0e7d758|this] earlier commit. 
No effect when Tcl is not compiled with -DTCL_NO_DEPRECATED.
2017-11-20 12:07:08 +00:00
jan.nijtmans c19490026d Re-base to core-8-branch: This change is fine as-is for Tcl 8.7, I wouldn't recommend it for 8.6 (even though it's only for the changed error-message) 2017-11-20 10:30:02 +00:00
jan.nijtmans 75a121d773 merge core-8-branch 2017-11-20 10:23:13 +00:00
jan.nijtmans bc3e198cba Fix error-message for min/math functions: "to" -> "for", for consistancy with the error-messages for other math functions. 2017-11-20 10:15:59 +00:00
jan.nijtmans adc8a8bbdf merge core-8-branch 2017-11-20 09:28:02 +00:00
jan.nijtmans b946ce971f Fix [e058307eef73cf21cf6805ad7c778e1024f9eb7d|e058307eef]: Use of values.h breaks build of Tk trunk on macOS 2017-11-20 08:58:39 +00:00
pspjuth c2eeda3f09 Changed math functions min and max to C implementations. 2017-11-19 18:40:13 +00:00
pooryorick 75924256c1 Fix segmentation fault in TclOO that was noted in [16fe1b5807]. Update
coroutine and TclOO object creation routines to use TclCreateObjCommandInNs.
2017-11-19 00:06:51 +00:00
pooryorick 42c80667fd Lift the restriction on command names names that begin with ":". 2017-11-17 23:42:16 +00:00
pooryorick 3c942c50d9 Fix [16fe1b5807]: namespace ensemble command named ":" is mistakenly given the
empty string as its name.
2017-11-17 22:30:06 +00:00
jan.nijtmans 2ea8f0fe98 merge core-8-branch. Fix some Tcl_UniChar initialization, in case TCL_UTF_MAX == 4 2017-11-17 16:08:49 +00:00
apnadkarni 335305de9c Added back nothreads option. 2017-11-17 15:46:23 +00:00
jan.nijtmans b832920adb merge core-8-branch 2017-11-17 15:34:01 +00:00
jan.nijtmans 48047bb120 merge core-8-6-branch 2017-11-17 15:30:02 +00:00
jan.nijtmans b44ffcf5e2 Fix [fab92486a1b05ba6f7cfe8677da95b9efb3beff0|fab92486a1]: Windows error 14 "Out of memory" mapping to Posix EFAULT "Bad address in system call argument" feels wrong 2017-11-17 15:29:07 +00:00
jan.nijtmans ff436137df Fix [fab92486a1b05ba6f7cfe8677da95b9efb3beff0|fab92486a1]: Windows error 14 "Out of memory" mapping to Posix EFAULT "Bad address in system call argument" feels wrong 2017-11-17 15:28:09 +00:00
jan.nijtmans 42236b435f Fix ignore-glob versioned setting (something went wrong in previous merge). Also convert rules-ext.vc and targets.vc to CRLF line-endings. 2017-11-17 11:35:26 +00:00
jan.nijtmans a27501598a merge core-8-6-branch 2017-11-17 11:27:13 +00:00
jan.nijtmans 466e0f29c3 TIP #422, Tcl 9.0 part: Don't Use stdarg.h/va_list in Public API 2017-11-17 10:50:02 +00:00
jan.nijtmans 28017c14e3 TIP #422, Tcl 8.7 part: Mark all *VA functions as deprecated. They will be removed in Tcl 9.0. 2017-11-17 10:23:14 +00:00
jan.nijtmans ac3259b669 Suggested patch for [4f51e1c5dc]: patch to correct linker flag sequence. Same change done for a few other platforms where it might matter. 2017-11-17 08:32:16 +00:00
apnadkarni 5560b9198b Check for existence of targets.vc, not rules.vc to determine nmake support dir. 2017-11-17 07:05:23 +00:00
apnadkarni 51319d2cae Add PRJ_PACKAGE_TCLNAME and other minor changes.
Also:
Change ifdef checks to check for empty string instead.
Quote include paths.
2017-11-17 06:52:48 +00:00
jan.nijtmans 5ff5853a6e merge core-8-6-branch 2017-11-16 08:45:54 +00:00
jan.nijtmans 24d7fa6401 No longer document (even though it's only in an example) that Tcl_SavedResult is a struct, and that the internal representation of an int is stored in the object's internalRep.longValue member. That might no longer be true in the future. 2017-11-16 08:42:32 +00:00
jan.nijtmans 65007a4d02 No longer document (even though it's only in an example) that Tcl_SavedResult is a struct, and that the internal representation of an int is stored in the object's internalRep.longValue member. That might no longer be true in the future. 2017-11-16 08:39:41 +00:00
jan.nijtmans 4eed307023 merge core-8-branch. Also fix some test-cases, expecting the existence of "int" objType. 2017-11-15 15:00:25 +00:00
jan.nijtmans 0dd94666f5 Merge dgp's "end-int-registration" branch, but slightly different: In stead of not registering "int", continue to register it as being "wideInt" for Tcl 8.x. This should assure maximum compatibility with Tcl 8.6-based extensions.
In addition, revert some boolean-related changes (keep the longValue usage here in stead of wideValue). And stop registering oldBoolean starting with Tcl 9.
2017-11-15 14:13:09 +00:00
apnadkarni c4d4363abd Loosen restriction on where rules-ext.vc file is located. 2017-11-15 13:18:00 +00:00
apnadkarni 0197a30845 Include PKGNAMEFLAGS in stubscflags as some extension stubs use it 2017-11-15 11:47:16 +00:00
jan.nijtmans de0ff2272e merge core-8-branch 2017-11-15 10:01:18 +00:00
jan.nijtmans 346cce5745 Remove compat/float.h and related machinery. The last system known where this was needed was SunOS-4, which is not supported by Tcl any more for a long ... long time ....
Also, fix a typo in generic/tclInt.h and remove some end-of-line spacing.
2017-11-15 09:42:07 +00:00
jan.nijtmans b9216a9c1f merge core-8-branch 2017-11-15 08:56:25 +00:00
jan.nijtmans e3439b6af2 Change signature of (internal) TclScanElement() function. This saves memory allocation and the possibility for panic's in dict and list handling, requiring 1/4 of memory for internal allocation of temporary storage. No change to external API. 2017-11-15 08:55:18 +00:00
jan.nijtmans 59ebc49f0f Change signature of (internal) TclScanElement() function. This saves memory allocation and the possibility for panic's in dict and list handling, requiring 1/4 of memory for internal allocation of temporary storage. No change to external API. 2017-11-15 08:54:13 +00:00
apnadkarni ca86fd3219 Added default-install-stubs target.
Make presence of nmake support files in extension directory optional
(except for rules-ext.vc). This requires them to only build against
a Tcl with the new nmake build system.
2017-11-15 07:54:08 +00:00
dgp 1ed5a135ed TIP 484 proposes a re-implementation of Tcl's "int" Tcl_ObjType.
Since the new implementation is not consistent with the former one, any
callers of Tcl_GetObjType("int") who are expecting the return value to
point them at something playing by the former rules are at risk of having
their code broken.  In this branch I remove the registation of Tcl's
"int" type, so such callers will get NULL (which they should already be
able to handle) instead of something misleading them into breakage.

Examine this branch and decide if it should be incorporated into TIP 484.
2017-11-14 18:35:22 +00:00
dgp f6a35fe784 merge 8.7 2017-11-14 18:19:05 +00:00
dgp 43f411afeb [5d6de65036] [package require] with [package prefer stable] was not choosing available stable package. 2017-11-14 17:24:00 +00:00
dgp 9f65735813 Repair lost of broken [package prefer] testing. 2017-11-14 17:09:49 +00:00
dgp 2ea108ae28 [5d6de65036] [package require] with [package prefer stable] was not choosing available stable package. 2017-11-14 14:48:21 +00:00
dgp d7b5cde35f [5d6de65036] [package require] with [package prefer stable] was not choosing available stable package. 2017-11-14 14:17:57 +00:00
dgp ba9e81068e [5d6de65036] [package require] with [package prefer stable] was not choosing
available stable package.
2017-11-14 13:36:59 +00:00
jan.nijtmans a35ad3e794 Remove extra.unused2 field from struct Interp. It really is unused ... 2017-11-14 10:00:58 +00:00
aku a7b6d60948 Ticket [5d65e65036]. My fix. Do not skip the second check for stable versions even when the main check fails. Avoided radical changes to the structure (kept single search loop, with selection after). 2017-11-13 18:58:16 +00:00
jan.nijtmans cd80622d5e merge core-8-branch 2017-11-13 11:17:23 +00:00
jan.nijtmans eb2a9484b8 Merge core-8-6-branch 2017-11-13 11:15:44 +00:00
jan.nijtmans a92e1c508f No longer mark Tcl_EvalFile() as obsolete, since it will continue to be supported in Tcl 9.0 2017-11-13 10:51:39 +00:00
jan.nijtmans 0fc6533fcb No longer mark Tcl_EvalFile() as obsolete, since it will continue to be supported in Tcl 9.0 2017-11-13 10:49:25 +00:00
jan.nijtmans 26c5e61700 merge tcl-9-cleanup (and also a minor bug-fix from core-8-branch). 2017-11-13 08:59:59 +00:00
jan.nijtmans 01fd6594cf Add a lot of "deprecation" marks to internal API which will be removed in Tcl 9.0 (see also tcl-9-cleanup branch). Extensions still using this API will get a compiler warning, but everything will continue to work fine for all future 8.x releases. 2017-11-13 08:37:55 +00:00
jan.nijtmans 752cfbe04c merge core-8-6-branch 2017-11-10 08:49:54 +00:00
jan.nijtmans 1ffeaf24ef Make "string split" and "string is (alpha|graph|...)" work as expected with Unicode chars > U+ffff, when Tcl is compiled with TCL_UTF_MAX == 4. No effect when TCL_UTF_MAX == 3 or TCL_UTF_MAX == 6.
Test-case added for "string split".
2017-11-10 08:40:45 +00:00
jan.nijtmans dfbe0053d1 merge core-8-branch 2017-11-09 16:07:06 +00:00
jan.nijtmans b7e5592df1 Merge core-8-branch. Backout the Tcl_EvalFile changes. 2017-11-09 15:56:04 +00:00
jan.nijtmans 944a3d95ff Rebase back to 8.7 (core-8-branch), since that's what the TIP is meant for. (I see no reason to wait for 9.0) 2017-11-09 14:59:36 +00:00
dgp 29dda71bad merge trunk 2017-11-09 14:44:57 +00:00
dgp de9a7da4ba merge trunk 2017-11-09 14:40:30 +00:00
jan.nijtmans 0faadee83c merge core-8-branch 2017-11-09 12:51:26 +00:00
jan.nijtmans 78374f18a4 merge core-8-6-branch 2017-11-09 12:50:43 +00:00
jan.nijtmans 729fcd5f09 Make "scan %c" and the internal function ExtendUnicodeRepWithString() work as expected for TCL_UTF_MAX == 4 when handling characters > U+ffff. No effect when TCL_UTF_MAX == 3 or TCL_UTF_MAX == 6 2017-11-09 12:48:54 +00:00
jan.nijtmans c59b3f3bc1 For alpha/beta versions of Tcl, stub-enabled extensions are only allowed to run on the EXACT the same Tcl versions as compiled: The stubs might still be in flux, they are not guaranteed to work on future Tcl versions anyway.
Backported from "novem" (which already had this special protection). For final releases (8.7.0) everything works as before.
2017-11-09 12:37:20 +00:00
jan.nijtmans a037934e21 Get rid of Tcl_DStringTrunc et al, as described in the TIP (Thanks, Don!). 2017-11-09 11:49:10 +00:00
jan.nijtmans 56e7df256a No longer mark Tcl_EvalFile() as obsolete/deprecated. Thanks to all feedback to TIP #485! 2017-11-09 11:04:49 +00:00
jan.nijtmans 429acda3ee Put Tcl_EvalFile back, but then as a macro in terms of Tcl_FSEvalFileEx(). 2017-11-09 10:34:10 +00:00
jan.nijtmans c1f627b31e Fogot to remove the TclWinSetInterfaces() implementation. 2017-11-09 09:02:44 +00:00
jan.nijtmans a31c699833 Forgot TclpGetTime() 2017-11-08 16:12:29 +00:00
jan.nijtmans 9c9ce91ef5 Tcl-9 huge cleanup: Remove many unused internal functions which do nothing more than occupy the internal stub table. 2017-11-08 15:50:06 +00:00
jan.nijtmans cf4d5a8cfe TIP #485 implementation: "Remove Deprecated API". Based on Tcl 8.7 (core-8-branch). 2017-11-08 11:50:55 +00:00
apnadkarni c7530621ad Fix inclusion of custom resource files to match TIP spec 2017-11-07 16:47:35 +00:00
jan.nijtmans a7ba08158b merge 8.7 2017-11-07 16:31:17 +00:00
jan.nijtmans 42764c99be More code simplifications, with still equal functionality. 2017-11-07 16:16:52 +00:00
dgp 2ad54a6f6e merge 8.7 2017-11-07 15:11:43 +00:00
dgp f941597e43 merge 8.7 2017-11-07 14:28:03 +00:00
jan.nijtmans 48b529209c Somewhat simplified implementation of TIP #389, in which the "string length" if characters > U+FFFF is considered to be 2, not 1. 2017-11-07 12:15:30 +00:00
jan.nijtmans 45808db8dc TIP #422 implementation, Tcl 8.7 part. 2017-11-07 09:08:48 +00:00
dgp 22719c6596 Test case for Bug 5d65e65036. 2017-11-06 00:10:21 +00:00
f.bonnet 6fff25ecbc Fixed stupid Tcl_DecrRefCount bug in TclCleanupChildren with normally terminated processes. 2017-11-05 16:41:11 +00:00
jan.nijtmans cf516b0eb8 merge core-8-branch 2017-11-05 14:35:43 +00:00
jan.nijtmans 735d38cd7c merge trunk 2017-11-03 12:24:06 +00:00
jan.nijtmans 9e2ed8b729 Finally, get rid of tclWideIntType completely 2017-11-01 12:35:40 +00:00
jan.nijtmans adc216698f Eliminate most usage of TCL_NUMBER_LONG, just use TCL_NUMBER_WIDE in stead (since both have the same internal representation now) 2017-10-31 16:40:57 +00:00
jan.nijtmans 1cbd95eeee eliminate most use of (long) type, except for increments 2017-10-31 16:16:46 +00:00
jan.nijtmans db930a501f Only use 64-bit tables for all platforms 2017-10-31 14:48:28 +00:00
jan.nijtmans 2f2459e120 more progress 2017-10-31 14:40:33 +00:00
jan.nijtmans 8fd76cb873 more simplifications 2017-10-31 12:39:16 +00:00
jan.nijtmans c8fbbd8f3e Fix 2 failing test-cases, broken by some earlier commit 2017-10-31 11:37:29 +00:00
jan.nijtmans b8b341fea6 Fix some pointer arthemeric (only visible on big-endian systems) 2017-10-30 16:46:49 +00:00
jan.nijtmans ca470c3d4e more progress in code simplifications 2017-10-30 14:32:52 +00:00
jan.nijtmans aad24c7ffc Change (internal) TclFormatInt() signature, so it can handle WideInt's directly. Ongoing simplifications ... 2017-10-30 11:01:28 +00:00
jan.nijtmans fe508fa3b5 Experimental branch meant to eliminate the "wideint" type, just merge it to a single "int" type. No effect on linux64 and similar systems, code simplification for Win64 and 32-bit system. No TIP yet, implementation ongoing. 2017-10-30 08:47:33 +00:00
apnadkarni 2318b70929 Minor edits 2017-10-28 17:18:58 +00:00
apnadkarni c324bb3eff Reworked build command macros (MAKEBINCMD, CCPKGCMD etc.) and purged old comments. 2017-10-26 15:07:16 +00:00
fvogel d8cae66217 Fix typo in set-old.test 2017-10-25 17:31:09 +00:00
apnadkarni ff1c348970 Updated comments. 2017-10-25 02:59:46 +00:00
fvogel 40ce2eccbc 'array for' implementation (TIP #421) from Brad Lanam 2017-10-24 21:24:07 +00:00
jan.nijtmans 16976013d1 merge trunk 2017-10-24 13:59:40 +00:00
apnadkarni fe8915122a Eliminate loimpact and tclalloc options. 2017-10-23 13:53:51 +00:00
apnadkarni 7db056b75a Fully qualify OUT_DIR and TMP_DIR paths so that the test target can
change directories and not break relative paths to the built extension.
2017-10-21 12:14:25 +00:00
apnadkarni 6f23316c4a Added test and shell targets. 2017-10-20 15:32:22 +00:00
apnadkarni fa7141288f Update RCFILE to PRJ_RCFILE. 2017-10-18 16:04:13 +00:00
apnadkarni 63a9fcf2e7 Fix resource file compilation when makefile specifies PRJ_RCFILE 2017-10-18 16:03:08 +00:00
apnadkarni b6f90aaf1f Add PRJ_MANIFEST to support manifest generation. 2017-10-17 15:01:56 +00:00
apnadkarni 4ef03a8950 Fixed reversed check for implicit rules 2017-10-16 12:46:53 +00:00
jan.nijtmans ef82c5073a merge trunk 2017-10-16 12:05:17 +00:00
jan.nijtmans 237b4d22a2 Add support for 'L' length modifier (either long double or mp_int) and 'a'/'A' modifiers (floating point in hex notation) 2017-10-16 11:55:57 +00:00
apnadkarni 823edbf0ab Permit application makefile to define RCFILE.
Change PROJECT_REQUIRES_TK to use value instead of ifdef.
Change MAKERESCMD macro not to specify included input files.
2017-10-15 06:58:20 +00:00
jan.nijtmans a72fed191e fix unixFCmd test-cases, as result of the octal behavior change 2017-10-14 22:52:26 +00:00
jan.nijtmans 5015dd8a1f Fix missing line (after manual merge-conflict). Fix compiler warning on linux64. 2017-10-13 14:46:26 +00:00
jan.nijtmans 5abbd5b2da Merge trunk. And merge jn-0d-radix-prefix branch in too (too small to be considered separately) 2017-10-13 14:07:47 +00:00
apnadkarni 0c646bc3d1 Fix RC template dependency to not generate it every time 2017-10-08 16:12:23 +00:00
apnadkarni f4e4349cad Fix htmlhelp generation on 64-bit systems 2017-10-08 14:25:19 +00:00
apnadkarni 9845cc7c9c Add default rc template so extensions do not have to write their own 2017-10-08 13:18:15 +00:00
apnadkarni fdc29e53d3 Was not setting VERSION for extensions. 2017-10-07 17:16:20 +00:00
apnadkarni a0f84e1b73 Fix ignore glob for Visual C++ output directories. 2017-10-07 13:33:13 +00:00
apnadkarni 21379b0cf5 Move standard predefined targets to targets.vc as this allows the master
makefile to modify macros if required before the targets are defined.
2017-10-06 13:38:26 +00:00
apnadkarni 65895760ea Added standard target for generating pkgIndex.tcl.
Added PKGNAMEFLAGS to pass PACKAGE_NAME and PACKAGE_VERSION.
2017-10-05 17:00:39 +00:00
apnadkarni 20730e0afb Added default-pkgindex target and split DISABLE_DEFAULT_TARGETS to
DISABLE_{STANDARD,CLEAN}_TARGETS.
2017-10-05 14:19:50 +00:00
apnadkarni c0295836a8 Add default-* targets 2017-10-04 01:57:51 +00:00
apnadkarni 8c50df7bbf Extract version numbers from TEA files so do not have to be separately defined. 2017-10-03 13:44:49 +00:00
apnadkarni ec0fc7f816 Have nmakehlp return non-0 exit code if version string not located with -V option 2017-10-03 13:41:53 +00:00
apnadkarni f5c6b07246 Remove use of any macros used in rules.vc from rules-ext.vc
Added USE_WIDECHAR_API to control usage of Windows wide API's.
2017-10-03 08:06:30 +00:00
apnadkarni 35256f809e Introduce rules-ext.vc file for extensions to select most recent rules.vc 2017-10-02 17:09:56 +00:00
apnadkarni 01201582b7 Fix initialization of _TCLDIR and use MAKE*CMD macros in makefile.vc
Fixed initialization of _TCLDIR when it is not defined by caller when
building an extension. _INSTALLDIR is modified AFTER it is used to
initialize _TCLDIR. However, nmake expands late so we have to init
_TCLDIR relative to the *modified* _INSTALLDIR.
2017-09-30 14:11:08 +00:00
apnadkarni 24b65fbe41 Added MAKEEXTCMD macro.
Fixed couple of syntax errors when building extensions.
2017-09-30 08:34:31 +00:00
apnadkarni 457587f033 Added standard macros LIBDIR and DEMODIR. Also set common Tk related names and paths 2017-09-30 06:20:33 +00:00
apnadkarni 78cf383197 Permit definition of implicit rules and standard targets to be disabled 2017-09-29 14:23:17 +00:00
apnadkarni 71c784c8bc Added implicit rule for compiling resources.
Added Tcl import libraries to link macro.
2017-09-29 12:41:02 +00:00
apnadkarni e4269a7140 Updated for Tk compatibility.
Removed extraneous quotes in macro definitions. Macros should be quoted at 
*use* time, not *definition* time.
Added _nostubs versions of pkgcflags and appcflags.
2017-09-29 06:12:04 +00:00
apnadkarni 3734937878 Add pkgcflags, appcflags and stubscflags to reflect different compilation modes.
Packages compile (at least) three types of objects files - the shared library
extension (e.g. tk86.dll), application programs (e.g. wish) and a static 
stubs library (tkstub86.lib). Thus we need to construct three different sets
of compilation flags accordingly.

Also updated makefile header comments to reflect modern usage.
2017-09-28 12:22:41 +00:00
apnadkarni 07c1c221cb Include rules.vc and nmakehlp.c as part of install.
Work toward not having to keep updating extensions with the latest version
of rules.vc and nmakehlp. Extension makefiles can instead use the 
installed files instead.

Also added some basic sanity checks to rules.vc to warn if extensions are
being compiled with options incompatible with those used to build Tcl.
2017-09-26 12:22:42 +00:00
apnadkarni 246e599142 Eliminate obsolete winhelp style documentation and fix Html Help doc build
to work on 64-bit systems.
2017-09-25 17:35:29 +00:00
apnadkarni f1aa04858d Eliminated /base option on linking as not recommended with ASLR 2017-09-25 16:33:20 +00:00
apnadkarni 301208c889 Unify build commands with MAKE{LIB,DLL,CON,GUI}CMD macros 2017-09-25 16:23:34 +00:00
apnadkarni b5e3779cf2 Move TCLSH and TCLSH_NATIVE macros to rules.vc 2017-09-25 13:45:34 +00:00
apnadkarni 56e2bd0be4 Added project-specific include paths and preprocessor defines. 2017-09-25 10:41:22 +00:00
apnadkarni 34cb030c7b Move clean target to rules.vc to avoid repetition in every extension 2017-09-24 14:25:48 +00:00
apnadkarni a91099b33b Move installation dir macros to rules.vc 2017-09-24 12:13:29 +00:00
apnadkarni ad9a3b8b45 Moved generic compiler and linker flags completely into rules.vc so
extensions do not have to repeat the verbage.

Special case Tk as a Tcl extension and add default for locating Tcl source.

Both Tcl and Tk compile with new rules.
2017-09-24 06:03:34 +00:00
apnadkarni c7e43807bf More refactoring. Moved defines that are Tcl-specific to makefile.vc as
rules.vc is common to extensions. Reworked parsing of STATS and CHECKS.
2017-09-23 07:35:32 +00:00
apnadkarni d8e7cf09b1 First step in complete refactoring.
Breaking up into logical sections with comments.
Fix floating point option selection to be the same on debug and release.
Pick up nmakehlp.c from installed Tcl if available when building extensions.
Mods to allow extensions to use the same exact rules.vc file.
2017-09-22 13:26:14 +00:00
apnadkarni 4f406d752d First cut at making application-independent compile and link flags
common to all extensions defined in a single place - rules.vc -
instead of having each extension cut and paste the same code.
2017-09-20 12:58:59 +00:00
apnadkarni 6d85564696 Disable pointer<->int warnings related to cast between different sizes
There are a gadzillion of these due to use of ClientData and clutter up compiler
output increasing chance of a real warning getting lost. So disable them.
Eventually some day, Tcl will be 64-bit clean.
2017-09-19 16:43:19 +00:00
apnadkarni 071f38c482 Eliminated some obsolete checks (Win98, IA64 etc.) to reduce the noise. 2017-09-19 16:07:14 +00:00
apnadkarni b81c66b4c7 Do not permit nothreads in OPTS as sockets, registry and dde require threading. 2017-09-19 15:12:52 +00:00
apnadkarni 0e5d15e072 Fix mapping of VCVERSION to VCVER. The simplistic calculation no longer
holds for new versions of the compiler. Instead directly use the internal
compiler version for these.
2017-09-19 12:50:25 +00:00
apnadkarni 78a20a11b2 Remove /Gs which enables _chkstk on *every* function call. The normal default
behaviour (without the option) checks only local variable space exceeds
page size. This is what Microsoft recommends.

Also moved -O2 to rules.vc file so as to keep all optimization flags 
in one location. 

Removed optimizations switches subsumed by -O2.
2017-09-19 12:10:25 +00:00
apnadkarni 54431f3360 Create new branch named "vc-reform" 2017-09-19 10:49:37 +00:00
jan.nijtmans 943b46881e Merge trunk 2017-09-18 15:13:40 +00:00
jan.nijtmans 757012c289 Rebase to trunk 2017-09-08 12:48:35 +00:00
f.bonnet 0a8718312d Comments and formatting 2017-08-27 21:25:14 +00:00
f.bonnet 68b53cfb25 Fixed reference counting issue with objects returned by WaitProcessStatus 2017-08-27 15:25:57 +00:00
f.bonnet 935e991786 On Windows, Tcl_Pids now map to dwProcessId instead of hProcess because the system reuses handles of recently terminated processes. 2017-08-27 15:24:22 +00:00
f.bonnet 43c89a019c Refactoring to support all processes and not just detached ones. 2017-08-27 11:05:45 +00:00
f.bonnet 57aa77515a Added switches and pid list support to tcl::process status 2017-08-23 19:51:02 +00:00
f.bonnet 8dd2373a08 Refactoring and preliminary implementation of tcl::process (list|status) 2017-08-23 18:31:56 +00:00
f.bonnet 03470df2ff Completed [tcl::process autopurge] semantics and added [tcl::process purge] implementation along with the necessary internal functions TclpGetChildPid/TclReapPids 2017-08-18 12:49:08 +00:00
f.bonnet 5aaef06572 Added [tcl::process autopurge] flag management with TclProcessGetAutopurge/TclProcessSetAutopurge companion functions. 2017-08-18 07:51:01 +00:00
f.bonnet 0b8e964f45 Fixed line endings 2017-08-17 13:03:48 +00:00
f.bonnet c86a23de04 Basic scaffolding for tcl::process 2017-08-17 13:02:27 +00:00
jan.nijtmans ca0b2a012e merge trunk 2017-06-29 13:18:33 +00:00
jan.nijtmans 4401a58b2a Implement %a and %A for floating point numbers 2017-06-28 11:02:19 +00:00
jan.nijtmans ccabb2af0c Merge trunk. Don't use expensive ToUpper() for hex 0X???? formatting, just generate uppercase directly. 2017-06-27 12:00:45 +00:00
jan.nijtmans 875f1b248d Implement "format %o" as prefixing with "0o" in stead of "0" (Kevin Kenny's suggestion). Seems ready to be TIPed (just some more testing) 2017-06-27 10:13:34 +00:00
jan.nijtmans b1c5e807ca Rebase branch "jn-0d-radix-prefix" back to trunk. No new changes 2017-06-26 10:20:32 +00:00
jan.nijtmans cf30ba443c Little variation on Brian's proposal: Only prefix decimal number with '0d' when that's necessary for correct interpretation of the number when parsed back again. 2017-06-14 10:04:05 +00:00
jan.nijtmans 8c62a9c228 merge trunk 2017-06-12 13:29:40 +00:00
jan.nijtmans 3bde30215b merge-mark 2017-04-18 06:15:48 +00:00
jan.nijtmans 46db6e4a00 merge trunk 2017-04-14 10:04:33 +00:00
jan.nijtmans cddb5b612f merge trunk. New TIP is getting shape. 2017-04-12 13:49:33 +00:00
jan.nijtmans d56986e037 merge trunk 2017-04-12 10:06:32 +00:00
jan.nijtmans e9b2f70238 merge trunk 2017-04-07 15:15:42 +00:00
jan.nijtmans de59a00a30 Use "0o" in stead of "0" as octal prefix in more places. 2017-04-07 14:48:49 +00:00
jan.nijtmans 7eea851880 Merge trunk. Only use hash prefix (0x, 0b, 0 ) if value is not 0, except for %p. 2017-04-07 13:46:19 +00:00
jan.nijtmans 0515becf7a Fix fall-back test for TCL_WIDE_INT_IS_LONG, making it do the same as "configure": Should be 1 if sizeof(long long) == sizeof(long), 0 otherwise. 2017-03-31 11:05:28 +00:00
jan.nijtmans 6b2a58ffcd Merge trunk 2017-03-31 09:54:42 +00:00
jan.nijtmans 30cebba4d6 merge trunk 2017-03-29 14:57:15 +00:00
jan.nijtmans afc0ba5cdc merge trunk 2017-03-29 13:23:11 +00:00
jan.nijtmans cf3f133df1 (more experimenting): Make TCL_LL_MODIFIER behave more close to intuitive expectations: If the platform has a "long long" type, use it for Tcl_WideInt, so TCL_LL_MODIFIER is really a replacement for "ll" on most platforms (Win32/Win64 as most notable exception).
Will need a new TIP.
2017-03-29 12:05:59 +00:00
jan.nijtmans eb03584c16 (experimental) new internal macro TCL_Z_MODIFIER, just like TCL_LL_MODIFIER but then for size_t. 2017-03-28 07:14:47 +00:00
f.bonnet f0aac87b35 Create new branch named "tip-462" 2017-03-27 09:28:55 +00:00
jan.nijtmans 8a090098fe merge trunk 2017-02-01 15:03:59 +00:00
pooryorick 547a4781df merge trunk 2016-10-03 16:55:56 +00:00
pooryorick 77140c23d4 Fix improper use of TclCheckEmptySTring. 2016-08-22 07:58:55 +00:00
pooryorick 382ff46e71 Remove unnecessary macro. Use an enum for result values. 2016-07-11 09:16:15 +00:00
pooryorick 0af0a4ef07 Change TclIsEmpty to TclCheckEmptyString. Check length instead of first char of
bytes.
2016-07-11 08:09:33 +00:00
pooryorick ee2b083ea7 Add missing "break". 2016-07-11 00:01:58 +00:00
pooryorick 2c4866bd92 Avoid generating string representation for comparisons against empty string. 2016-07-10 23:07:47 +00:00
394 changed files with 17451 additions and 20692 deletions
+2
View File
@@ -12,6 +12,8 @@ win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
+2
View File
@@ -12,6 +12,8 @@ win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
+1
View File
@@ -44,5 +44,6 @@ unix/pkgs/*
win/Debug*
win/Release*
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
win/nmhlp-out.txt
+3 -3
View File
@@ -49,7 +49,7 @@ and selling it either in whole or in part. See the file
Extensive documentation is available at our website.
The home page for this release, including new features, is
http://www.tcl.tk/software/tcltk/8.7.html
http://www.tcl.tk/software/tcltk/9.0.html
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
@@ -61,9 +61,9 @@ Information about Tcl itself can be found at
There have been many Tcl books on the market. Many are mentioned in the Wiki:
http://wiki.tcl.tk/_/ref?N=25206
To view the complete set of reference manual entries for Tcl 8.7 online,
To view the complete set of reference manual entries for Tcl 9.0 online,
visit the URL:
http://www.tcl.tk/man/tcl8.7/
http://www.tcl.tk/man/tcl9.0/
2a. Unix Documentation
----------------------
+46 -3
View File
@@ -8234,7 +8234,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
2013-05-16 (platform support) mingw-4.0 (nijtmans)
2013-05-19 (platform support) FreeBSD updates (gahr)
2013-05-19 (platform support) FreeBSD updates (cerutti)
2013-05-20 (bug fix)[3613567] access error temp file creation (keene)
@@ -8657,7 +8657,7 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)
2016-06-02 (TIP 447) execution time verbosity option (gahr)
2016-06-02 (TIP 447) execution time verbosity option (cerutti)
=> tcltest 2.4.0
2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)
@@ -8796,6 +8796,45 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
--- Released 8.6.7, August 9, 2017 --- http://core.tcl.tk/tcl/ for details
2017-08-10 [array names -regexp] supports backrefs (goth)
2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows)
2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter)
2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
=> http 2.8.12
2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows)
2017-10-23 tzdata updated to Olson's tzdata2017c (jima)
2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows)
2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner)
2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter)
2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries)
2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann)
2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres)
2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter)
2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni)
2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter)
--- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details
Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:
2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter)
*** POTENTIAL INCOMPATIBILITY ***
@@ -8836,8 +8875,12 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin)
2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
=> http 2.8.12
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
2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann)
2018-03-12 (TIP 499) custom locale preference list (oehlmann)
=> msgcat 1.7.0
-14
View File
@@ -1,14 +0,0 @@
/*
* float.h --
*
* This is a dummy header file to #include in Tcl when there
* is no float.h in /usr/include. Right now this file is empty:
* Tcl contains #ifdefs to deal with the lack of definitions;
* all it needs is for the #include statement to work.
*
* Copyright (c) 1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-47
View File
@@ -1,47 +0,0 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Backslash \- parse a backslash sequence
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char
\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
.SH ARGUMENTS
.AS char *countPtr out
.AP 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
in with number of characters in the backslash sequence, including
the backslash character.
.BE
.SH DESCRIPTION
.PP
The use of \fBTcl_Backslash\fR is deprecated in favor of
\fBTcl_UtfBackslash\fR.
.PP
This is a utility procedure provided for backwards compatibility with
non-internationalized Tcl extensions. It parses a backslash sequence and
returns the low byte of the Unicode character corresponding to the sequence.
\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
characters in the backslash sequence.
.PP
See the Tcl manual entry for information on the valid backslash sequences.
All of the sequences described in the Tcl manual entry are supported by
\fBTcl_Backslash\fR.
.SH "SEE ALSO"
Tcl(n), Tcl_UtfBackslash(3)
.SH KEYWORDS
backslash, parse
-162
View File
@@ -1,162 +0,0 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
.SH "NOTICE OF EVENTUAL DEPRECATION"
.PP
The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions
are rendered somewhat obsolete by the ability to create functions for
expressions by placing commands in the \fBtcl::mathfunc\fR namespace,
as described in the \fBmathfunc\fR manual page; the API described on
this page is not expected to be maintained indefinitely.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
.sp
int
\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr,
clientDataPtr\fR)
.sp
Tcl_Obj *
\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
.SH ARGUMENTS
.AS Tcl_ValueType *clientDataPtr out
.AP Tcl_Interp *interp in
Interpreter in which new function will be defined.
.AP "const char" *name in
Name for new function.
.AP int numArgs in
Number of arguments to new function; also gives size of \fIargTypes\fR array.
.AP Tcl_ValueType *argTypes in
Points to an array giving the permissible types for each argument to
function.
.AP Tcl_MathProc *proc in
Procedure that implements the function.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
.AP int *numArgsPtr out
Points to a variable that will be set to contain the number of
arguments to the function.
.AP Tcl_ValueType **argTypesPtr out
Points to a variable that will be set to contain a pointer to an array
giving the permissible types for each argument to the function which
will need to be freed up using \fITcl_Free\fR.
.AP Tcl_MathProc **procPtr out
Points to a variable that will be set to contain a pointer to the
implementation code for the function (or NULL if the function is
implemented directly in bytecode).
.AP ClientData *clientDataPtr out
Points to a variable that will be set to contain the clientData
argument passed to \fITcl_CreateMathFunc\fR when the function was
created if the function is not implemented directly in bytecode.
.AP "const char" *pattern in
Pattern to match against function names so as to filter them (by
passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
.BE
.SH DESCRIPTION
.PP
Tcl allows a number of mathematical functions to be used in
expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
These functions are represented by commands in the namespace,
\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is
an obsolete way for applications to add additional functions
to those already provided by Tcl or to replace existing functions.
It should not be used by new applications, which should create
math functions using \fBTcl_CreateObjCommand\fR to create a command
in the \fBtcl::mathfunc\fR namespace.
.PP
In the \fBTcl_CreateMathFunc\fR interface,
\fIName\fR is the name of the function as it will appear in expressions.
If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR
namespace, then a new command is created in that namespace.
If \fIname\fR does exist, then the existing function is replaced.
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
Each entry in the \fIargTypes\fR array must be
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR,
or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an
integer, a double-precision floating value, a wide (64-bit) integer,
or any, respectively.
.PP
Whenever the function is invoked in an expression Tcl will invoke
\fIproc\fR. \fIProc\fR should have arguments and result that match
the type \fBTcl_MathProc\fR:
.PP
.CS
typedef int \fBTcl_MathProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
Tcl_Value *\fIargs\fR,
Tcl_Value *\fIresultPtr\fR);
.CE
.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
which describe the actual arguments to the function:
.PP
.CS
typedef struct Tcl_Value {
Tcl_ValueType \fItype\fR;
long \fIintValue\fR;
double \fIdoubleValue\fR;
Tcl_WideInt \fIwideValue\fR;
} \fBTcl_Value\fR;
.CE
.PP
The \fItype\fR field indicates the type of the argument and is
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR.
It will match the \fIargTypes\fR value specified for the function unless
the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts
the argument supplied in the expression to the type requested in
\fIargTypes\fR, if that is necessary.
Depending on the value of the \fItype\fR field, the \fIintValue\fR,
\fIdoubleValue\fR or \fIwideValue\fR
field will contain the actual value of the argument.
.PP
\fIProc\fR should compute its result and store it either as an integer
in \fIresultPtr->intValue\fR or as a floating value in
\fIresultPtr->doubleValue\fR.
It should set also \fIresultPtr->type\fR to one of
\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR
to indicate which value was set.
Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR.
If an error occurs while executing the function, \fIproc\fR should
return \fBTCL_ERROR\fR and leave an error message in the interpreter's result.
.PP
\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
function \fIname\fR that were passed to a preceding
\fBTcl_CreateMathFunc\fR call. Normally, the return code is
\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
is returned and an error message is placed in the interpreter's
result.
.PP
If an error did not occur, the array reference placed in the variable
pointed to by \fIargTypesPtr\fR is newly allocated, and should be
released by passing it to \fBTcl_Free\fR. Some functions (the
standard set implemented in the core, and those defined by placing
commands in the \fBtcl::mathfunc\fR namespace) do not have
argument type information; attempting to retrieve values for
them causes a NULL to be stored in the variable pointed to by
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
will not be modified. The variable pointed to by \fInumArgsPointer\fR
will contain -1, and no argument types will be stored in the variable
pointed to by \fIargTypesPointer\fR.
.PP
\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 "SEE ALSO"
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)
.SH KEYWORDS
expression, mathematical function
+1 -7
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -34,8 +34,6 @@ char *
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
@@ -128,10 +126,6 @@ caller to fill in the new space.
even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
will still need to be called.
.PP
\fBTcl_DStringTrunc\fR changes the length of a dynamic string.
This procedure is now deprecated. \fBTcl_DStringSetLength\fR should
be used instead.
.PP
\fBTcl_DStringFree\fR should be called when you are finished using
the string. It frees up any memory that was allocated for the string
and reinitializes the string's value to an empty string.
+2 -21
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -62,12 +62,6 @@ Tcl_Obj *
.sp
int
\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR)
.sp
const char *
\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
.sp
void
\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR)
.SH ARGUMENTS
.AS "const Tcl_EncodingType" *dstWrotePtr in/out
.AP Tcl_Interp *interp in
@@ -260,10 +254,6 @@ Windows-only convenience
functions for converting between UTF-8 and Windows strings
based on the TCHAR type which is by convention
a Unicode character on Windows NT.
These functions are essentially wrappers around
\fBTcl_UtfToExternalDString\fR and
\fBTcl_ExternalToUtfDString\fR that convert to and from the
Unicode encoding.
.PP
\fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR.
Given an \fIencoding\fR, the return value is the \fIname\fR argument that
@@ -291,7 +281,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned.
\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
consisting of the names of all the encodings that are currently defined
or can be dynamically loaded, searching the encoding path specified by
\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the
\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the
dynamically-loadable encoding files contain valid data, but merely that they
exist.
.PP
@@ -406,15 +396,6 @@ are not verified as existing readable filesystem directories. When
searching for encoding data files takes place, and non-existent or
non-readable filesystem directories on the \fIsearchPath\fR are silently
ignored.
.PP
\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR
are obsolete interfaces best replaced with calls to
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR.
They are called to access and set the first element of the \fIsearchPath\fR
list. Since Tcl searches \fIsearchPath\fR for encoding data files in
list order, these routines establish the
.QW default
directory in which to find encoding data files.
.SH "ENCODING FILES"
Space would prohibit precompiling into Tcl every possible encoding
algorithm, so many encodings are stored on disk as dynamically-loadable
+6 -12
View File
@@ -122,16 +122,10 @@ might be a UTF-8 special code. The string is parsed and executed directly
bytecodes. In situations where it is known that the script will never be
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
\fBTcl_Eval\fR returns a completion code and result just like
\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before
Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
does not do the copy.
\fBTcl_EvalObjEx\fR.
.PP
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
additional arguments \fInumBytes\fR and \fIflags\fR. For the
efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred
over \fBTcl_Eval\fR.
additional arguments \fInumBytes\fR and \fIflags\fR.
.PP
\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures
that are now deprecated. They are similar to \fBTcl_EvalEx\fR and
@@ -166,10 +160,10 @@ it is faster to execute the script directly.
.TP 23
\fBTCL_EVAL_GLOBAL\fR
.
If this flag is set, the script is processed at global level. This
means that it is evaluated in the global namespace and its variable
context consists of global variables only (it ignores any Tcl
procedures that are active).
If this flag is set, the script is evaluated in the global namespace instead of
the current namespace and its variable context consists of global variables
only (it ignores any Tcl procedures that are active).
.\" TODO: document TCL_EVAL_INVOKE and TCL_EVAL_NOERR.
.SH "MISCELLANEOUS DETAILS"
.PP
+3 -3
View File
@@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms,
the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the
library name is \fItclstub86.lib\fR.
Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms,
the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the
library name is \fItclstub90.lib\fR.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
+1 -1
View File
@@ -97,7 +97,7 @@ are provided by the C language standard. The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending
on the platform and the C compiler, the actual type might be
\fBlong int\fR, \fBlong long int\fR, \fB__int64\fR, or something else.
\fBlong long int\fR, \fB__int64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
+1 -1
View File
@@ -88,7 +88,7 @@ the command. The \fIfreeProc\fR field will be initialized to zero,
and \fIinterp->result\fR will point to an empty string. Commands that
do not return any value can simply leave the fields alone.
Furthermore, the empty string pointed to by \fIresult\fR is actually
part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
part of an array of approximately 200 characters.
If a command wishes to return a short string, it can simply copy
it to the area pointed to by \fIinterp->result\fR. Or, it can use
the sprintf procedure to generate a short result string at the location
+76 -168
View File
@@ -1,5 +1,6 @@
.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -38,43 +39,39 @@ void
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *interp in
.AP Tcl_Interp *interp in
Interpreter in which to create or evaluate a command.
The relevant Interpreter.
.AP char *cmdName in
Name of a new command to create.
Name of the command to create.
.AP Tcl_ObjCmdProc *proc in
Implementation of a command that will be called whenever \fIcmdName\fR
is invoked as a command in the unoptimized way.
Called in order to evaluate a command. Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Implementation of a command that will be called whenever \fIcmdName\fR
is invoked and requested to conserve the C stack.
Called instead of \fIproc\fR when a trampoline is already in use.
.AP ClientData clientData in
Arbitrary one-word value that will be passed to \fIproc\fR, \fInreProc\fR,
\fIdeleteProc\fR and \fIobjProc\fR.
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Procedure to call before \fIcmdName\fR is deleted from the interpreter.
This procedure allows for command-specific cleanup. If \fIdeleteProc\fR
is \fBNULL\fR, then no procedure is called before the command is deleted.
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP int objc in
Count of parameters provided to the implementation of a command.
Number of items in \fIobjv\fR.
.AP Tcl_Obj **objv in
Pointer to an array of Tcl values. Each value holds the value of a
single word in the command to execute.
Words in the command.
.AP Tcl_Obj *objPtr in
Pointer to a Tcl_Obj whose value is a script or expression to execute.
A script or expression to evaluate.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR is the only flag that is currently supported.
.\" TODO: This is a lie. But kbk didn't grasp TCL_EVAL_INVOKE and
.\" TCL_EVAL_NOERR well enough to document them.
As described for \fITcl_EvalObjv\fR.
.PP
.AP Tcl_Command cmd in
Token for a command that is to be used instead of the currently
executing command.
Token to use instead of one derived from the first word of \fIobjv\fR in order
to evaluate a command.
.AP Tcl_Obj *resultPtr out
Pointer to an unshared Tcl_Obj where the result of expression
evaluation is written.
Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if
the return code is TCL_OK.
.AP Tcl_NRPostProc *postProcPtr in
Pointer to a function that will be invoked when the command currently
executing in the interpreter designated by \fIinterp\fR completes.
A function to push.
.AP ClientData data0 in
.AP ClientData data1 in
.AP ClientData data2 in
@@ -84,98 +81,51 @@ to the function designated by \fIpostProcPtr\fR when it is invoked.
.BE
.SH DESCRIPTION
.PP
This series of C functions provides an interface whereby commands that
are implemented in C can be evaluated, and invoke Tcl commands scripts
and scripts, without consuming space on the C stack. The non-recursive
evaluation is done by installing a \fItrampoline\fR, a small piece of
code that invokes a command or script, and then executes a series of
callbacks when the command or script returns.
These functions provide an interface to the function stack that an interpreter
iterates through to evaluate commands. The routine behind a command is
implemented by an initial function and any additional functions that the
routine pushes onto the stack as it progresses. The interpreter itself pushes
functions onto the stack to react to the end of a routine and to exercise other
forms of control such as switching between in-progress stacks and the
evaluation of other scripts at additional levels without adding frames to the C
stack. To execute a routine, the initial function for the routine is called
and then a small bit of code called a \fItrampoline\fR iteratively takes
functions off the stack and calls them, using the value of the last call as the
value of the routine.
.PP
The \fBTcl_NRCreateCommand\fR function creates a Tcl command in the
interpreter designated by \fIinterp\fR that is prepared to handle
nonrecursive evaluation with a trampoline. The \fIcmdName\fR argument
gives the name of the new command. If \fIcmdName\fR contains any
namespace qualifiers, then the new command is added to the specified
namespace; otherwise, it is added to the global namespace. \fIproc\fR
gives the procedure that will be called when the interpreter wishes to
evaluate the command in an unoptimized manner, and \fInreProc\fR is
the procedure that will be called when the interpreter wishes to
evaluate the command using a trampoline. \fIdeleteProc\fR is a
function that will be called before the command is deleted from the
interpreter. When any of the three functions is invoked, it is passed
the \fIclientData\fR parameter.
\fBTcl_NRCallObjProc\fR calls \fInreProc\fR using a new trampoline.
.PP
\fBTcl_NRCreateCommand\fR deletes any existing command
\fIname\fR already associated with the interpreter
(however see below for an exception where the existing command
is not deleted).
It returns a token that may be used to refer
to the command in subsequent calls to \fBTcl_GetCommandName\fR.
If \fBTcl_NRCreateCommand\fR is called for an interpreter that is in
the process of being deleted, then it does not create a new command,
does not delete any existing command of the same name, and returns NULL.
\fBTcl_NRCreateCommand\fR, an alternative to \fBTcl_CreateObjCommand\fR,
resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the
current namespace, creates a command by that name, and returns a token for the
command which may be used in subsequent calls to \fBTcl_GetCommandName\fR.
Except for a few cases noted below any existing command by the same name is
first deleted. If \fIinterp\fR is in the process of being deleted
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
command, and returns NULL.
.PP
The \fIproc\fR and \fInreProc\fR function are expected to conform to
all the rules set forth for the \fIproc\fR argument to
\fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR).
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
consumes no space on the C stack.
.PP
When a command that is written to cope with evaluation via trampoline
is invoked without a trampoline on the stack, it will usually respond
to the invocation by creating a trampoline and calling the
trampoline-enabled implementation of the same command. This call is done by
means of \fBTcl_NRCallObjProc\fR. In the call to
\fBTcl_NRCallObjProc\fR, the \fIinterp\fR, \fIclientData\fR,
\fIobjc\fR and \fIobjv\fR parameters should be the same ones that were
passed to \fIproc\fR. The \fInreProc\fR parameter should designate the
trampoline-enabled implementation of the command.
\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but
consumes no space on the C stack.
.PP
\fBTcl_NREvalObj\fR arranges for the script contained in \fIobjPtr\fR
to be evaluated in the interpreter designated by \fIinterp\fR after
the current command (which must be trampoline-enabled) returns. It is
the method by which a command may invoke a script without consuming
space on the C stack. Similarly, \fBTcl_NREvalObjv\fR arranges to
invoke a single Tcl command whose words have already been separated
and substituted. The \fIobjc\fR and \fIobjv\fR parameters give the
words of the command to be evaluated when execution reaches the
trampoline.
\fBTcl_NRCmdSwap\fR is like \fBTcl_NREvalObjv\fR, but uses \fIcmd\fR, a token
previously returned by \fBTcl_CreateObjCommand\fR or
\fBTcl_GetCommandFromObj\fR, instead of resolving the first word of \fIobjv\fR.
. The name of this command must be the same as \fIobjv[0]\fR.
.PP
\fBTcl_NRCmdSwap\fR allows for trampoline evaluation of a command whose
resolution is already known. The \fIcmd\fR parameter gives a
\fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or
\fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in
the trampoline; this command must match the word in \fIobjv[0]\fR.
The remaining arguments are as for \fBTcl_NREvalObjv\fR.
\fBTcl_NRExprObj\fR pushes a function that evaluates \fIobjPtr\fR as an
expression in the same manner as \fBTcl_ExprObj\fR but without consuming space
on the C stack.
.PP
\fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR
all accept a \fIflags\fR parameter, which is an OR-ed-together set of
bits to control evaluation. At the present time, the only supported flag
available to callers is \fBTCL_EVAL_GLOBAL\fR.
.\" TODO: Again, this is a lie. Do we want to explain TCL_EVAL_INVOKE
.\" and TCL_EVAL_NOERR?
If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is
evaluated in the global namespace. If it is not set, it is evaluated
in the current namespace.
All of the functions return \fBTCL_OK\fR if the evaluation of the script,
command, or expression has been scheduled successfully. Otherwise (for example
if the command name cannot be resolved), they return \fBTCL_ERROR\fR and store
a message as the interpreter's result.
.PP
\fBTcl_NRExprObj\fR arranges for the expression contained in \fIobjPtr\fR
to be evaluated in the interpreter designated by \fIinterp\fR after
the current command (which must be trampoline-enabled) returns. It is
the method by which a command may evaluate a Tcl expression without consuming
space on the C stack. The argument \fIresultPtr\fR is a pointer to an
unshared Tcl_Obj where the result of expression evaluation is to be written.
If expression evaluation returns any code other than TCL_OK, the
\fIresultPtr\fR value is left untouched.
.PP
All of the routines return \fBTCL_OK\fR if command or expression invocation
has been scheduled successfully. If for any reason the scheduling cannot
be completed (for example, if the interpreter is unable to find
the requested command), they return \fBTCL_ERROR\fR with an
appropriate message left in the interpreter's result.
.PP
\fBTcl_NRAddCallback\fR arranges to have a C function called when the
current trampoline-enabled command in the Tcl interpreter designated
by \fIinterp\fR returns. The \fIpostProcPtr\fR argument is a pointer
to the callback function, which must have arguments and return value
consistent with the \fBTcl_NRPostProc\fR data type:
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR. The signature for
\fBTcl_NRPostProc\fR is:
.PP
.CS
typedef int
@@ -185,25 +135,13 @@ typedef int
int \fIresult\fR);
.CE
.PP
When the trampoline invokes the callback function, the \fIdata\fR
parameter will point to an array containing the four one-word
quantities that were passed to \fBTcl_NRAddCallback\fR in the
\fIdata0\fR through \fIdata3\fR parameters. The Tcl interpreter will
be designated by the \fIinterp\fR parameter, and the \fIresult\fR
parameter will contain the result (\fBTCL_OK\fR, \fBTCL_ERROR\fR,
\fBTCL_RETURN\fR, \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR) that was
returned by the command evaluation. The callback function is expected,
in turn, either to return a \fIresult\fR to control further evaluation.
.PP
Multiple \fBTcl_NRAddCallback\fR invocations may request multiple
callbacks, which may be to the same or different callback
functions. If multiple callbacks are requested, they are executed in
last-in, first-out order, that is, the most recently requested
callback is executed first.
\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR.
\fIresult\fR is the value returned by the previous function implementing part
the routine.
.SH EXAMPLE
.PP
The usual pattern for Tcl commands that invoke other Tcl commands
is something like:
The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C
stack, to evalute a script:
.PP
.CS
int
@@ -228,28 +166,17 @@ int
\fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
.CE
.PP
To enable a command like this one for trampoline-based evaluation,
it must be split into three pieces:
.IP \(bu
A non-trampoline implementation, \fITheCmdNewObjProc\fR,
which will simply create a trampoline
and invoke the trampoline-based implementation.
.IP \(bu
A trampoline-enabled implementation, \fITheCmdNRObjProc\fR. This
function will perform the initialization, request that the trampoline
call the postprocessing routine after command evaluation, and finally,
request that the trampoline call the inner command.
.IP \(bu
A postprocessing routine, \fITheCmdPostProc\fR. This function will
perform the postprocessing formerly done after the return from the
inner command in \fITheCmdObjProc\fR.
.PP
The non-trampoline implementation is simple and stylized, containing
a single statement:
To avoid consuming space on the C stack, \fITheCmdOldObjProc\fR is renamed to
\fITheCmdNRObjProc\fR and the postprocessing step is split into a separate
function, \fITheCmdPostProc\fR, which is pushed onto the function stack.
\fITcl_EvalObjEx\fR is replaced with \fITcl_NREvalObj\fR, which uses a
trampoline instead of consuming space on the C stack. A new version of
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
call \fITheCmdNRObjProc\fR:
.PP
.CS
int
\fITheCmdNewObjProc\fR(
\fITheCmdOldObjProc\fR(
ClientData clientData,
Tcl_Interp *interp,
int objc,
@@ -260,9 +187,6 @@ int
}
.CE
.PP
The trampoline-enabled implementation requests postprocessing,
and returns to the trampoline requesting command evaluation.
.PP
.CS
int
\fITheCmdNRObjProc\fR
@@ -284,9 +208,6 @@ int
}
.CE
.PP
The postprocessing procedure does whatever the original command did
upon return from the inner evaluation.
.PP
.CS
int
\fITheCmdNRPostProc\fR(
@@ -303,26 +224,13 @@ int
}
.CE
.PP
If \fItheCommand\fR is a command that results in multiple commands or
scripts being evaluated, its postprocessing routine may schedule
additional postprocessing and then request another command evaluation
by means of \fBTcl_NREvalObj\fR or one of the other evaluation
routines. Looping and sequencing constructs may be implemented in this way.
Any function comprising a routine can push other functions, making it possible
implement looping and sequencing constructs using the function stack.
.PP
Finally, to install a trampoline-enabled command in the interpreter,
\fBTcl_NRCreateCommand\fR is used in place of
\fBTcl_CreateObjCommand\fR. It accepts two command procedures instead
of one. The first is for use when no trampoline is yet on the stack,
and the second is for use when there is already a trampoline in place.
.PP
.CS
\fBTcl_NRCreateCommand\fR(interp, "theCommand",
\fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData,
TheCmdDeleteProc);
.CE
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny
Copyright (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.
+1 -1
View File
@@ -257,7 +257,7 @@ The \fBincr\fR command first gets an integer from \fIx\fR's value
by calling \fBTcl_GetIntFromObj\fR.
This procedure checks whether the value is already an integer value.
Since it is not, it converts the value
by setting the value's \fIinternalRep.longValue\fR member
by setting the value's internal representation
to the integer \fB123\fR
and setting the value's \fItypePtr\fR
to point to the integer Tcl_ObjType structure.
+5 -19
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -33,20 +33,16 @@ const char *
.sp
\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
.sp
Tcl_Obj *
\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
.sp
int
\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
.SH ARGUMENTS
.AS Tcl_Interp *usedParsePtr out
.AP Tcl_Interp *interp out
For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
For procedures other than \fBTcl_FreeParse\fR and
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
if NULL, then no error messages are left after errors.
For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
determines the context for evaluating the
script and also is used for error reporting; must not be NULL.
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
the script and also is used for error reporting; must not be NULL.
.AP "const char" *start in
Pointer to first character in string to parse.
.AP int numBytes in
@@ -191,16 +187,6 @@ 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.
.PP
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
the return convention used: it returns the result in a new Tcl_Obj.
The reference count of the value returned as result has been
incremented, so the caller must
invoke \fBTcl_DecrRefCount\fR when it is finished with the value.
If an error or other exception occurs while evaluating the tokens
(such as a reference to a non-existent variable) then the return value
is NULL and an error message is left in \fIinterp\fR's result. The use
of \fBTcl_EvalTokens\fR is deprecated.
.SH "TCL_PARSE STRUCTURE"
.PP
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
+2 -7
View File
@@ -18,10 +18,7 @@ Tcl_PrintDouble \- Convert floating value to string
.SH ARGUMENTS
.AS Tcl_Interp *interp out
.AP Tcl_Interp *interp in
Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter
controlled the conversion. As of Tcl 8.0, this argument is ignored and
the conversion is controlled by the \fBtcl_precision\fR variable
that is now shared by all interpreters.
This argument is ignored.
.AP double value in
Floating-point value to be converted.
.AP char *dst out
@@ -41,9 +38,7 @@ so that it does not look like an integer. Where \fB%g\fR would
generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds
.QW .0 .
.PP
If the \fBtcl_precision\fR value is non-zero, the result will have
precisely that many digits of significance. If the value is zero
(the default), the result will have the fewest digits needed to
The result will have the fewest digits needed to
represent the number in such a way that \fBTcl_NewDoubleObj\fR
will generate the same number when presented with the given string.
IEEE semantics of rounding to even apply to the conversion.
+1 -1
View File
@@ -31,7 +31,7 @@ the command at global level instead of the current stack level.
.SH DESCRIPTION
.PP
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
on the history list and then execute it using \fBTcl_EvalObjEx\fR
on the history list and then execute it using \fBTcl_EvalObjEx\fR.
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
as well as a result value containing additional information
(a result value or error message)
+1 -1
View File
@@ -29,7 +29,7 @@ New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
.PP
At any given time Tcl enforces a limit on the number of recursive
calls that may be active for \fBTcl_Eval\fR and related procedures
such as \fBTcl_GlobalEval\fR.
such as \fBTcl_EvalEx\fR.
Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with
an error.
By default the recursion limit is 1000.
+3 -2
View File
@@ -37,7 +37,7 @@ Tcl_UniChar *
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
.sp
Tcl_UniChar
int
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
.sp
int
@@ -201,7 +201,8 @@ where the caller does not need the length of the unicode string
representation.
.PP
\fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
value's Unicode representation.
value's Unicode representation. If the index is out of range or
it references a low surrogate preceded by a high surrogate, it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
+4 -4
View File
@@ -13,13 +13,13 @@ Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_UniChar
int
\fBTcl_UniCharToUpper\fR(\fIch\fR)
.sp
Tcl_UniChar
int
\fBTcl_UniCharToLower\fR(\fIch\fR)
.sp
Tcl_UniChar
int
\fBTcl_UniCharToTitle\fR(\fIch\fR)
.sp
int
@@ -33,7 +33,7 @@ int
.SH ARGUMENTS
.AS char *str in/out
.AP int ch in
The Tcl_UniChar to be converted.
The Unicode character to be converted.
.AP char *str in/out
Pointer to UTF-8 string to be converted in place.
.BE
+2 -5
View File
@@ -48,19 +48,16 @@ int
.SH ARGUMENTS
.AS int ch
.AP int ch in
The Tcl_UniChar to be examined.
The Unicode character to be examined.
.BE
.SH DESCRIPTION
.PP
All of the routines described examine Tcl_UniChars and return a
All of the routines described examine Unicode characters and return a
boolean value. A non-zero return value means that the character does
belong to the character class associated with the called routine. The
rest of this document just describes the character classes associated
with the various routines.
.PP
Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
fixed-size quantity.
.SH "CHARACTER CLASSES"
.PP
+5 -2
View File
@@ -63,7 +63,7 @@ const char *
const char *
\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
.sp
Tcl_UniChar
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
@@ -77,7 +77,7 @@ int
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most
\fBTCL_UTF_MAX\fR bytes are stored in the buffer.
.AP int ch in
The Tcl_UniChar to be converted or examined.
The Unicode character to be converted or examined.
.AP Tcl_UniChar *chPtr out
Filled with the Tcl_UniChar represented by the head of the UTF-8 string.
.AP "const char" *src in
@@ -140,6 +140,9 @@ number of bytes read from \fIsrc\fR. The caller must ensure that the
source buffer is long enough such that this routine does not run off the
end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen. If the input is
a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the
cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR
and returns 1. If the input is otherwise
not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and
0x00ff and return 1.
+9
View File
@@ -47,6 +47,15 @@ been the return value from a previous invocation of
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
.TP
\fBarray for {\fIkeyVariable valueVariable\fB} \fIarrayName body\fP
The first argument is a two element list of variable names for the
key and value of each entry in the array. The second argument is the
array name to iterate over. The third argument is the body to execute
for each key and value returned.
The ordering of the returned keys is undefined.
If an array element is deleted or a new array element is inserted during
the \fIarray for\fP process, the command will terminate with an error.
.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements. The first
element in each pair is the name of an element in \fIarrayName\fR
-60
View File
@@ -1,60 +0,0 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH case n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
case \- Evaluate one of several scripts, depending on a given value
.SH SYNOPSIS
\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...?
.sp
\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?}
.BE
.SH DESCRIPTION
.PP
\fINote: the \fBcase\fI command is obsolete and is supported only
for backward compatibility. At some point in the future it may be
removed entirely. You should use the \fBswitch\fI command instead.\fR
.PP
The \fBcase\fR command matches \fIstring\fR against each of
the \fIpatList\fR arguments in order.
Each \fIpatList\fR argument is a list of one or
more patterns. If any of these patterns matches \fIstring\fR then
\fBcase\fR evaluates the following \fIbody\fR argument
by passing it recursively to the Tcl interpreter and returns the result
of that evaluation.
Each \fIpatList\fR argument consists of a single
pattern or list of patterns. Each pattern may contain any of the wild-cards
described under \fBstring match\fR. If a \fIpatList\fR
argument is \fBdefault\fR, the corresponding body will be evaluated
if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument
matches \fIstring\fR and no default is given, then the \fBcase\fR
command returns an empty string.
.PP
Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
this form is convenient if substitutions are desired on some of the
patterns or commands.
The second form places all of the patterns and commands together into
a single argument; the argument must have proper list structure, with
the elements of the list being the patterns and commands.
The second form makes it easy to construct multi-line case commands,
since the braces around the whole list make it unnecessary to include a
backslash at the end of each line.
Since the \fIpatList\fR arguments are in braces in the second form,
no command or variable substitutions are performed on them; this makes
the behavior of the second form different than the first form in some
cases.
.SH "SEE ALSO"
switch(n)
.SH KEYWORDS
case, match, regular expression
+1 -1
View File
@@ -50,7 +50,7 @@ being constructed. Within the constructor, the \fBnext\fR command should be
used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
string, the constructor will be deleted.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
+23 -10
View File
@@ -83,14 +83,15 @@ Specifies that the number should be padded on the left with
zeroes instead of spaces.
.TP 10
\fB#\fR
Requests an alternate output form. For \fBo\fR and \fBO\fR
conversions it guarantees that the first digit is always \fB0\fR.
For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
Requests an alternate output form. For \fBo\fR conversions,
\fB0o\fR will be added to the beginning of the result unless
it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR
will be added to the beginning of the result unless it is zero.
For \fBb\fR conversions, \fB0b\fR
will be added to the beginning of the result unless it is zero.
For \fBd\fR conversions, \fB0d\fR will be added to the beginning
of the result unless it is zero.
For \fBd\fR conversions, \fB0d\fR there is no effect unless
the \fB0\fR specifier is used as well: In that case, \fB0d\fR
will be added to the beginning.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
@@ -132,7 +133,7 @@ it must be a numeric string.
.SS "OPTIONAL SIZE MODIFIER"
.PP
The fifth part of a conversion specifier is a size modifier,
which must be \fBll\fR, \fBh\fR, or \fBl\fR.
which must be \fBll\fR, \fBh\fR, \fBl\fR, or \fBL\fR.
If it is \fBll\fR it specifies that an integer value is taken
without truncation for conversion to a formatted substring.
If it is \fBh\fR it specifies that an integer value is
@@ -140,7 +141,9 @@ truncated to a 16-bit range before converting. This option is rarely useful.
If it is \fBl\fR it specifies that the integer value is
truncated to the same range as that produced by the \fBwide()\fR
function of the \fBexpr\fR command (at least a 64-bit range).
If neither \fBh\fR nor \fBl\fR are present, the integer value is
If it is \fBL\fR it specifies that an integer or double value is taken
without truncation for conversion to a formatted substring.
If neither \fBh\fR nor \fBl\fR nor \fBL\fR are present, the integer value is
truncated to the same range as that produced by the \fBint()\fR
function of the \fBexpr\fR command (at least a 32-bit range, but
determined by the value of the \fBwordSize\fR element of the
@@ -171,7 +174,7 @@ for \fBx\fR and
for \fBX\fR).
.TP 10
\fBb\fR
Convert integer to binary string, using digits 0 and 1.
Convert integer to unsigned binary string, using digits 0 and 1.
.TP 10
\fBc\fR
Convert integer to the Unicode character it represents.
@@ -200,8 +203,19 @@ precision, then convert number as for \fB%e\fR or
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
.TP 10
\fBa\fR or \fBA\fR
Convert double to hexadecimal notation in the form
\fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is
determined by the precision (default: 13).
If the \fBA\fR form is used then the hex characters
are printed in uppercase.
.TP 10
\fB%\fR
No conversion: just insert \fB%\fR.
.TP 10
\fBp\fR
Shorthand form for \fB0x%zx\fR, so it outputs the integer in
hexadecimal form with \fB0x\fR prefix.
.SH "DIFFERENCES FROM ANSI SPRINTF"
.PP
The behavior of the format command is the same as the
@@ -210,13 +224,12 @@ differences:
.IP [1]
Tcl guarantees that it will be working with UNICODE characters.
.IP [2]
\fB%p\fR and \fB%n\fR specifiers are not supported.
\fB%n\fR specifier is not supported.
.IP [3]
For \fB%c\fR conversions the argument must be an integer value,
which will then be converted to the corresponding character value.
.IP [4]
The size modifiers are ignored when formatting floating-point values.
The \fBll\fR modifier has no \fBsprintf\fR counterpart.
The \fBb\fR specifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
.PP
+20
View File
@@ -148,6 +148,19 @@ or \fB\-not\fR.
These options are used to search lists of lists. They may be used
with any other options.
.TP
\fB\-stride\0\fIstrideLength\fR
.
If this option is specified, the list is treated as consisting of
groups of \fIstrideLength\fR elements and the groups are searched by
either their first element or, if the \fB\-index\fR option is used,
by the element within each group given by the first index passed to
\fB\-index\fR (which is then ignored by \fB\-index\fR). The resulting
index always points to the first element in a group.
.PP
The list length must be an integer multiple of \fIstrideLength\fR, which
in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and
indicates no grouping.
.TP
\fB\-index\fR\0\fIindexList\fR
.
This option is designed for use when searching within nested lists.
@@ -208,6 +221,13 @@ It is also possible to search inside elements:
\fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc*
\fI\(-> {a abc} {b bcd}\fR
.CE
.PP
The same thing for a flattened list:
.PP
.CS
\fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc*
\fI\(-> {a abc b bcd}\fR
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
lset(n), lsort(n), lrange(n), lreplace(n),
+1 -4
View File
@@ -106,10 +106,7 @@ of which work solely with floating-point numbers unless otherwise noted:
In addition to these predefined functions, applications may
define additional functions by using \fBproc\fR (or any other method,
such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
new commands in the \fBtcl::mathfunc\fR namespace. In addition, an
obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
extensions that are written in C. The latter interface is not recommended
for new implementations.
new commands in the \fBtcl::mathfunc\fR namespace.
.SS "DETAILED DEFINITIONS"
.TP
\fBabs \fIarg\fR
+179 -28
View File
@@ -11,9 +11,9 @@
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
\fBpackage require Tcl 8.7\fR
.sp
\fBpackage require msgcat 1.6\fR
\fBpackage require msgcat 1.7\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
@@ -23,9 +23,15 @@ msgcat \- Tcl message catalog
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.VE "TIP 412"
.sp
.VS "TIP 490"
\fB::msgcat::mcpackagenamespaceget\fR
.VE "TIP 490"
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
\fB::msgcat::mcpreferences\fR
.VS "TIP 499"
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
.VE "TIP 499"
.sp
.VS "TIP 412"
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
@@ -50,6 +56,10 @@ msgcat \- Tcl message catalog
.sp
\fB::msgcat::mcforgetpackage\fR
.VE "TIP 412"
.sp
.VS "TIP 499"
\fB::msgcat::mcutil subcommand\fR ?\fIlocale\fR?
.VS "TIP 499"
.BE
.SH DESCRIPTION
.PP
@@ -71,6 +81,11 @@ In \fBmsgcat\fR, there is a global locale initialized by the system locale of th
Each package may decide to use the global locale or to use a package specific locale.
.PP
The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
.PP
.VS tip490
Object oriented programming is supported by the use of a package namespace.
.VE tip490
.PP
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
@@ -95,6 +110,17 @@ use the result. If an application is written for a single language in
this fashion, then it is easy to add support for additional languages
later simply by defining new message catalog entries.
.RE
.VS "TIP 490"
.TP
\fB::msgcat::mcn \fInamespace\fR \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument.
.PP
.RS
\fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller.
An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below.
.RE
.PP
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.
@@ -102,29 +128,69 @@ Given several source strings, \fB::msgcat::mcmax\fR returns the length
of the longest translated string. This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).
.TP
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.
.VS "TIP 412"
.TP
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR
.
Return true, if there is a translation for the given \fIsrc-string\fR.
.PP
.RS
The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
.PP
It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
.RE
.PP
.VE "TIP 412"
.VS "TIP 490"
An explicit package namespace may be specified by the option \fB-namespace\fR.
The namespace of the caller is used if not explicitly specified.
.RE
.PP
.VE "TIP 490"
.VS "TIP 490"
.TP
\fB::msgcat::mcpackagenamespaceget\fR
.
Return the package namespace of the caller.
This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR.
.PP
.RS
Example usage is a tooltip package, which saves the caller package namespace to update the translation each time the tooltip is shown:
.CS
proc ::tooltip::tooltip {widget message} {
...
set messagenamespace [uplevel 1 {::msgcat::mcpackagenamespaceget}]
...
bind $widget [list ::tooltip::show $widget $messagenamespace $message]
}
proc ::tooltip::show {widget messagenamespace message} {
...
set message [::msgcat::mcn $messagenamespace $message]
...
}
.CE
.RE
.PP
.VE "TIP 490"
.TP
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.
This function sets the locale to \fInewLocale\fR. If \fInewLocale\fR
is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR. msgcat stores and compares the locale in a
If \fInewLocale\fR is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.
.PP
.RS
If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set.
For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR.
.PP
The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fR \fInewLocale\fR].
.PP
The current locale is always the first element of the list returned by \fBmcpreferences\fR.
.PP
msgcat stores and compares the locale in a
case-insensitive manner, and returns locales in lowercase.
The initial locale is determined by the locale specified in
the user's environment. See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.
.RS
.PP
.VS "TIP 412"
If the locale is set, the preference list of locales is evaluated.
@@ -132,16 +198,26 @@ Locales in this list are loaded now, if not jet loaded.
.VE "TIP 412"
.RE
.TP
\fB::msgcat::mcpreferences\fR
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
.
Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
preference. The list is derived from the current
locale set in msgcat by \fB::msgcat::mclocale\fR, and
cannot be set independently. For example, if the
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
returns \fB{en_us_funky en_us en {}}\fR.
Without arguments, returns an ordered list of the locales preferred by
the user.
The list is ordered from most specific to least preference.
.PP
.VS "TIP 499"
.RS
A set of locale preferences may be given to set the list of locale preferences.
The current locale is also set, which is the first element of the locale preferences list.
.PP
Locale preferences are loaded now, if not jet loaded.
.PP
As an example, the user may prefer French or English text. This may be configured by:
.CS
::msgcat::mcpreferences fr en {}
.CE
.RE
.PP
.VS "TIP 499"
.TP
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
.
@@ -232,6 +308,22 @@ Note that this routine is only called if the concerned package did not set a pac
The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
.VE "TIP 412"
.PP
.VS "TIP 499"
.TP
\fB::msgcat::mcutil getpreferences\fR \fIlocale\fR
.
Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR.
An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french:
.CS
% concat [lrange [msgcat::mcutil getpreferences fr_CH] 0 end-1] [msgcat::mcutil getpreferences de_CH]
fr_ch fr de_ch de {}
.CE
.TP
\fB::msgcat::mcutil getsystemlocale\fR
.
The system locale is returned as described by the section \fBLOCALE SPECIFICATION\fR.
.VE "TIP 499"
.PP
.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
@@ -437,7 +529,7 @@ formatting substitution is done directly.
# human-oriented versions by \fBmsgcat::mcset\fR
.CE
.VS "TIP 412"
.SH Package private locale
.SH "PACKAGE PRIVATE LOCALE"
.PP
A package using \fBmsgcat\fR may choose to use its own package private
locale and its own set of loaded locales, independent to the global
@@ -461,10 +553,22 @@ This command may cause the load of locales.
.
Return the package private locale or the global locale, if no package private locale is set.
.TP
\fB::msgcat::mcpackagelocale preferences\fR
\fB::msgcat::mcpackagelocale preferences\fR ?\fIlocale preference\fR? ...
.
Return the package private preferences or the global preferences,
With no parameters, return the package private preferences or the global preferences,
if no package private locale is set.
The package locale state (set or not) is not changed (in contrast to the command \fB::msgcat::mcpackagelocale set\fR).
.PP
.RS
.VS "TIP 499"
If a set of locale preferences is given, it is set as package locale preference list.
The package locale is set to the first element of the preference list.
A package locale is activated, if it was not set so far.
.PP
Locale preferences are loaded now for the package, if not jet loaded.
.VE "TIP 499"
.RE
.PP
.TP
\fB::msgcat::mcpackagelocale loaded\fR
.
@@ -488,7 +592,7 @@ Returns true, if the given locale is loaded for the package.
.
Clear any loaded locales of the package not present in the package preferences.
.PP
.SH Changing package options
.SH "CHANGING PACKAGE OPTIONS"
.PP
Each package using msgcat has a set of options within \fBmsgcat\fR.
The package options are described in the next sectionPackage options.
@@ -563,7 +667,7 @@ A generic unknown handler is used if set to the empty string. This consists in r
See section \fBcallback invocation\fR below.
The appended arguments are identical to \fB::msgcat::mcunknown\fR.
.RE
.SS Callback invocation
.SH "Callback invocation"
A package may decide to register one or multiple callbacks, as described above.
.PP
Callbacks are invoked, if:
@@ -577,7 +681,54 @@ Callbacks are invoked, if:
If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
.PP
.SS Examples
.VS tip490
.SH "OBJECT ORIENTED PROGRAMMING"
\fBmsgcat\fR supports packages implemented by object oriented programming.
Objects and classes should be defined within a package namespace.
.PP
There are 3 supported cases where package namespace sensitive commands of msgcat (\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, \fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) may be called:
.PP
.TP
\fB1) In class definition script\fR
.
\fBmsgcat\fR command is called within a class definition script.
.CS
namespace eval ::N2 {
mcload $dir/msgs
oo::class create C1 {puts [mc Hi!]}
}
.CE
.PP
.TP
\fB2) method defined in a class\fR
.
\fBmsgcat\fR command is called from a method in an object and the method is defined in a class.
.CS
namespace eval ::N3Class {
mcload $dir/msgs
oo::class create C1
oo::define C1 method m1 {
puts [mc Hi!]
}
}
.CE
.PP
.TP
\fB3) method defined in a classless object\fR
.
\fBmsgcat\fR command is called from a method of a classless object.
.CS
namespace eval ::N4 {
mcload $dir/msgs
oo::object create O1
oo::objdefine O1 method m1 {} {
puts [mc Hi!]
}
}
.CE
.PP
.VE tip490
.SH EXAMPLES
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
@@ -643,9 +794,9 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
.PP
The message catalog code was developed by Mark Harrison.
.SH "SEE ALSO"
format(n), scan(n), namespace(n), package(n)
format(n), scan(n), namespace(n), package(n), oo::class(n), oo::object
.SH KEYWORDS
internationalization, i18n, localization, l10n, message, text, translation
internationalization, i18n, localization, l10n, message, text, translation, class, object
.\" Local Variables:
.\" mode: nroff
.\" End:
+3 -5
View File
@@ -115,9 +115,7 @@ Any Unicode control character.
Any Unicode digit character. Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the valid forms for a double in Tcl, with optional surrounding
whitespace. In case of under/overflow in the value, 0 is returned and
the \fIvarname\fR will contain \-1.
Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
.IP \fBentier\fR 12
.VS 8.6
Any of the valid string formats for an integer value of arbitrary size
@@ -131,7 +129,7 @@ false.
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for a 32-bit integer value in Tcl,
with optional surrounding whitespace. In case of under/overflow in
with optional surrounding whitespace. In case of overflow in
the value, 0 is returned and the \fIvarname\fR will contain \-1.
.IP \fBlist\fR 12
Any proper list structure, with optional surrounding whitespace. In
@@ -156,7 +154,7 @@ true.
Any upper case alphabet character in the Unicode character set.
.IP \fBwideinteger\fR 12
Any of the valid forms for a wide integer in Tcl, with optional
surrounding whitespace. In case of under/overflow in the value, 0 is
surrounding whitespace. In case of overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
.IP \fBwordchar\fR 12
Any Unicode word character. That is any alphanumeric character, and
+1 -65
View File
@@ -10,7 +10,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
.BE
.SH DESCRIPTION
.PP
@@ -356,70 +356,6 @@ This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.RE
.TP
\fBtcl_precision\fR
.
This variable controls the number of digits to generate
when converting floating-point values to strings. It defaults
to 0. \fIApplications should not change this value;\fR it is
provided for compatibility with legacy code.
.PP
.RS
The default value of 0 is special, meaning that Tcl should
convert numbers using as few digits as possible while still
distinguishing any floating point number from its nearest
neighbours. It differs from using an arbitrarily high value
for \fItcl_precision\fR in that an inexact number like \fI1.4\fR
will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR
even though the latter is nearer to the exact value of the
binary number.
.RE
.PP
.RS
If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
point number, it creates a decimal representation of at most
\fBtcl_precision\fR significant digits; the result may be shorter if
the shorter result represents the original number exactly. If no
result of at most \fBtcl_precision\fR digits is an exact representation
of the original number, the one that is closest to the original
number is chosen.
If the original number lies precisely between two equally accurate
decimal representations, then the one with an even value for the least
significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then
0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to
0.688, not 0.687. Any string of trailing zeroes that remains is trimmed.
.RE
.PP
.RS
a \fBtcl_precision\fR value of 17 digits is
.QW perfect
for IEEE floating-point in that it allows
double-precision values to be converted to strings and back to
binary with no loss of information. For this reason, you will often
see it as a value in legacy code that must run on Tcl versions before
8.5. It is no longer recommended; as noted above, a zero value is the
preferred method.
.RE
.PP
.RS
All interpreters in a thread share a single \fBtcl_precision\fR value:
changing it in one interpreter will affect all other interpreters as
well. Safe interpreters are not allowed to modify the
variable.
.RE
.PP
.RS
Valid values for \fBtcl_precision\fR range from 0 to 17.
.RE
.TP
\fBtcl_rcFileName\fR
.
This variable is used during initialization to indicate the name of a
user-specific startup file. If it is set by application-specific
initialization, then the Tcl startup code will check for the existence
of this file and \fBsource\fR it if it exists. For example, for \fBwish\fR
the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR
for Windows.
.TP
\fBtcl_traceCompile\fR
.
The value of this variable can be set to control
+265 -259
View File
@@ -137,8 +137,8 @@ static const crange alphaRangeTable[] = {
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588},
{0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
{0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4},
{0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
@@ -165,45 +165,42 @@ static const crange alphaRangeTable[] = {
{0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
{0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731},
{0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3},
{0x1820, 0x1877}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
{0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
{0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
{0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
{0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec},
{0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d},
{0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
{0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc},
{0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4},
{0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d},
{0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149},
{0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee},
{0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6},
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035},
{0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff},
{0x3105, 0x312e}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff},
{0x3400, 0x4db5}, {0x4e00, 0x9fea}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd},
{0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d},
{0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae},
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a},
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
{0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
{0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
{0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
{0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d},
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
{0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba},
{0x1cbd, 0x1cbf}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf},
{0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
{0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc},
{0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb},
{0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c},
{0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139},
{0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e},
{0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67},
{0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
{0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
{0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f},
{0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e},
{0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef},
{0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f},
{0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f},
{0xa722, 0xa788}, {0xa78b, 0xa7b9}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
{0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
{0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
{0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
{0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
{0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
{0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65},
{0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
{0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
{0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
{0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
{0xffda, 0xffdc}
#if CHRBITS > 16
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
{0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
@@ -212,23 +209,25 @@ static const crange alphaRangeTable[] = {
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
{0x10f30, 0x10f45}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
{0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4},
{0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
{0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c},
{0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361},
{0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae},
{0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, {0x11700, 0x1171a},
{0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
{0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x12000, 0x12399},
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
{0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
{0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
{0x17000, 0x187ec}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x11d60, 0x11d65},
{0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, {0x12000, 0x12399}, {0x12480, 0x12543},
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
{0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
{0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
{0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
@@ -264,17 +263,18 @@ static const chr alphaCharTable[] = {
0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, 0xa9cf, 0xaa7a, 0xaab1,
0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43,
0xfb44
#if CHRBITS > 16
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11a00,
0x11a3a, 0x11a50, 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x16f50, 0x16fe0, 0x16fe1,
0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
0x1ee64, 0x1ee7e
0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644,
0x118ff, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, 0x11c40, 0x11d08, 0x11d09, 0x11d46,
0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2,
0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};
@@ -288,7 +288,7 @@ static const crange controlRangeTable[] = {
{0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
{0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
{0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
#if CHRBITS > 16
,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
{0x100000, 0x10fffd}
#endif
@@ -298,8 +298,8 @@ static const crange controlRangeTable[] = {
static const chr controlCharTable[] = {
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
#if TCL_UTF_MAX > 4
,0x110bd, 0xe0001
#if CHRBITS > 16
,0x110bd, 0x110cd, 0xe0001
#endif
};
@@ -320,12 +320,12 @@ static const crange digitRangeTable[] = {
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
{0xff10, 0xff19}
#if TCL_UTF_MAX > 4
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
{0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
{0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
{0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#if CHRBITS > 16
,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
{0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
{0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
{0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
{0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#endif
};
@@ -348,19 +348,20 @@ static const crange punctRangeTable[] = {
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
{0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4e},
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
{0xff5f, 0xff65}
#if TCL_UTF_MAX > 4
#if CHRBITS > 16
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
{0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
{0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, {0x11c41, 0x11c45},
{0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
{0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1},
{0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x111dd, 0x111df}, {0x11238, 0x1123d},
{0x1144b, 0x1144f}, {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c},
{0x1173c, 0x1173e}, {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2},
{0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x16e97, 0x16e9a},
{0x1da87, 0x1da8b}
#endif
};
@@ -371,18 +372,20 @@ static const chr punctCharTable[] = {
0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
0x9fd, 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9,
0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736,
0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e,
0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe,
0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673,
0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df,
0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
0x9fd, 0xa76, 0xaf0, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14,
0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c,
0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
0xff5b, 0xff5d
#if CHRBITS > 16
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f,
0x1e95e, 0x1e95f
#endif
};
@@ -413,25 +416,25 @@ static const crange lowerRangeTable[] = {
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
{0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a},
{0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
{0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa},
{0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
{0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
{0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
{0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
{0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
{0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
{0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
{0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab65},
{0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if CHRBITS > 16
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
{0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
{0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
{0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
{0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
{0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
{0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
{0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
{0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
{0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
{0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
{0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
{0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
#endif
};
@@ -501,8 +504,8 @@ static const chr lowerCharTable[] = {
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7fa
#if CHRBITS > 16
,0x1d4bb, 0x1d7cb
#endif
};
@@ -518,20 +521,22 @@ static const crange upperRangeTable[] = {
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
{0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
{0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
{0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
{0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
{0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
{0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
{0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
{0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
{0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if CHRBITS > 16
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
{0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
{0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
{0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
{0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
{0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
{0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
{0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
{0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
{0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
{0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8},
{0x1e900, 0x1e921}
#endif
};
@@ -600,8 +605,9 @@ static const chr upperCharTable[] = {
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
0xa7b8
#if CHRBITS > 16
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
0x1d539, 0x1d546, 0x1d7ca
#endif
@@ -616,85 +622,80 @@ static const chr upperCharTable[] = {
static const crange graphRangeTable[] = {
{0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
{0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
{0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
{0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
{0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a},
{0x8a0, 0x8b4}, {0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983},
{0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
{0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fd},
{0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
{0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75},
{0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
{0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9},
{0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff},
{0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
{0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
{0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
{0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
{0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
{0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
{0xc66, 0xc6f}, {0xc78, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4},
{0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef},
{0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd44},
{0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f},
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
{0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4},
{0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f},
{0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4},
{0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47},
{0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc},
{0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d},
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
{0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
{0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c},
{0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c},
{0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9},
{0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa},
{0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b},
{0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
{0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c},
{0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe},
{0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
{0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf9},
{0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
{0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
{0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
{0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
{0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd2},
{0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
{0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
{0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
{0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d},
{0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4},
{0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03},
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {0xa81, 0xa83},
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
{0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
{0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
{0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
{0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
{0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
{0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
{0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc8c},
{0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
{0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
{0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
{0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
{0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
{0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
{0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97},
{0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd},
{0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf},
{0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc},
{0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248},
{0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
{0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
{0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
{0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5},
{0x13f8, 0x13fd}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8},
{0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
{0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1878},
{0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b},
{0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
{0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
{0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
{0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3},
{0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1c90, 0x1cba},
{0x1cbd, 0x1cc7}, {0x1cd0, 0x1cf9}, {0x1d00, 0x1df9}, {0x1dfb, 0x1f15},
{0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
{0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
{0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
{0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c},
{0x20a0, 0x20bf}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, {0x2190, 0x2426},
{0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bc8},
{0x2bca, 0x2bfe}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
{0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e49},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4e},
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312e},
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fea}, {0xa000, 0xa48c},
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae},
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
{0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
{0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
{0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
{0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
{0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c},
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7b9},
{0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
{0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
{0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
{0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
{0xab30, 0xab65}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
{0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
{0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
{0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
{0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
{0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if CHRBITS > 16
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
@@ -705,80 +706,85 @@ static const crange graphRangeTable[] = {
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
{0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
{0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
{0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11a9c}, {0x11a9e, 0x11aa2},
{0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
{0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
{0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
{0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x11000, 0x1104d},
{0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8},
{0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, {0x11150, 0x11176},
{0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211},
{0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
{0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303},
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
{0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c},
{0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, {0x114d0, 0x114d9},
{0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, {0x11650, 0x11659},
{0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x1171a},
{0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x11800, 0x1183b}, {0x118a0, 0x118f2},
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11aa2}, {0x11ac0, 0x11af8},
{0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
{0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
{0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
{0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
{0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
{0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
{0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
{0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
{0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a},
{0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f},
{0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8},
{0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454},
{0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
{0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
{0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
{0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f},
{0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, {0x1e008, 0x1e018}, {0x1e01b, 0x1e021},
{0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a},
{0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
{0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
{0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
{0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
{0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
{0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
{0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248},
{0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f8},
{0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
{0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
{0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
{0x16e40, 0x16e9a}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
{0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
{0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
{0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
{0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
{0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
{0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
{0x1f100, 0x1f10c}, {0x1f110, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
{0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4},
{0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f9}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d8},
{0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887},
{0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, {0x1f910, 0x1f93e}, {0x1f940, 0x1f970},
{0x1f973, 0x1f976}, {0x1f97c, 0x1f9a2}, {0x1f9b0, 0x1f9b9}, {0x1f9c0, 0x1f9c2},
{0x1f9d0, 0x1f9ff}, {0x1fa60, 0x1fa6d}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d},
{0xe0100, 0xe01ef}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde,
0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
#if TCL_UTF_MAX > 4
0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87,
0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7,
0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d,
0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41,
0xfb43, 0xfb44, 0xfffc, 0xfffd
#if CHRBITS > 16
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x11d08, 0x11d09,
0x11d3a, 0x11d3c, 0x11d3d, 0x16a6e, 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f,
0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f,
0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x1145e, 0x118ff, 0x11d08,
0x11d09, 0x11d3a, 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e,
0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f97a
#endif
};
+1 -1
View File
@@ -91,7 +91,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */
#if TCL_UTF_MAX > 4
#define CHRBITS 32 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */
#define CHR_MAX 0xffffffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
#define CHR_MAX 0x10ffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
#else
#define CHRBITS 16 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x0000 /* Smallest and largest chr; the value */
+144 -129
View File
@@ -32,7 +32,7 @@ declare 0 {
const char *version, const void *clientData)
}
declare 1 {
CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
void *clientDataPtr)
}
@@ -104,9 +104,10 @@ declare 20 {
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
declare 22 {
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 22 {
# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
#}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
const char *file, int line)
@@ -119,9 +120,10 @@ declare 25 {
Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line)
}
declare 26 {
Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 26 {
# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
#}
declare 27 {
Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
@@ -154,7 +156,7 @@ declare 35 {
}
declare 36 {
int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
}
declare 37 {
int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
@@ -166,7 +168,7 @@ declare 39 {
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
@@ -198,33 +200,37 @@ declare 48 {
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
declare 49 {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
# Removed in 9.0 (changed to macro):
#declare 49 {
# Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
#}
declare 50 {
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
declare 52 {
Tcl_Obj *Tcl_NewIntObj(int intValue)
}
# Removed in 9.0 (changed to macro):
#declare 52 {
# Tcl_Obj *Tcl_NewIntObj(int intValue)
#}
declare 53 {
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
declare 54 {
Tcl_Obj *Tcl_NewLongObj(long longValue)
}
# Removed in 9.0 (changed to macro):
#declare 54 {
# Tcl_Obj *Tcl_NewLongObj(long longValue)
#}
declare 55 {
Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
declare 57 {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
#}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
@@ -235,15 +241,17 @@ declare 59 {
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
declare 61 {
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
# Removed in 9.0 (changed to macro):
#declare 61 {
# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
#}
declare 62 {
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
declare 63 {
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
}
# Removed in 9.0 (changed to macro):
#declare 63 {
# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
#}
declare 64 {
void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
@@ -285,9 +293,10 @@ declare 75 {
declare 76 {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
declare 77 {
char Tcl_Backslash(const char *src, int *readPtr)
}
# Removed in 9.0:
#declare 77 {deprecated {Use Tcl_UtfBackslash}} {
# char Tcl_Backslash(const char *src, int *readPtr)
#}
declare 78 {
int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
const char *optionList)
@@ -306,7 +315,7 @@ declare 82 {
int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
char *Tcl_Concat(int argc, CONST84 char *const *argv)
char *Tcl_Concat(int argc, const char *const *argv)
}
declare 84 {
int Tcl_ConvertElement(const char *src, char *dst, int flags)
@@ -318,7 +327,7 @@ declare 85 {
declare 86 {
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
Tcl_Interp *target, const char *targetCmd, int argc,
CONST84 char *const *argv)
const char *const *argv)
}
declare 87 {
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
@@ -352,11 +361,12 @@ declare 93 {
declare 94 {
Tcl_Interp *Tcl_CreateInterp(void)
}
declare 95 {
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
int numArgs, Tcl_ValueType *argTypes,
Tcl_MathProc *proc, ClientData clientData)
}
# Removed in 9.0:
#declare 95 {deprecated {}} {
# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
# int numArgs, Tcl_ValueType *argTypes,
# Tcl_MathProc *proc, ClientData clientData)
#}
declare 96 {
Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
const char *cmdName,
@@ -461,21 +471,21 @@ declare 126 {
int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
CONST84_RETURN char *Tcl_ErrnoId(void)
const char *Tcl_ErrnoId(void)
}
declare 128 {
CONST84_RETURN char *Tcl_ErrnoMsg(int err)
const char *Tcl_ErrnoMsg(int err)
}
declare 129 {
int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
# This is obsolete, use Tcl_FSEvalFile
declare 130 {
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
declare 131 {
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
# Removed in 9.0, replaced by macro.
#declare 131 {
# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
@@ -529,12 +539,12 @@ declare 147 {
}
declare 148 {
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *argcPtr, CONST84 char ***argvPtr)
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *argcPtr, const char ***argvPtr)
}
declare 149 {
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
@@ -559,28 +569,28 @@ declare 155 {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
const char *Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 {
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
const char *optionName, Tcl_DString *dsPtr)
}
declare 158 {
CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 {
int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
Tcl_CmdInfo *infoPtr)
}
declare 160 {
CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
const char *Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command)
}
declare 161 {
int Tcl_GetErrno(void)
}
declare 162 {
CONST84_RETURN char *Tcl_GetHostName(void)
const char *Tcl_GetHostName(void)
}
declare 163 {
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
@@ -623,22 +633,23 @@ declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 {
CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
const char *Tcl_GetStringResult(Tcl_Interp *interp)
}
declare 175 {
CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
int flags)
}
declare 176 {
CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags)
}
declare 177 {
int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
}
declare 178 {
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
# Removed in 9.0, replaced by macro.
#declare 178 {
# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 179 {
int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
const char *hiddenCmdToken)
@@ -663,7 +674,7 @@ declare 185 {
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
char *Tcl_JoinPath(int argc, const char *const *argv,
Tcl_DString *resultPtr)
}
declare 187 {
@@ -686,7 +697,7 @@ declare 191 {
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
char *Tcl_Merge(int argc, CONST84 char *const *argv)
char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
@@ -704,7 +715,7 @@ declare 196 {
}
declare 197 {
Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
CONST84 char **argv, int flags)
const char **argv, int flags)
}
# This is obsolete, use Tcl_FSOpenFileChannel
declare 198 {
@@ -730,7 +741,7 @@ declare 203 {
int Tcl_PutEnv(const char *assignment)
}
declare 204 {
CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
@@ -766,7 +777,7 @@ declare 214 {
}
declare 215 {
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
CONST84 char **startPtr, CONST84 char **endPtr)
const char **startPtr, const char **endPtr)
}
declare 216 {
void Tcl_Release(ClientData clientData)
@@ -780,10 +791,10 @@ declare 218 {
declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 {
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
# Removed in 9.0:
#declare 220 {
# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
declare 221 {
int Tcl_ServiceAll(void)
}
@@ -837,29 +848,29 @@ declare 236 {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
declare 237 {
CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
const char *newValue, int flags)
}
declare 238 {
CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue, int flags)
}
declare 239 {
CONST84_RETURN char *Tcl_SignalId(int sig)
const char *Tcl_SignalId(int sig)
}
declare 240 {
CONST84_RETURN char *Tcl_SignalMsg(int sig)
const char *Tcl_SignalMsg(int sig)
}
declare 241 {
void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
CONST84 char ***argvPtr)
const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
@@ -868,10 +879,10 @@ declare 244 {
declare 245 {
int Tcl_StringMatch(const char *str, const char *pattern)
}
# Obsolete
declare 246 {
int Tcl_TellOld(Tcl_Channel chan)
}
# Removed in 9.0:
#declare 246 {
# int Tcl_TellOld(Tcl_Channel chan)
#}
declare 247 {
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
@@ -945,11 +956,11 @@ declare 265 {
declare 266 {
void Tcl_ValidateAllMemory(const char *file, int line)
}
# Removed in 9.0
# Removed in 9.0:
#declare 267 {
# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0
# Removed in 9.0:
#declare 268 {
# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
#}
@@ -957,15 +968,15 @@ declare 269 {
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
CONST84 char **termPtr)
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr)
}
declare 271 {
CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
declare 272 {
CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
void *clientDataPtr)
}
@@ -975,21 +986,21 @@ declare 273 {
}
# TIP #268: The internally used new Require function is in slot 573.
declare 274 {
CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
# Removed in 9.0
# Removed in 9.0:
#declare 275 {
# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0
# Removed in 9.0:
#declare 276 {
# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
#}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
# Removed in 9.0
# Removed in 9.0:
#declare 278 {
# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
#}
@@ -1092,7 +1103,7 @@ declare 301 {
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
@@ -1153,22 +1164,22 @@ declare 319 {
Tcl_QueuePosition position)
}
declare 320 {
Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index)
int Tcl_UniCharAtIndex(const char *src, int index)
}
declare 321 {
Tcl_UniChar Tcl_UniCharToLower(int ch)
int Tcl_UniCharToLower(int ch)
}
declare 322 {
Tcl_UniChar Tcl_UniCharToTitle(int ch)
int Tcl_UniCharToTitle(int ch)
}
declare 323 {
Tcl_UniChar Tcl_UniCharToUpper(int ch)
int Tcl_UniCharToUpper(int ch)
}
declare 324 {
int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
const char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
int Tcl_UtfCharComplete(const char *src, int length)
@@ -1177,16 +1188,16 @@ declare 327 {
int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
CONST84_RETURN char *Tcl_UtfNext(const char *src)
const char *Tcl_UtfNext(const char *src)
}
declare 331 {
CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
@@ -1219,12 +1230,14 @@ declare 339 {
declare 340 {
char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 {
CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
}
declare 342 {
void Tcl_SetDefaultEncodingDir(const char *path)
}
# Removed in 9.0:
#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
# const char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0:
#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
# void Tcl_SetDefaultEncodingDir(const char *path)
#}
declare 343 {
void Tcl_AlertNotifier(ClientData clientData)
}
@@ -1271,10 +1284,11 @@ declare 356 {
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
int flags)
}
declare 357 {
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
# Removed in 9.0:
#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
# int count)
#}
declare 358 {
void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
@@ -1284,7 +1298,7 @@ declare 359 {
}
declare 360 {
int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
Tcl_Parse *parsePtr, int append, const char **termPtr)
}
declare 361 {
int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
@@ -1297,7 +1311,7 @@ declare 362 {
declare 363 {
int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
int numBytes, Tcl_Parse *parsePtr, int append,
CONST84 char **termPtr)
const char **termPtr)
}
declare 364 {
int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
@@ -1356,7 +1370,7 @@ declare 380 {
int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
declare 382 {
Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
@@ -1413,7 +1427,7 @@ declare 397 {
int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 {
CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
}
declare 399 {
Tcl_ChannelTypeVersion Tcl_ChannelVersion(
@@ -1498,13 +1512,15 @@ declare 420 {
int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase)
}
declare 421 {
Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
}
declare 422 {
Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr)
}
# Removed in 9.0, as it is actually a macro:
#declare 421 {
# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
#}
# Removed in 9.0, as it is actually a macro:
#declare 422 {
# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
# const void *key, int *newPtr)
#}
declare 423 {
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
const Tcl_HashKeyType *typePtr)
@@ -1553,14 +1569,16 @@ declare 434 {
}
# TIP#15 (math function introspection) dkf
declare 435 {
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 {
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}
# Removed in 9.0:
#declare 435 {deprecated {}} {
# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
# int *numArgsPtr, Tcl_ValueType **argTypesPtr,
# Tcl_MathProc **procPtr, ClientData *clientDataPtr)
#}
# Removed in 9.0:
#declare 436 {deprecated {}} {
# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}
# TIP#36 (better access to 'subst') dkf
declare 437 {
@@ -1622,7 +1640,7 @@ declare 452 {
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
}
declare 453 {
const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef)
}
declare 454 {
@@ -1700,7 +1718,7 @@ declare 476 {
Tcl_Obj *pathPtr)
}
declare 477 {
CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
}
declare 478 {
Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
@@ -2383,9 +2401,6 @@ declare 1 macosx {
# Public functions that are not accessible via the stubs table.
export {
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact)
+59 -230
View File
@@ -60,22 +60,7 @@ extern "C" {
#define TCL_VERSION "9.0"
#define TCL_PATCH_LEVEL "9.0a0"
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
*----------------------------------------------------------------------------
* The following definitions set up the proper options for Windows compilers.
* We use this method because there is no autoconf equivalent.
*/
#ifdef _WIN32
# ifndef __WIN32__
# define __WIN32__
# endif
# ifndef WIN32
# define WIN32
# endif
#endif
#if defined(RC_INVOKED)
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
* quotation marks), JOIN joins two arguments.
@@ -89,7 +74,7 @@ extern "C" {
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#endif
#endif /* !TCL_NO_DEPRECATED */
#endif /* RC_INVOKED */
/*
* A special definition used to allow this header file to be included from
@@ -125,20 +110,11 @@ extern "C" {
#include <stdio.h>
#ifndef TCL_NO_DEPRECATED
# define TCL_VARARGS(type, name) (type name, ...)
# define TCL_VARARGS_DEF(type, name) (type name, ...)
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#endif /* !TCL_NO_DEPRECATED */
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
# define TCL_NORETURN __attribute__ ((noreturn))
# define TCL_NOINLINE __attribute__ ((noinline))
# if defined(BUILD_tcl) || defined(BUILD_tk)
# define TCL_NORETURN1 __attribute__ ((noreturn))
# else
# define TCL_NORETURN1 /* nothing */
# endif
# define TCL_NORETURN1 __attribute__ ((noreturn))
#else
# define TCL_FORMAT_PRINTF(a,b)
# if defined(_MSC_VER) && (_MSC_VER >= 1310)
@@ -213,7 +189,7 @@ extern "C" {
* to be included in a shared library, then it should have the DLLEXPORT
* storage class. If is being declared for use by a module that is going to
* link against the shared library, then it should have the DLLIMPORT storage
* class. If the symbol is beind declared for a static build or for use from a
* class. If the symbol is being declared for a static build or for use from a
* stub library, then the storage class should be empty.
*
* The convention is that a macro called BUILD_xxxx, where xxxx is the name of
@@ -234,55 +210,8 @@ extern "C" {
# endif
#endif
/*
* The following _ANSI_ARGS_ macro is to support old extensions
* written for older versions of Tcl where it permitted support
* for compilers written in the pre-prototype era of C.
*
* New code should use prototypes.
*/
#ifndef TCL_NO_DEPRECATED
# undef _ANSI_ARGS_
# define _ANSI_ARGS_(x) x
#endif /* !TCL_NO_DEPRECATED */
/*
* Definitions that allow this header file to be used either with or without
* ANSI C features.
*/
#ifndef INLINE
# define INLINE
#endif
#ifdef NO_CONST
# ifndef const
# define const
# endif
#endif
#ifndef CONST
# define CONST const
#endif
#ifdef USE_NON_CONST
# ifdef USE_COMPAT_CONST
# error define at most one of USE_NON_CONST and USE_COMPAT_CONST
# endif
# define CONST84
# define CONST84_RETURN
#else
# ifdef USE_COMPAT_CONST
# define CONST84
# define CONST84_RETURN const
# else
# define CONST84 const
# define CONST84_RETURN const
# endif
#endif
#ifndef CONST86
# define CONST86 CONST84
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
# define CONST86 const
#endif
/*
@@ -299,47 +228,11 @@ extern "C" {
# define EXTERN extern TCL_STORAGE_CLASS
#endif
/*
*----------------------------------------------------------------------------
* The following code is copied from winnt.h. If we don't replicate it here,
* then <windows.h> can't be included after tcl.h, since tcl.h also defines
* VOID. This block is skipped under Cygwin and Mingw.
*/
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
/*
* Macro to use instead of "void" for arguments that must have type "void *"
* in ANSI C; maps them to type "char *" in non-ANSI systems.
*/
#ifndef __VXWORKS__
# ifndef NO_VOID
# define VOID void
# else
# define VOID char
# endif
#endif
/*
* Miscellaneous declarations.
*/
#ifndef _CLIENTDATA
# ifndef NO_VOID
typedef void *ClientData;
# else
typedef int *ClientData;
# endif
# define _CLIENTDATA
#endif
typedef void *ClientData;
/*
* Darwin specific configure overrides (to support fat compiles, where
@@ -384,44 +277,40 @@ typedef long LONG;
# if defined(_WIN32)
# define TCL_WIDE_INT_TYPE __int64
# define TCL_LL_MODIFIER "I64"
# if defined(_WIN64)
# define TCL_Z_MODIFIER "I"
# endif
# elif defined(__GNUC__)
# define TCL_WIDE_INT_TYPE long long
# define TCL_LL_MODIFIER "ll"
# define TCL_Z_MODIFIER "z"
# else /* ! _WIN32 && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
*/
# include <limits.h>
# if (INT_MAX < LONG_MAX)
# if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
# define TCL_WIDE_INT_IS_LONG 1
# else
# define TCL_WIDE_INT_TYPE long long
# endif
# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
# undef TCL_WIDE_INT_TYPE
# define TCL_WIDE_INT_TYPE long
#endif /* TCL_WIDE_INT_IS_LONG */
#ifndef TCL_WIDE_INT_TYPE
# define TCL_WIDE_INT_TYPE long long
#endif /* !TCL_WIDE_INT_TYPE */
typedef TCL_WIDE_INT_TYPE Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
#ifdef TCL_WIDE_INT_IS_LONG
# ifndef TCL_LL_MODIFIER
# define TCL_LL_MODIFIER "l"
# endif /* !TCL_LL_MODIFIER */
#else /* TCL_WIDE_INT_IS_LONG */
/*
* The next short section of defines are only done when not running on Windows
* or some other strange platform.
*/
# ifndef TCL_LL_MODIFIER
# define TCL_LL_MODIFIER "ll"
# endif /* !TCL_LL_MODIFIER */
#endif /* TCL_WIDE_INT_IS_LONG */
#ifndef TCL_LL_MODIFIER
# define TCL_LL_MODIFIER "ll"
#endif /* !TCL_LL_MODIFIER */
#ifndef TCL_Z_MODIFIER
# if defined(__GNUC__) && !defined(_WIN32)
# define TCL_Z_MODIFIER "z"
# else
# define TCL_Z_MODIFIER ""
# endif
#endif /* !TCL_Z_MODIFIER */
#define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
@@ -639,22 +528,6 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_SUBST_BACKSLASHES 004
#define TCL_SUBST_ALL 007
/*
* Argument descriptors for math function callbacks in expressions:
*/
typedef enum {
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;
typedef struct Tcl_Value {
Tcl_ValueType type; /* Indicates intValue or doubleValue is valid,
* or both. */
long intValue; /* Integer value. */
double doubleValue; /* Double-precision floating value. */
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
} Tcl_Value;
/*
* Forward declaration of Tcl_Obj to prevent an error when the forward
* reference to Tcl_Obj is encountered in the function types declared below.
@@ -674,10 +547,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
typedef void (Tcl_CloseProc) (ClientData data);
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
int level, char *command, Tcl_CmdProc *proc,
ClientData cmdClientData, int argc, CONST84 char *argv[]);
ClientData cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
int level, const char *command, Tcl_Command commandInfo, int objc,
struct Tcl_Obj *const *objv);
@@ -700,8 +573,6 @@ typedef void (Tcl_FreeProc) (char *blockPtr);
typedef void (Tcl_IdleProc) (ClientData clientData);
typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
Tcl_Interp *interp);
typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
Tcl_Value *args, Tcl_Value *resultPtr);
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
int objc, struct Tcl_Obj *const *objv);
@@ -714,7 +585,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
CONST84 char *part1, CONST84 char *part2, int flags);
const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
@@ -942,14 +813,11 @@ typedef struct Tcl_DString {
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
#ifndef TCL_NO_DEPRECATED
# define Tcl_DStringTrunc Tcl_DStringSetLength
#endif /* !TCL_NO_DEPRECATED */
/*
* Definitions for the maximum number of digits of precision that may be
* specified in the "tcl_precision" variable, and the number of bytes of
* buffer space required by Tcl_PrintDouble.
* produced by Tcl_PrintDouble, and the number of bytes of buffer space
* required by Tcl_PrintDouble.
*/
#define TCL_MAX_PREC 17
@@ -1063,17 +931,6 @@ typedef struct Tcl_DString {
#define TCL_ALLOW_INLINE_COMPILATION 0x20000
/*
* The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
* always parsed whenever the part2 is NULL. (This is to avoid a common error
* when converting code to use the new object based APIs and forgetting to
* give the flag)
*/
#ifndef TCL_NO_DEPRECATED
# define TCL_PARSE_PART1 0x400
#endif /* !TCL_NO_DEPRECATED */
/*
* Types for linked variables:
*/
@@ -1127,9 +984,7 @@ struct Tcl_HashEntry {
Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket,
* or NULL for end of chain. */
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
void *hash; /* Hash value, stored as pointer to ensure
* that the offsets of the fields in this
* structure are not changed. */
unsigned int hash; /* Hash value. */
ClientData clientData; /* Application stores something here with
* Tcl_SetHashValue. */
union { /* Key has one of these forms: */
@@ -1224,10 +1079,10 @@ struct Tcl_HashTable {
* table. */
int rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
unsigned int mask; /* Mask value used in hashing function. */
int downShift; /* Shift count used in hashing function.
* Designed to use high-order bits of
* randomized keys. */
int mask; /* Mask value used in hashing function. */
int keyType; /* Type of keys used in this table. It's
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
* TCL_ONE_WORD_KEYS, or an integer giving the
@@ -1348,8 +1203,8 @@ typedef struct Tcl_Time {
long usec; /* Microseconds. */
} Tcl_Time;
typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
/*
* TIP #233 (Virtualized Time)
@@ -1423,14 +1278,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData,
typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf,
int toRead, int *errorCodePtr);
typedef int (Tcl_DriverOutputProc) (ClientData instanceData,
CONST84 char *buf, int toWrite, int *errorCodePtr);
const char *buf, int toWrite, int *errorCodePtr);
typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset,
int mode, int *errorCodePtr);
typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData,
Tcl_Interp *interp, const char *optionName,
const char *value);
typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData,
Tcl_Interp *interp, CONST84 char *optionName,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask);
typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData,
@@ -1621,7 +1476,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
int nextCheckpoint);
typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef);
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
@@ -2146,7 +2001,7 @@ typedef struct Tcl_EncodingType {
*/
#ifndef TCL_UTF_MAX
#define TCL_UTF_MAX 3
#define TCL_UTF_MAX 4
#endif
/*
@@ -2336,10 +2191,10 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
/*
*----------------------------------------------------------------------------
* The following constant is used to test for older versions of Tcl in the
* stubs tables.
* stubs tables. If TCL_UTF_MAX>4 use a different value.
*/
#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
#define TCL_STUB_MAGIC ((int) 0xFCA3BACF + (TCL_UTF_MAX>4))
/*
* The following function is required to be defined in all stubs aware
@@ -2354,14 +2209,27 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
#ifdef USE_TCL_STUBS
#define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
TCL_STUB_MAGIC)
#else
#define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \
1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
TCL_STUB_MAGIC)
#endif
#else
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
# define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#else
# define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, TCL_PATCH_LEVEL, \
1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#endif
#endif
/*
@@ -2489,15 +2357,9 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# undef Tcl_NewDoubleObj
# define Tcl_NewDoubleObj(val) \
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
# undef Tcl_NewIntObj
# define Tcl_NewIntObj(val) \
Tcl_DbNewLongObj(val, __FILE__, __LINE__)
# undef Tcl_NewListObj
# define Tcl_NewListObj(objc, objv) \
Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
# undef Tcl_NewLongObj
# define Tcl_NewLongObj(val) \
Tcl_DbNewLongObj(val, __FILE__, __LINE__)
# undef Tcl_NewObj
# define Tcl_NewObj() \
Tcl_DbNewObj(__FILE__, __LINE__)
@@ -2527,10 +2389,8 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
* hash tables:
*/
#undef Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#undef Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
@@ -2555,37 +2415,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#define Tcl_ConditionFinalize(condPtr)
#endif /* TCL_THREADS */
/*
*----------------------------------------------------------------------------
* Deprecated Tcl functions:
*/
#ifndef TCL_NO_DEPRECATED
/*
* These function have been renamed. The old names are deprecated, but we
* define these macros for backwards compatibilty.
*/
# define Tcl_Ckalloc Tcl_Alloc
# define Tcl_Ckfree Tcl_Free
# define Tcl_Ckrealloc Tcl_Realloc
# define Tcl_Return Tcl_SetResult
# define Tcl_TildeSubst Tcl_TranslateFileName
#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */
# define panic Tcl_Panic
#endif
/*
*----------------------------------------------------------------------------
* Convenience declaration of Tcl_AppInit for backwards compatibility. This
* function is not *implemented* by the tcl library, so the storage class is
* neither DLLEXPORT nor DLLIMPORT.
*/
extern Tcl_AppInitProc Tcl_AppInit;
#endif /* !TCL_NO_DEPRECATED */
#endif /* RC_INVOKED */
/*
+5 -5
View File
@@ -661,14 +661,14 @@ mstats(
fprintf(stderr, "\nused:\t");
for (i = 0; i < NBUCKETS; i++) {
fprintf(stderr, " %" TCL_LL_MODIFIER "d", (Tcl_WideInt)numMallocs[i]);
fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
totalUsed += numMallocs[i] * (1 << (i + 3));
}
fprintf(stderr, "\n\tTotal small in use: %" TCL_LL_MODIFIER "d, total free: %" TCL_LL_MODIFIER "d\n",
(Tcl_WideInt)totalUsed, (Tcl_WideInt)totalFree);
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_LL_MODIFIER "d\n",
MAXMALLOC, (Tcl_WideInt)numMallocs[NBUCKETS]);
fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
totalUsed, totalFree);
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
MAXMALLOC, numMallocs[NBUCKETS]);
Tcl_MutexUnlock(allocMutexPtr);
}
+13 -14
View File
@@ -406,7 +406,6 @@ static const TalInstDesc TalInstructionTable[] = {
{"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0},
{"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0},
{"label", ASSEM_LABEL, 0, 0, 0},
{"land", ASSEM_1BYTE, INST_LAND, 2, 1},
{"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8
| INST_LAPPEND_SCALAR4),
1, 1},
@@ -434,7 +433,6 @@ static const TalInstDesc TalInstructionTable[] = {
| INST_LOAD_ARRAY4), 1, 1},
{"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
{"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1},
{"lor", ASSEM_1BYTE, INST_LOR, 2, 1},
{"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1},
{"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
{"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1},
@@ -2246,23 +2244,24 @@ GetListIndexOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
Tcl_Obj *value;
int status;
/*
* Extract the next token as a string.
*/
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
/* General operand validity check */
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
return TCL_ERROR;
}
/* Convert to an integer, advance to the next token and return. */
/*
* Convert to an integer, advance to the next token and return.
* NOTE: Indexing a list with an index before it yields the
* same result as indexing after it, and might be more easily portable
* when list size limits grow.
*/
status = TclIndexEncode(interp, value,
TCL_INDEX_BEFORE,TCL_INDEX_BEFORE, result);
status = TclGetIntForIndex(interp, intObj, -2, result);
Tcl_DecrRefCount(intObj);
Tcl_DecrRefCount(value);
*tokenPtrPtr = TokenAfter(tokenPtr);
return status;
}
@@ -4266,7 +4265,7 @@ AddBasicBlockRangeToErrorInfo(
Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
TclSetLongObj(lineNo, bbPtr->successor1->startLine);
TclSetIntObj(lineNo, bbPtr->successor1->startLine);
Tcl_AppendObjToErrorInfo(interp, lineNo);
} else {
Tcl_AddErrorInfo(interp, "end of assembly code");
+177 -558
View File
@@ -37,18 +37,6 @@
# define MAX_EXACT 9007199254740991.0
#endif
/*
* The following structure defines the client data for a math function
* registered with Tcl_CreateMathFunc
*/
typedef struct OldMathFuncData {
Tcl_MathProc *proc; /* Handler function */
int numArgs; /* Number of args expected */
Tcl_ValueType *argTypes; /* Types of the args */
ClientData clientData; /* Client data for the handler function */
} OldMathFuncData;
/*
* This is the script cancellation struct and hash table. The hash table is
* used to keep track of the information necessary to process script
@@ -118,6 +106,8 @@ static Tcl_ObjCmdProc ExprEntierFunc;
static Tcl_ObjCmdProc ExprFloorFunc;
static Tcl_ObjCmdProc ExprIntFunc;
static Tcl_ObjCmdProc ExprIsqrtFunc;
static Tcl_ObjCmdProc ExprMaxFunc;
static Tcl_ObjCmdProc ExprMinFunc;
static Tcl_ObjCmdProc ExprRandFunc;
static Tcl_ObjCmdProc ExprRoundFunc;
static Tcl_ObjCmdProc ExprSqrtFunc;
@@ -130,8 +120,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
static void ProcessUnexpectedResult(Tcl_Interp *interp,
int returnCode);
static int RewindCoroutine(CoroutineData *corPtr, int result);
@@ -203,9 +191,6 @@ static const CmdInfo builtInCmds[] = {
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
#ifndef TCL_NO_DEPRECATED
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
{"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
@@ -234,7 +219,7 @@ static const CmdInfo builtInCmds[] = {
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
{"package", Tcl_PackageObjCmd, NULL, NULL, CMD_IS_SAFE},
{"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE},
{"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE},
{"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE},
@@ -321,6 +306,8 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "isqrt", ExprIsqrtFunc, NULL },
{ "log", ExprUnaryFunc, (ClientData) log },
{ "log10", ExprUnaryFunc, (ClientData) log10 },
{ "max", ExprMaxFunc, NULL },
{ "min", ExprMinFunc, NULL },
{ "pow", ExprBinaryFunc, (ClientData) pow },
{ "rand", ExprRandFunc, NULL },
{ "round", ExprRoundFunc, NULL },
@@ -523,8 +510,7 @@ Tcl_CreateInterp(void)
iPtr->hiddenCmdTablePtr = NULL;
iPtr->interpInfo = NULL;
TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
iPtr->extra.optimizer = TclOptimizeBytecode;
iPtr->optimizer = TclOptimizeBytecode;
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
@@ -797,6 +783,7 @@ Tcl_CreateInterp(void)
TclInitNamespaceCmd(interp);
TclInitStringCmd(interp);
TclInitPrefixCmd(interp);
TclInitProcessCmd(interp);
/*
* Register "clock" subcommands. These *do* go through
@@ -934,9 +921,6 @@ Tcl_CreateInterp(void)
Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
TclpSetVariables(interp);
#ifdef TCL_THREADS
@@ -2075,13 +2059,13 @@ Tcl_CreateCommand(
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
if (isNew || deleted) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
}
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
@@ -2222,64 +2206,82 @@ Tcl_CreateObjCommand(
* name. */
ClientData clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
Tcl_CmdDeleteProc *deleteProc
/* If not NULL, gives a function to call when
* this command is deleted. */
)
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
Namespace *nsPtr;
Command *cmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
int isNew = 0, deleted = 0;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
/*
* The interpreter is being deleted. Don't create any new commands;
* it's not safe to muck with the interpreter anymore.
*/
return (Tcl_Command) NULL;
}
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
*/
if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
proc, clientData, deleteProc);
}
Tcl_Command
TclCreateObjCommandInNs (
Tcl_Interp *interp,
const char *cmdName, /* Name of command, without any namespace components */
Tcl_Namespace *namespace, /* The namespace to create the command in */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
ClientData clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc
/* If not NULL, gives a function to call when
* this command is deleted. */
) {
int deleted = 0, isNew = 0;
Command *cmdPtr;
ImportRef *oldRefPtr = NULL;
ImportedCmdData *dataPtr;
Tcl_HashEntry *hPtr;
Namespace *nsPtr = (Namespace *) namespace;
/*
* If the command name we seek to create already exists, we need to
* delete that first. That can be tricky in the presence of traces.
* Loop until we no longer find an existing command in the way, or
* until we've deleted one command and that didn't finish the job.
*/
while (1) {
/*
* Determine where the command should reside. If its name contains
* namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
*/
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
if (isNew || deleted) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
}
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
@@ -2313,7 +2315,13 @@ Tcl_CreateObjCommand(
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
/* Make sure namespace doesn't get deallocated. */
cmdPtr->nsPtr->refCount++;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
nsPtr = (Namespace *) TclEnsureNamespace(interp,
(Tcl_Namespace *)cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
oldRefPtr = cmdPtr->importRefPtr;
@@ -2322,7 +2330,6 @@ Tcl_CreateObjCommand(
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
@@ -2344,7 +2351,7 @@ Tcl_CreateObjCommand(
* commands.
*/
TclInvalidateCmdLiteral(interp, tail, nsPtr);
TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
/*
* The list of command exported from the namespace might have changed.
@@ -2567,10 +2574,6 @@ TclRenameCommand(
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
return TCL_ERROR;
}
cmdNsPtr = cmdPtr->nsPtr;
oldFullName = Tcl_NewObj();
Tcl_IncrRefCount(oldFullName);
Tcl_GetCommandFullName(interp, cmd, oldFullName);
/*
* If the new command name is NULL or empty, delete the command. Do this
@@ -2579,10 +2582,14 @@ TclRenameCommand(
if ((newName == NULL) || (*newName == '\0')) {
Tcl_DeleteCommandFromToken(interp, cmd);
result = TCL_OK;
goto done;
return TCL_OK;
}
cmdNsPtr = cmdPtr->nsPtr;
oldFullName = Tcl_NewObj();
Tcl_IncrRefCount(oldFullName);
Tcl_GetCommandFullName(interp, cmd, oldFullName);
/*
* Make sure that the destination command does not already exist. The
* rename operation is like creating a command, so we should automatically
@@ -3094,6 +3101,8 @@ Tcl_DeleteCommandFromToken(
* traces.
*/
cmdPtr->nsPtr->refCount++;
if (cmdPtr->tracePtr != NULL) {
CommandTrace *tracePtr;
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
@@ -3121,6 +3130,7 @@ Tcl_DeleteCommandFromToken(
*/
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
/*
* If the command being deleted has a compile function, increment the
@@ -3436,359 +3446,6 @@ TclCleanupCommand(
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateMathFunc --
*
* Creates a new math function for expressions in a given interpreter.
*
* Results:
* None.
*
* Side effects:
* The Tcl function defined by "name" is created or redefined. If the
* function already exists then its definition is replaced; this includes
* the builtin functions. Redefining a builtin function forces all
* existing code to be invalidated since that code may be compiled using
* an instruction specific to the replaced function. In addition,
* redefioning a non-builtin function will force existing code to be
* invalidated if the number of arguments has changed.
*
*----------------------------------------------------------------------
*/
void
Tcl_CreateMathFunc(
Tcl_Interp *interp, /* Interpreter in which function is to be
* available. */
const char *name, /* Name of function (e.g. "sin"). */
int numArgs, /* Nnumber of arguments required by
* function. */
Tcl_ValueType *argTypes, /* Array of types acceptable for each
* argument. */
Tcl_MathProc *proc, /* C function that implements the math
* function. */
ClientData clientData) /* Additional value to pass to the
* function. */
{
Tcl_DString bigName;
OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
data->proc = proc;
data->numArgs = numArgs;
data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
data->clientData = clientData;
Tcl_DStringInit(&bigName);
TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
Tcl_DStringAppend(&bigName, name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
OldMathFuncProc, data, OldMathFuncDeleteProc);
Tcl_DStringFree(&bigName);
}
/*
*----------------------------------------------------------------------
*
* OldMathFuncProc --
*
* Dispatch to a math function created with Tcl_CreateMathFunc
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* Whatever the math function does.
*
*----------------------------------------------------------------------
*/
static int
OldMathFuncProc(
ClientData clientData, /* Ponter to OldMathFuncData describing the
* function being called */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Parameter vector */
{
Tcl_Obj *valuePtr;
OldMathFuncData *dataPtr = clientData;
Tcl_Value funcResult, *args;
int result;
int j, k;
double d;
/*
* Check argument count.
*/
if (objc != dataPtr->numArgs + 1) {
MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
return TCL_ERROR;
}
/*
* Convert arguments from Tcl_Obj's to Tcl_Value's.
*/
args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
/* TODO: Convert to TclGetNumberFromObj? */
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
d = valuePtr->internalRep.doubleValue;
result = TCL_OK;
}
#endif
if (result != TCL_OK) {
/*
* We have a non-numeric argument.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
ckfree(args);
return TCL_ERROR;
}
/*
* Copy the object's numeric value to the argument record, converting
* it if necessary.
*
* NOTE: no bignum support; use the new mathfunc interface for that.
*/
args[k].type = dataPtr->argTypes[k];
switch (args[k].type) {
case TCL_EITHER:
if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue)
== TCL_OK) {
args[k].type = TCL_INT;
break;
}
if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
== TCL_OK) {
args[k].type = TCL_WIDE_INT;
break;
}
args[k].type = TCL_DOUBLE;
/* FALLTHROUGH */
case TCL_DOUBLE:
args[k].doubleValue = d;
break;
case TCL_INT:
if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
ckfree(args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue);
Tcl_ResetResult(interp);
break;
case TCL_WIDE_INT:
if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
ckfree(args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
Tcl_ResetResult(interp);
break;
}
}
/*
* Call the function.
*/
errno = 0;
result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
ckfree(args);
if (result != TCL_OK) {
return result;
}
/*
* Return the result of the call.
*/
if (funcResult.type == TCL_INT) {
TclNewLongObj(valuePtr, funcResult.intValue);
} else if (funcResult.type == TCL_WIDE_INT) {
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
} else {
return CheckDoubleResult(interp, funcResult.doubleValue);
}
Tcl_SetObjResult(interp, valuePtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* OldMathFuncDeleteProc --
*
* Cleans up after deleting a math function registered with
* Tcl_CreateMathFunc
*
* Results:
* None.
*
* Side effects:
* Frees allocated memory.
*
*----------------------------------------------------------------------
*/
static void
OldMathFuncDeleteProc(
ClientData clientData)
{
OldMathFuncData *dataPtr = clientData;
ckfree(dataPtr->argTypes);
ckfree(dataPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetMathFuncInfo --
*
* Discovers how a particular math function was created in a given
* interpreter.
*
* Results:
* TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
* interpreter result if that happens.)
*
* Side effects:
* If this function succeeds, the variables pointed to by the numArgsPtr
* and argTypePtr arguments will be updated to detail the arguments
* allowed by the function. The variable pointed to by the procPtr
* argument will be set to NULL if the function is a builtin function,
* and will be set to the address of the C function used to implement the
* math function otherwise (in which case the variable pointed to by the
* clientDataPtr argument will also be updated.)
*
*----------------------------------------------------------------------
*/
int
Tcl_GetMathFuncInfo(
Tcl_Interp *interp,
const char *name,
int *numArgsPtr,
Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr,
ClientData *clientDataPtr)
{
Tcl_Obj *cmdNameObj;
Command *cmdPtr;
/*
* Get the command that implements the math function.
*/
TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
Tcl_AppendToObj(cmdNameObj, name, -1);
Tcl_IncrRefCount(cmdNameObj);
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
Tcl_DecrRefCount(cmdNameObj);
/*
* Report unknown functions.
*/
if (cmdPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown math function \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
*numArgsPtr = -1;
*argTypesPtr = NULL;
*procPtr = NULL;
*clientDataPtr = NULL;
return TCL_ERROR;
}
/*
* Retrieve function info for user defined functions; return dummy
* information for builtins.
*/
if (cmdPtr->objProc == &OldMathFuncProc) {
OldMathFuncData *dataPtr = cmdPtr->clientData;
*procPtr = dataPtr->proc;
*numArgsPtr = dataPtr->numArgs;
*argTypesPtr = dataPtr->argTypes;
*clientDataPtr = dataPtr->clientData;
} else {
*procPtr = NULL;
*numArgsPtr = -1;
*argTypesPtr = NULL;
*procPtr = NULL;
*clientDataPtr = NULL;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ListMathFuncs --
*
* Produces a list of all the math functions defined in a given
* interpreter.
*
* Results:
* A pointer to a Tcl_Obj structure with a reference count of zero, or
* NULL in the case of an error (in which case a suitable error message
* will be left in the interpreter result.)
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_ListMathFuncs(
Tcl_Interp *interp,
const char *pattern)
{
Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
Tcl_Obj *result;
Tcl_InterpState state;
if (pattern) {
Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
Tcl_AppendObjToObj(script, arg);
Tcl_DecrRefCount(arg); /* Should tear down patternObj too */
}
state = Tcl_SaveInterpState(interp, TCL_OK);
Tcl_IncrRefCount(script);
if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
} else {
result = Tcl_NewObj();
}
Tcl_DecrRefCount(script);
Tcl_RestoreInterpState(interp, state);
return result;
}
/*
*----------------------------------------------------------------------
*
@@ -4531,7 +4188,7 @@ TEOV_Exception(
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
}
if ((result != TCL_ERROR) && !allowExceptions) {
if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
ProcessUnexpectedResult(interp, result);
result = TCL_ERROR;
}
@@ -4855,54 +4512,6 @@ Tcl_EvalTokensStandard(
NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_EvalTokens --
*
* Given an array of tokens parsed from a Tcl command (e.g., the tokens
* that make up a word or the index for an array variable) this function
* evaluates the tokens and concatenates their values to form a single
* result value.
*
* Results:
* The return value is a pointer to a newly allocated Tcl_Obj containing
* the value of the array of tokens. The reference count of the returned
* object has been incremented. If an error occurs in evaluating the
* tokens then a NULL value is returned and an error message is left in
* interp's result.
*
* Side effects:
* A new object is allocated to hold the result.
*
*----------------------------------------------------------------------
*
* This uses a non-standard return convention; its use is now deprecated. It
* is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
* in the core any longer. It is only kept for backward compatibility.
*/
Tcl_Obj *
Tcl_EvalTokens(
Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
Tcl_Obj *resPtr;
if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
return NULL;
}
resPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resPtr);
Tcl_ResetResult(interp);
return resPtr;
}
/*
*----------------------------------------------------------------------
*
@@ -5867,40 +5476,6 @@ Tcl_Eval(
{
return Tcl_EvalEx(interp, script, -1, 0);
}
/*
*----------------------------------------------------------------------
*
* Tcl_EvalObj, Tcl_GlobalEvalObj --
*
* These functions are deprecated but we keep them around for backwards
* compatibility reasons.
*
* Results:
* See the functions they call.
*
* Side effects:
* See the functions they call.
*
*----------------------------------------------------------------------
*/
#undef Tcl_EvalObj
int
Tcl_EvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
return Tcl_EvalObjEx(interp, objPtr, 0);
}
#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}
#endif /* TCL_NO_DEPRECATED */
/*
@@ -6397,7 +5972,6 @@ Tcl_ExprLongObj(
resultPtr = Tcl_NewBignumObj(&big);
/* FALLTHROUGH */
}
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
case TCL_NUMBER_BIG:
result = TclGetLongFromObj(interp, resultPtr, ptr);
@@ -6759,7 +6333,7 @@ Tcl_AddObjErrorInfo(
iPtr->flags |= ERR_LEGACY_COPY;
if (iPtr->errorInfo == NULL) {
iPtr->errorInfo = iPtr->objResultPtr;
iPtr->errorInfo = iPtr->objResultPtr;
Tcl_IncrRefCount(iPtr->errorInfo);
if (!iPtr->errorCode) {
Tcl_SetErrorCode(interp, "NONE", NULL);
@@ -7324,12 +6898,12 @@ ExprAbsFunc(
return TCL_ERROR;
}
if (type == TCL_NUMBER_LONG) {
long l = *((const long *) ptr);
if (type == TCL_NUMBER_WIDE) {
Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
if (l > (long)0) {
if (l > (Tcl_WideInt)0) {
goto unChanged;
} else if (l == (long)0) {
} else if (l == (Tcl_WideInt)0) {
const char *string = objv[1]->bytes;
if (string) {
while (*string != '0') {
@@ -7341,11 +6915,11 @@ ExprAbsFunc(
}
}
goto unChanged;
} else if (l == LONG_MIN) {
TclInitBignumFromLong(&big, l);
} else if (l == LLONG_MIN) {
TclInitBignumFromWideInt(&big, l);
goto tooLarge;
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
return TCL_OK;
}
@@ -7369,24 +6943,8 @@ ExprAbsFunc(
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (type == TCL_NUMBER_WIDE) {
Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
if (w >= (Tcl_WideInt)0) {
goto unChanged;
}
if (w == LLONG_MIN) {
TclInitBignumFromWideInt(&big, w);
goto tooLarge;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
return TCL_OK;
}
#endif
if (type == TCL_NUMBER_BIG) {
if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
if (mp_isneg((const mp_int *) ptr)) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
mp_neg(&big, &big);
@@ -7581,6 +7139,71 @@ ExprWideFunc(
return TCL_OK;
}
/*
* Common implmentation of max() and min().
*/
static int
ExprMaxMinFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv, /* Actual parameter vector. */
int op) /* Comparison direction */
{
Tcl_Obj *res;
double d;
int type, i;
ClientData ptr;
if (objc < 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
res = objv[1];
for (i = 1; i < objc; i++) {
if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type == TCL_NUMBER_NAN) {
/*
* Get the error message for NaN.
*/
Tcl_GetDoubleFromObj(interp, objv[i], &d);
return TCL_ERROR;
}
if (TclCompareTwoNumbers(objv[i], res) == op) {
res = objv[i];
}
}
Tcl_SetObjResult(interp, res);
return TCL_OK;
}
static int
ExprMaxFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
}
static int
ExprMinFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
}
static int
ExprRandFunc(
ClientData clientData, /* Ignored. */
@@ -7604,7 +7227,7 @@ ExprRandFunc(
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
* To ensure different seeds in different threads (bug #416643),
* To ensure different seeds in different threads (bug #416643),
* take into consideration the thread this interp is running in.
*/
@@ -8069,6 +7692,22 @@ Tcl_NRCreateCommand(
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
}
Tcl_Command
TclNRCreateCommandInNs (
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc) {
Command *cmdPtr = (Command *)
TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
}
/****************************************************************************
* Stuff for the public api
@@ -8854,9 +8493,9 @@ TclNRCoroutineObjCmd(
{
Command *cmdPtr;
CoroutineData *corPtr;
const char *fullName, *procName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_DString ds;
const char *procName, *simpleName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
if (objc < 3) {
@@ -8864,34 +8503,21 @@ TclNRCoroutineObjCmd(
return TCL_ERROR;
}
/*
* FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
* something in tclUtil.c to find the FQ name.
*/
fullName = TclGetString(objv[1]);
TclGetNamespaceForQualName(interp, fullName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
procName = TclGetString(objv[1]);
TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
if (nsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": unknown namespace",
fullName));
procName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": bad procedure name",
fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\" in non-global namespace with"
" name starting with \":\"", procName));
procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
return TCL_ERROR;
}
@@ -8903,16 +8529,9 @@ TclNRCoroutineObjCmd(
corPtr = ckalloc(sizeof(CoroutineData));
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
/*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
Tcl_DStringFree(&ds);
cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
(Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
corPtr, DeleteCoroutine);
corPtr->cmdPtr = cmdPtr;
cmdPtr->refCount++;
+1 -1
View File
@@ -267,7 +267,7 @@ const Tcl_ObjType tclByteArrayType = {
* fewer mallocs.
*/
typedef struct ByteArray {
typedef struct {
int used; /* The number of bytes used in the byte
* array. */
int allocated; /* The amount of space actually allocated
+15 -15
View File
@@ -33,7 +33,7 @@
* "memory tag" command is invoked, to hold the current tag.
*/
typedef struct MemTag {
typedef struct {
size_t refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
@@ -187,15 +187,15 @@ TclDumpMemoryInfo(
"total mallocs %10u\n"
"total frees %10u\n"
"current packets allocated %10u\n"
"current bytes allocated %10" TCL_LL_MODIFIER "u\n"
"current bytes allocated %10" TCL_Z_MODIFIER "u\n"
"maximum packets allocated %10u\n"
"maximum bytes allocated %10" TCL_LL_MODIFIER "u\n",
"maximum bytes allocated %10" TCL_Z_MODIFIER "u\n",
total_mallocs,
total_frees,
current_malloc_packets,
(Tcl_WideInt)current_bytes_malloced,
current_bytes_malloced,
maximum_malloc_packets,
(Tcl_WideInt)maximum_bytes_malloced);
maximum_bytes_malloced);
if (flags == 0) {
fprintf((FILE *)clientData, "%s", buf);
} else {
@@ -254,7 +254,7 @@ ValidateMemory(
fprintf(stderr, "low guard failed at %p, %s %d\n",
memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", (Tcl_WideInt) memHeaderP->length,
fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
memHeaderP->file, memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -276,8 +276,8 @@ ValidateMemory(
fprintf(stderr, "high guard failed at %p, %s %d\n",
memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n",
(Tcl_WideInt)memHeaderP->length, memHeaderP->file,
fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -359,9 +359,9 @@ Tcl_DumpActiveMemory(
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body[0];
fprintf(fileP, "%p - %p %" TCL_LL_MODIFIER "d @ %s %d %s",
fprintf(fileP, "%p - %p %" TCL_Z_MODIFIER "u @ %s %d %s",
address, address + memScanP->length - 1,
(Tcl_WideInt)memScanP->length, memScanP->file, memScanP->line,
memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
}
@@ -611,8 +611,8 @@ Tcl_DbCkfree(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
fprintf(stderr, "ckfree %p %" TCL_LL_MODIFIER "d %s %d\n",
memp->body, (Tcl_WideInt) memp->length, file, line);
fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
memp->body, memp->length, file, line);
}
if (validate_memory) {
@@ -859,12 +859,12 @@ MemoryCmd(
}
if (strcmp(argv[1],"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER"d\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER "d\n",
"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
"current bytes allocated", (Tcl_WideInt)current_bytes_malloced,
"current bytes allocated", current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
"maximum bytes allocated", (Tcl_WideInt)maximum_bytes_malloced));
"maximum bytes allocated", maximum_bytes_malloced));
return TCL_OK;
}
if (strcmp(argv[1], "init") == 0) {
+1 -1
View File
@@ -100,7 +100,7 @@ typedef struct {
* Structure containing the fields used in [clock format] and [clock scan]
*/
typedef struct TclDateFields {
typedef struct {
Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
* epoch */
Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
-137
View File
@@ -147,143 +147,6 @@ Tcl_BreakObjCmd(
return TCL_BREAK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CaseObjCmd --
*
* This procedure is invoked to process the "case" Tcl command. See the
* user documentation for details on what it does. THIS COMMAND IS
* OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
*
* Results:
* A standard Tcl object result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
/* ARGSUSED */
int
Tcl_CaseObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register int i;
int body, result, caseObjc;
const char *stringPtr, *arg;
Tcl_Obj *const *caseObjv;
Tcl_Obj *armPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
"string ?in? ?pattern body ...? ?default body?");
return TCL_ERROR;
}
stringPtr = TclGetString(objv[1]);
body = -1;
arg = TclGetString(objv[2]);
if (strcmp(arg, "in") == 0) {
i = 3;
} else {
i = 2;
}
caseObjc = objc - i;
caseObjv = objv + i;
/*
* If all of the pattern/command pairs are lumped into a single argument,
* split them out again.
*/
if (caseObjc == 1) {
Tcl_Obj **newObjv;
TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
caseObjv = newObjv;
}
for (i = 0; i < caseObjc; i += 2) {
int patObjc, j;
const char **patObjv;
const char *pat, *p;
if (i == caseObjc-1) {
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"extra case pattern with no body", -1));
return TCL_ERROR;
}
/*
* Check for special case of single pattern (no list) with no
* backslash sequences.
*/
pat = TclGetString(caseObjv[i]);
for (p = pat; *p != '\0'; p++) {
if (TclIsSpaceProc(*p) || (*p == '\\')) {
break;
}
}
if (*p == '\0') {
if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
body = i + 1;
}
if (Tcl_StringMatch(stringPtr, pat)) {
body = i + 1;
goto match;
}
continue;
}
/*
* Break up pattern lists, then check each of the patterns in the
* list.
*/
result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
if (result != TCL_OK) {
return result;
}
for (j = 0; j < patObjc; j++) {
if (Tcl_StringMatch(stringPtr, patObjv[j])) {
body = i + 1;
break;
}
}
ckfree(patObjv);
if (j < patObjc) {
break;
}
}
match:
if (body != -1) {
armPtr = caseObjv[body - 1];
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"%.50s\" arm line %d)",
TclGetString(armPtr), Tcl_GetErrorLine(interp)));
}
return result;
}
/*
* Nothing matched: return nothing.
*/
return TCL_OK;
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
+189 -136
View File
@@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
* The following structure is used to pass this information.
*/
typedef struct SortInfo {
typedef struct {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_* values
* defined below. */
@@ -64,8 +64,9 @@ typedef struct SortInfo {
* SORTMODE_COMMAND. Pre-initialized to hold
* base of command. */
int *indexv; /* If the -index option was specified, this
* holds the indexes contained in the list
* supplied as an argument to that option.
* holds an encoding of the indexes contained
* in the list supplied as an argument to
* that option.
* NULL if no indexes supplied, and points to
* singleIndex field when only one
* supplied. */
@@ -92,14 +93,6 @@ typedef struct SortInfo {
#define SORTMODE_DICTIONARY 4
#define SORTMODE_ASCII_NC 8
/*
* Magic values for the index field of the SortInfo structure. Note that the
* index "end-1" will be translated to SORTIDX_END-1, etc.
*/
#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
#define SORTIDX_END -2 /* Indexed from end. */
/*
* Forward declarations for procedures defined in this file:
*/
@@ -2160,7 +2153,7 @@ Tcl_JoinObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int listLen;
int length, listLen;
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
@@ -2191,9 +2184,9 @@ Tcl_JoinObjCmd(
joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
Tcl_IncrRefCount(joinObjPtr);
if (Tcl_GetCharLength(joinObjPtr) == 0) {
TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
&resObjPtr);
(void) Tcl_GetStringFromObj(joinObjPtr, &length);
if (length == 0) {
resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
} else {
int i;
@@ -2543,7 +2536,6 @@ Tcl_LrangeObjCmd(
register Tcl_Obj *const objv[])
/* Argument objects. */
{
Tcl_Obj **elemPtrs;
int listLen, first, last, result;
if (objc != 4) {
@@ -2561,55 +2553,14 @@ Tcl_LrangeObjCmd(
if (result != TCL_OK) {
return result;
}
if (first < 0) {
first = 0;
}
result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
&last);
if (result != TCL_OK) {
return result;
}
if (last >= listLen) {
last = listLen - 1;
}
if (first > last) {
/*
* Returning an empty list is easy.
*/
return TCL_OK;
}
result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
if (Tcl_IsShared(objv[1]) ||
((ListRepPtr(objv[1])->refCount > 1))) {
Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
&elemPtrs[first]));
} else {
/*
* In-place is possible.
*/
if (last < (listLen - 1)) {
Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
0, NULL);
}
/*
* This one is not conditioned on (first > 0) in order to preserve the
* string-canonizing effect of [lrange 0 end].
*/
Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
Tcl_SetObjResult(interp, objv[1]);
}
Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
return TCL_OK;
}
@@ -2787,7 +2738,7 @@ Tcl_LreplaceObjCmd(
* (to allow for replacing the last elem).
*/
if ((first > listLen) && (listLen > 0)) {
if ((first >= listLen) && (listLen > 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list doesn't contain element %s", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
@@ -2938,20 +2889,21 @@ Tcl_LsearchObjCmd(
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
int i, match, index, result, listc, length, elemLen, bisect;
int dataType, isIncreasing, lower, upper, offset;
int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
int allocatedIndexVector = 0;
int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
SortStrCmpFn_t strCmpFn = strcmp;
SortStrCmpFn_t strCmpFn = TclUtfCmp;
Tcl_RegExp regexp = NULL;
static const char *const options[] = {
"-all", "-ascii", "-bisect", "-decreasing", "-dictionary",
"-exact", "-glob", "-increasing", "-index",
"-inline", "-integer", "-nocase", "-not",
"-real", "-regexp", "-sorted", "-start",
"-real", "-regexp", "-sorted", "-start", "-stride",
"-subindices", NULL
};
enum options {
@@ -2959,7 +2911,7 @@ Tcl_LsearchObjCmd(
LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
LSEARCH_START, LSEARCH_SUBINDICES
LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES
};
enum datatypes {
ASCII, DICTIONARY, INTEGER, REAL
@@ -2979,7 +2931,9 @@ Tcl_LsearchObjCmd(
bisect = 0;
listPtr = NULL;
startPtr = NULL;
offset = 0;
groupSize = 1;
groupOffset = 0;
start = 0;
noCase = 0;
sortInfo.compareCmdPtr = NULL;
sortInfo.isIncreasing = 1;
@@ -2997,9 +2951,6 @@ Tcl_LsearchObjCmd(
for (i = 1; i < objc-2; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
!= TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
result = TCL_ERROR;
goto done;
}
@@ -3064,6 +3015,7 @@ Tcl_LsearchObjCmd(
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
startPtr = NULL;
}
if (i > objc-4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -3084,25 +3036,47 @@ Tcl_LsearchObjCmd(
startPtr = Tcl_DuplicateObj(objv[i]);
} else {
startPtr = objv[i];
Tcl_IncrRefCount(startPtr);
}
Tcl_IncrRefCount(startPtr);
break;
case LSEARCH_STRIDE: /* -stride */
if (i > objc-4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-stride\" option must be "
"followed by stride length", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
result = TCL_ERROR;
goto done;
}
if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
result = TCL_ERROR;
goto done;
}
if (groupSize < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"stride length must be at least 1", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
"BADSTRIDE", NULL);
result = TCL_ERROR;
goto done;
}
i++;
break;
case LSEARCH_INDEX: { /* -index */
Tcl_Obj **indices;
int j;
if (sortInfo.indexc > 1) {
if (allocatedIndexVector) {
TclStackFree(interp, sortInfo.indexv);
allocatedIndexVector = 0;
}
if (i > objc-4) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-index\" option must be followed by list index",
-1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
result = TCL_ERROR;
goto done;
}
/*
@@ -3114,10 +3088,8 @@ Tcl_LsearchObjCmd(
i++;
if (TclListObjGetElements(interp, objv[i],
&sortInfo.indexc, &indices) != TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
return TCL_ERROR;
result = TCL_ERROR;
goto done;
}
switch (sortInfo.indexc) {
case 0:
@@ -3129,6 +3101,8 @@ Tcl_LsearchObjCmd(
default:
sortInfo.indexv =
TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
allocatedIndexVector = 1; /* Cannot use indexc field, as it
* might be decreased by 1 later. */
}
/*
@@ -3138,13 +3112,26 @@ Tcl_LsearchObjCmd(
*/
for (j=0 ; j<sortInfo.indexc ; j++) {
if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
int encoded = 0;
if (TclIndexEncode(interp, indices[j], TCL_INDEX_BEFORE,
TCL_INDEX_AFTER, &encoded) != TCL_OK) {
result = TCL_ERROR;
}
if ((encoded == TCL_INDEX_BEFORE)
|| (encoded == TCL_INDEX_AFTER)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%s\" cannot select an element "
"from any list", Tcl_GetString(indices[j])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
"OUTOFRANGE", NULL);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
result = TCL_ERROR;
goto done;
}
sortInfo.indexv[j] = encoded;
}
break;
}
@@ -3156,14 +3143,12 @@ Tcl_LsearchObjCmd(
*/
if (returnSubindices && sortInfo.indexc==0) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"-subindices cannot be used without -index option", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
"BAD_OPTION_MIX", NULL);
return TCL_ERROR;
result = TCL_ERROR;
goto done;
}
if (bisect && (allMatches || negatedMatch)) {
@@ -3171,7 +3156,8 @@ Tcl_LsearchObjCmd(
"-bisect is not compatible with -all or -not", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
"BAD_OPTION_MIX", NULL);
return TCL_ERROR;
result = TCL_ERROR;
goto done;
}
if (mode == REGEXP) {
@@ -3197,9 +3183,6 @@ Tcl_LsearchObjCmd(
}
if (regexp == NULL) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
result = TCL_ERROR;
goto done;
}
@@ -3212,24 +3195,64 @@ Tcl_LsearchObjCmd(
result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
if (result != TCL_OK) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
goto done;
}
/*
* Check for sanity when grouping elements of the overall list together
* because of the -stride option. [TIP #351]
*/
if (groupSize > 1) {
if (listc % groupSize) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"list size must be a multiple of the stride length",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE",
NULL);
result = TCL_ERROR;
goto done;
}
if (sortInfo.indexc > 0) {
/*
* Use the first value in the list supplied to -index as the
* offset of the element within each group by which to sort.
*/
groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
if (groupOffset < 0 || groupOffset >= groupSize) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"when used with \"-stride\", the leading \"-index\""
" value must be within the group", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
"BADINDEX", NULL);
result = TCL_ERROR;
goto done;
}
if (sortInfo.indexc == 1) {
sortInfo.indexc = 0;
sortInfo.indexv = NULL;
} else {
sortInfo.indexc--;
for (i = 0; i < sortInfo.indexc; i++) {
sortInfo.indexv[i] = sortInfo.indexv[i+1];
}
}
}
}
/*
* Get the user-specified start offset.
*/
if (startPtr) {
result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
Tcl_DecrRefCount(startPtr);
result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
if (result != TCL_OK) {
goto done;
}
if (offset < 0) {
offset = 0;
if (start < 0) {
start = 0;
}
/*
@@ -3237,16 +3260,21 @@ Tcl_LsearchObjCmd(
* "did not match anything at all" result straight away. [Bug 1374778]
*/
if (offset > listc-1) {
if (sortInfo.indexc > 1) {
TclStackFree(interp, sortInfo.indexv);
}
if (start > listc-1) {
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
}
return TCL_OK;
goto done;
}
/*
* If start points within a group, it points to the start of the group.
*/
if (groupSize > 1) {
start -= (start % groupSize);
}
}
@@ -3305,18 +3333,23 @@ Tcl_LsearchObjCmd(
* sense in doing this when the match sense is inverted.
*/
lower = offset - 1;
/*
* With -stride, lower, upper and i are kept as multiples of groupSize.
*/
lower = start - groupSize;
upper = listc;
while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
i = (lower + upper)/2;
i -= i % groupSize;
if (sortInfo.indexc != 0) {
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
result = sortInfo.resultCode;
goto done;
}
} else {
itemPtr = listv[i];
itemPtr = listv[i+groupOffset];
}
switch ((enum datatypes) dataType) {
case ASCII:
@@ -3405,10 +3438,10 @@ Tcl_LsearchObjCmd(
if (allMatches) {
listPtr = Tcl_NewListObj(0, NULL);
}
for (i = offset; i < listc; i++) {
for (i = start; i < listc; i += groupSize) {
match = 0;
if (sortInfo.indexc != 0) {
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
@@ -3417,7 +3450,7 @@ Tcl_LsearchObjCmd(
goto done;
}
} else {
itemPtr = listv[i];
itemPtr = listv[i+groupOffset];
}
switch (mode) {
@@ -3507,18 +3540,23 @@ Tcl_LsearchObjCmd(
*/
if (returnSubindices && (sortInfo.indexc != 0)) {
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
itemPtr = SelectObjFromSublist(listv[i+groupOffset],
&sortInfo);
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else if (groupSize > 1) {
Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
groupSize, &listv[i]);
} else {
itemPtr = listv[i];
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else if (returnSubindices) {
int j;
itemPtr = Tcl_NewIntObj(i);
itemPtr = Tcl_NewIntObj(i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
Tcl_NewIntObj(sortInfo.indexv[j]));
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else {
@@ -3537,10 +3575,10 @@ Tcl_LsearchObjCmd(
if (returnSubindices) {
int j;
itemPtr = Tcl_NewIntObj(index);
itemPtr = Tcl_NewIntObj(index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
Tcl_NewIntObj(sortInfo.indexv[j]));
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
}
Tcl_SetObjResult(interp, itemPtr);
} else {
@@ -3554,7 +3592,14 @@ Tcl_LsearchObjCmd(
Tcl_SetObjResult(interp, Tcl_NewObj());
} else {
Tcl_SetObjResult(interp, listv[index]);
if (returnSubindices) {
Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
&sortInfo));
} else if (groupSize > 1) {
Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
} else {
Tcl_SetObjResult(interp, listv[index]);
}
}
result = TCL_OK;
@@ -3563,7 +3608,10 @@ Tcl_LsearchObjCmd(
*/
done:
if (sortInfo.indexc > 1) {
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
if (allocatedIndexVector) {
TclStackFree(interp, sortInfo.indexv);
}
return result;
@@ -3757,7 +3805,7 @@ Tcl_LsortObjCmd(
sortInfo.isIncreasing = 1;
break;
case LSORT_INDEX: {
int indexc, dummy;
int indexc;
Tcl_Obj **indexv;
if (i == objc-2) {
@@ -3783,8 +3831,20 @@ Tcl_LsortObjCmd(
*/
for (j=0 ; j<indexc ; j++) {
if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
&dummy) != TCL_OK) {
int encoded = 0;
int result = TclIndexEncode(interp, indexv[j],
TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &encoded);
if ((result == TCL_OK) && ((encoded == TCL_INDEX_BEFORE)
|| (encoded == TCL_INDEX_AFTER))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%s\" cannot select an element "
"from any list", Tcl_GetString(indexv[j])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
"OUTOFRANGE", NULL);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
sortInfo.resultCode = TCL_ERROR;
@@ -3864,8 +3924,8 @@ Tcl_LsortObjCmd(
* might be decreased by 1 later. */
}
for (j=0 ; j<sortInfo.indexc ; j++) {
TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
&sortInfo.indexv[j]);
/* Prescreened values, no errors or out of range possible */
TclIndexEncode(NULL, indexv[j], 0, 0, &sortInfo.indexv[j]);
}
}
@@ -3936,10 +3996,7 @@ Tcl_LsortObjCmd(
* offset of the element within each group by which to sort.
*/
groupOffset = sortInfo.indexv[0];
if (groupOffset <= SORTIDX_END) {
groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
}
groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
if (groupOffset < 0 || groupOffset >= groupSize) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"when used with \"-stride\", the leading \"-index\""
@@ -3958,6 +4015,9 @@ Tcl_LsortObjCmd(
/*
* Do not shrink the actual memory block used; that doesn't
* work with TclStackAlloc-allocated memory. [Bug 2918962]
*
* TODO: Consider a pointer increment to replace this
* array shift.
*/
for (i = 0; i < sortInfo.indexc; i++) {
@@ -4263,7 +4323,7 @@ SortCompare(
int order = 0;
if (infoPtr->sortMode == SORTMODE_ASCII) {
order = strcmp(elemPtr1->collationKey.strValuePtr,
order = TclUtfCmp(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
@@ -4526,15 +4586,8 @@ SelectObjFromSublist(
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
index = infoPtr->indexv[i];
/*
* Adjust for end-based indexing.
*/
if (index < SORTIDX_NONE) {
index += listLen + 1;
}
index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);
if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
&currentObj) != TCL_OK) {
+69 -74
View File
@@ -309,7 +309,7 @@ Tcl_RegexpObjCmd(
eflags = 0;
} else if (offset > stringLength) {
eflags = TCL_REG_NOTBOL;
} else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
eflags = 0;
} else {
eflags = TCL_REG_NOTBOL;
@@ -491,7 +491,7 @@ Tcl_RegsubObjCmd(
Tcl_RegExp regExpr;
Tcl_RegExpInfo info;
Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;
static const char *const options[] = {
"-all", "-command", "-expanded", "-line",
@@ -1216,13 +1216,22 @@ Tcl_SplitObjCmd(
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
for ( ; stringPtr < end; stringPtr += len) {
int fullchar;
len = TclUtfToUniChar(stringPtr, &ch);
fullchar = ch;
#if TCL_UTF_MAX <= 4
if (!len) {
len += TclUtfToUniChar(stringPtr, &ch);
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
}
#endif
/*
* Assume Tcl_UniChar is an integral type...
*/
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(fullchar),
&isNew);
if (isNew) {
TclNewStringObj(objPtr, stringPtr, len);
@@ -1326,16 +1335,8 @@ StringFirstCmd(
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
return TCL_ERROR;
}
if (start < 0) {
start = 0;
}
if (start >= size) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
return TCL_OK;
}
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFirst(objv[1],
objv[2], start)));
return TCL_OK;
}
@@ -1379,14 +1380,6 @@ StringLastCmd(
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
return TCL_ERROR;
}
if (last < 0) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
return TCL_OK;
}
if (last >= size) {
last = size - 1;
}
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
objv[2], last)));
@@ -1426,7 +1419,7 @@ StringIndexCmd(
}
/*
* Get the char length to calulate what 'end' means.
* Get the char length to calculate what 'end' means.
*/
length = Tcl_GetCharLength(objv[1]);
@@ -1435,7 +1428,11 @@ StringIndexCmd(
}
if ((index >= 0) && (index < length)) {
Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
int ch = Tcl_GetUniChar(objv[1], index);
if (ch == -1) {
return TCL_OK;
}
/*
* If we have a ByteArray object, we're careful to generate a new
@@ -1447,7 +1444,7 @@ StringIndexCmd(
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
} else {
char buf[TCL_UTF_MAX];
char buf[4];
length = Tcl_UniCharToUtf(ch, buf);
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
@@ -1579,10 +1576,8 @@ StringIsCmd(
string1 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
} else if (((index == STR_IS_TRUE) &&
objPtr->internalRep.longValue == 0)
|| ((index == STR_IS_FALSE) &&
objPtr->internalRep.longValue != 0)) {
} else if ((objPtr->internalRep.wideValue != 0)
? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
result = 0;
}
break;
@@ -1593,12 +1588,8 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
/* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
#ifndef TCL_WIDE_INT_IS_LONG
(objPtr->typePtr == &tclWideIntType) ||
#endif
(objPtr->typePtr == &tclBignumType)) {
break;
}
@@ -1633,9 +1624,6 @@ StringIsCmd(
goto failedIntParse;
case STR_IS_ENTIER:
if ((objPtr->typePtr == &tclIntType) ||
#ifndef TCL_WIDE_INT_IS_LONG
(objPtr->typePtr == &tclWideIntType) ||
#endif
(objPtr->typePtr == &tclBignumType)) {
break;
}
@@ -1814,8 +1802,16 @@ StringIsCmd(
}
end = string1 + length1;
for (; string1 < end; string1 += length2, failat++) {
int fullchar;
length2 = TclUtfToUniChar(string1, &ch);
if (!chcomp(ch)) {
fullchar = ch;
#if TCL_UTF_MAX <= 4
if (!length2) {
length2 = TclUtfToUniChar(string1, &ch);
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
}
#endif
if (!chcomp(fullchar)) {
result = 0;
break;
}
@@ -2277,11 +2273,12 @@ StringReptCmd(
return TCL_OK;
}
if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) {
return TCL_ERROR;
resultPtr = TclStringRepeat(interp, objv[1], count, TCL_STRING_IN_PLACE);
if (resultPtr) {
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
return TCL_ERROR;
}
/*
@@ -2309,42 +2306,50 @@ StringRplcCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *ustring;
int first, last, length;
int first, last, length, end;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
return TCL_ERROR;
}
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
length--;
length = Tcl_GetCharLength(objv[1]);
end = length - 1;
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
return TCL_ERROR;
}
if ((last < first) || (last < 0) || (first > length)) {
/*
* The following test screens out most empty substrings as
* candidates for replacement. When they are detected, no
* replacement is done, and the result is the original string,
*/
if ((last < 0) || /* Range ends before start of string */
(first > end) || /* Range begins after end of string */
(last < first)) { /* Range begins after it starts */
/*
* BUT!!! when (end < 0) -- an empty original string -- we can
* have (first <= end < 0 <= last) and an empty string is permitted
* to be replaced.
*/
Tcl_SetObjResult(interp, objv[1]);
} else {
Tcl_Obj *resultPtr;
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
length--;
if (first < 0) {
first = 0;
}
if (last > end) {
last = end;
}
resultPtr = TclStringReplace(interp, objv[1], first,
last + 1 - first, (objc == 5) ? objv[4] : NULL,
TCL_STRING_IN_PLACE);
resultPtr = Tcl_NewUnicodeObj(ustring, first);
if (objc == 5) {
Tcl_AppendObjToObj(resultPtr, objv[4]);
}
if (last < length) {
Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
length - last);
}
Tcl_SetObjResult(interp, resultPtr);
}
return TCL_OK;
@@ -2380,7 +2385,7 @@ StringRevCmd(
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
return TCL_OK;
}
@@ -2829,7 +2834,6 @@ StringCatCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int code;
Tcl_Obj *objResultPtr;
if (objc < 2) {
@@ -2839,23 +2843,15 @@ StringCatCmd(
*/
return TCL_OK;
}
if (objc == 2) {
/*
* Other trivial case, single arg, just return it.
*/
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
&objResultPtr);
objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE);
if (code == TCL_OK) {
if (objResultPtr) {
Tcl_SetObjResult(interp, objResultPtr);
return TCL_OK;
}
return code;
return TCL_ERROR;
}
/*
@@ -3224,8 +3220,7 @@ StringTrimCmd(
}
string1 = TclGetStringFromObj(objv[1], &length1);
triml = TclTrimLeft(string1, length1, string2, length2);
trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);
triml = TclTrim(string1, length1, string2, length2, &trimr);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
@@ -3530,7 +3525,7 @@ TclNRSwitchObjCmd(
OPT_LAST
};
typedef int (*strCmpFn_t)(const char *, const char *);
strCmpFn_t strCmpFn = strcmp;
strCmpFn_t strCmpFn = TclUtfCmp;
mode = OPT_EXACT;
foundmode = 0;
@@ -4293,7 +4288,7 @@ TclNRTryObjCmd(
}
info[0] = objv[i]; /* type */
TclNewLongObj(info[1], code); /* returnCode */
TclNewIntObj(info[1], code); /* returnCode */
if (info[2] == NULL) { /* errorCodePrefix */
TclNewObj(info[2]);
}
+15 -3
View File
@@ -322,11 +322,22 @@ TclCompileArraySetCmd(
*/
if (isDataValid && !isDataEven) {
/* Abandon custom compile and let invocation raise the error */
code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
goto done;
/*
* We used to compile to the bytecode that would throw the error,
* but that was wrong because it would not invoke the array trace
* on the variable.
*
PushStringLiteral(envPtr, "list must have an even number of elements");
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
goto done;
*
*/
}
/*
@@ -404,6 +415,10 @@ TclCompileArraySetCmd(
* Start issuing instructions to write to the array.
*/
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
CompileWord(envPtr, dataTokenPtr, interp, 2);
if (!isDataLiteral || !isDataValid) {
/*
@@ -428,9 +443,6 @@ TclCompileArraySetCmd(
TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
}
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
offsetBack = CurrentOffset(envPtr);
Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
+195 -270
View File
@@ -28,56 +28,39 @@ static void CompileReturnInternal(CompileEnv *envPtr,
static int IndexTailVarIfKnown(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
#define INDEX_END (-2)
/*
*----------------------------------------------------------------------
*
* GetIndexFromToken --
* TclGetIndexFromToken --
*
* Parse a token and get the encoded version of the index (as understood
* by TEBC), assuming it is at all knowable at compile time. Only handles
* indices that are integers or 'end' or 'end-integer'.
* Parse a token to determine if an index value is known at
* compile time.
*
* Returns:
* TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
*
* Side effects:
* Sets *index to the index value if successful.
* When TCL_OK is returned, the encoded index value is written
* to *index.
*
*----------------------------------------------------------------------
*/
static inline int
GetIndexFromToken(
int
TclGetIndexFromToken(
Tcl_Token *tokenPtr,
int *index)
int before,
int after,
int *indexPtr)
{
Tcl_Obj *tmpObj = Tcl_NewObj();
int result, idx;
int result = TCL_ERROR;
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
Tcl_DecrRefCount(tmpObj);
return TCL_ERROR;
}
result = TclGetIntFromObj(NULL, tmpObj, &idx);
if (result == TCL_OK) {
if (idx < 0) {
result = TCL_ERROR;
}
} else {
result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
if (result == TCL_OK && idx > INDEX_END) {
result = TCL_ERROR;
}
if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr);
}
Tcl_DecrRefCount(tmpObj);
if (result == TCL_OK) {
*index = idx;
}
return result;
}
@@ -144,7 +127,7 @@ TclCompileGlobalCmd(
return TCL_ERROR;
}
/* TODO: Consider what value can pass throug the
/* TODO: Consider what value can pass through the
* IndexTailVarIfKnown() screen. Full CompileWord()
* likely does not apply here. Push known value instead. */
CompileWord(envPtr, varTokenPtr, interp, i);
@@ -1053,7 +1036,7 @@ TclCompileLassignCmd(
*/
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
TclEmitInt4( INDEX_END, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
return TCL_OK;
}
@@ -1104,14 +1087,14 @@ TclCompileLindexCmd(
}
idxTokenPtr = TokenAfter(valTokenPtr);
if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_BEFORE,
&idx) == TCL_OK) {
/*
* All checks have been completed, and we have exactly one of these
* constructs:
* lindex <arbitraryValue> <posInt>
* lindex <arbitraryValue> end-<posInt>
* This is best compiled as a push of the arbitrary value followed by
* an "immediate lindex" which is the most efficient variety.
* The idxTokenPtr parsed as a valid index value and was
* encoded as expected by INST_LIST_INDEX_IMM.
*
* NOTE: that we rely on indexing before a list producing the
* same result as indexing after a list.
*/
CompileWord(envPtr, valTokenPtr, interp, 1);
@@ -1258,7 +1241,7 @@ TclCompileListCmd(
if (concat && numWords == 2) {
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( INDEX_END, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
}
return TCL_OK;
}
@@ -1332,21 +1315,25 @@ TclCompileLrangeCmd(
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
tokenPtr = TokenAfter(listTokenPtr);
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
&idx1) != TCL_OK) {
return TCL_ERROR;
}
/*
* Parse the indices. Will only compile if both are constants and not an
* _integer_ less than zero (since we reserve negative indices here for
* end-relative indexing) or an end-based index greater than 'end' itself.
* Token was an index value, and we treat all "first" indices
* before the list same as the start of the list.
*/
tokenPtr = TokenAfter(listTokenPtr);
if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(tokenPtr);
if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
&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.
*/
/*
* Issue instructions. It's not safe to skip doing the LIST_RANGE, as
@@ -1396,21 +1383,30 @@ TclCompileLinsertCmd(
*/
tokenPtr = TokenAfter(listTokenPtr);
if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
/*
* 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) {
return TCL_ERROR;
}
/*
* There are four main cases. If there are no values to insert, this is
* just a confirm-listiness check. If the index is '0', this is a prepend.
* If the index is 'end' (== INDEX_END), this is an append. Otherwise,
* If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,
* this is a splice (== split, insert values as list, concat-3).
*/
CompileWord(envPtr, listTokenPtr, interp, 1);
if (parsePtr->numWords == 3) {
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( INDEX_END, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
return TCL_OK;
}
@@ -1420,13 +1416,25 @@ TclCompileLinsertCmd(
}
TclEmitInstInt4( INST_LIST, i-3, envPtr);
if (idx == 0 /*start*/) {
if (idx == TCL_INDEX_START) {
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
} else if (idx == INDEX_END /*end*/) {
} else if (idx == TCL_INDEX_END) {
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
} else {
if (idx < 0) {
/*
* Here we handle two ranges for idx. First when idx > 0, we
* want the first half of the split to end at index idx-1 and
* the second half to start at index idx.
* Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
* we want the first half of the split to end at index end-N and
* the second half to start at index end-N+1. We accomplish this
* with a pre-adjustment of the end-N value.
* The root of this is that the commands [lrange] and [linsert]
* differ in their interpretation of the "end" index.
*/
if (idx < TCL_INDEX_END) {
idx++;
}
TclEmitInstInt4( INST_OVER, 1, envPtr);
@@ -1434,7 +1442,7 @@ TclCompileLinsertCmd(
TclEmitInt4( idx-1, envPtr);
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
TclEmitInt4( INDEX_END, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
}
@@ -1464,250 +1472,167 @@ TclCompileLreplaceCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Obj *tmpObj;
int idx1, idx2, i, offset, offset2;
int emptyPrefix=1, suffixStart = 0;
if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
* Parse the indices. Will only compile if both are constants and not an
* _integer_ less than zero (since we reserve negative indices here for
* end-relative indexing) or an end-based index greater than 'end' itself.
*/
tokenPtr = TokenAfter(listTokenPtr);
if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
&idx1) != TCL_OK) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(tokenPtr);
if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
&idx2) != TCL_OK) {
return TCL_ERROR;
}
/*
* idx1, idx2 are now in canonical form:
* idx1, idx2 are the conventional encoded forms of the tokens parsed
* as all forms of index values. Values of idx1 that come before the
* list are treated the same as if they were the start of the list.
* Values of idx2 that come after the list are treated the same as if
* they were the end of the list.
*/
if (idx1 == TCL_INDEX_AFTER) {
/*
* [lreplace] treats idx1 value end+1 differently from end+2, etc.
* The operand encoding cannot distinguish them, so we must bail
* out to direct evaluation.
*/
return TCL_ERROR;
}
/*
* General structure of the [lreplace] result is
* prefix replacement suffix
* In a few cases we can predict various parts will be empty and
* take advantage.
*
* - integer: [0,len+1]
* - end index: INDEX_END
* - -ive offset: INDEX_END-[len-1,0]
* - +ive offset: INDEX_END+1
* The proper suffix begins with the greater of indices idx1 or
* idx2 + 1. If we cannot tell at compile time which is greater,
* we must defer to direct evaluation.
*/
/*
* Compilation fails when one index is end-based but the other isn't.
* Fixing this will require more bytecodes, but this is a workaround for
* now. [Bug 47ac84309b]
*/
if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
if (idx2 == TCL_INDEX_BEFORE) {
suffixStart = idx1;
} else if (idx2 == TCL_INDEX_END) {
suffixStart = TCL_INDEX_AFTER;
} else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
|| ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
} else {
return TCL_ERROR;
}
if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
idx2 = idx1 - 1;
}
/*
* Work out what this [lreplace] is actually doing.
*/
tmpObj = NULL;
/* All paths start with computing/pushing the original value. */
CompileWord(envPtr, listTokenPtr, interp, 1);
if (parsePtr->numWords == 4) {
if (idx1 == 0) {
if (idx2 == INDEX_END) {
goto dropAll;
}
idx1 = idx2 + 1;
idx2 = INDEX_END;
goto dropEnd;
} else if (idx2 == INDEX_END) {
idx2 = idx1 - 1;
idx1 = 0;
goto dropEnd;
} else {
if (idx2 < idx1) {
idx2 = idx1 - 1;
}
if (idx1 > 0) {
tmpObj = Tcl_NewIntObj(idx1);
Tcl_IncrRefCount(tmpObj);
}
goto dropRange;
}
}
tokenPtr = TokenAfter(tokenPtr);
for (i=4 ; i<parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
/*
* 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);
for (i=4 ; i<parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
/* Make a list of them... */
TclEmitInstInt4( INST_LIST, i - 4, envPtr);
emptyPrefix = 0;
}
TclEmitInstInt4( INST_LIST, i - 4, envPtr);
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
if (idx1 == 0) {
if (idx2 == INDEX_END) {
goto replaceAll;
/*
* [lreplace] raises an error when idx1 points after the list, but
* only when the list is not empty. This is maximum stupidity.
*
* TODO: TIP this nonsense away!
*/
if (idx1 >= TCL_INDEX_START) {
if (emptyPrefix) {
TclEmitOpcode( INST_DUP, envPtr);
} else {
TclEmitInstInt4( INST_OVER, 1, envPtr);
}
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
TclEmitOpcode( INST_DUP, envPtr);
offset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
/* List is not empty */
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
NULL), envPtr);
TclEmitOpcode( INST_GT, envPtr);
offset2 = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
/* Idx1 >= list length ===> raise an error */
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
"list doesn't contain element %d", idx1), NULL), envPtr);
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
envPtr->codeStart + offset + 1);
TclEmitOpcode( INST_POP, envPtr);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
envPtr->codeStart + offset2 + 1);
}
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.
*/
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
return TCL_OK;
}
if (idx1 != TCL_INDEX_START) {
/* Prefix may not be empty; generate bytecode to push it */
if (emptyPrefix) {
TclEmitOpcode( INST_DUP, envPtr);
} else {
TclEmitInstInt4( INST_OVER, 1, envPtr);
}
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( idx1 - 1, envPtr);
if (!emptyPrefix) {
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
}
emptyPrefix = 0;
}
if (!emptyPrefix) {
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
}
if (suffixStart == TCL_INDEX_AFTER) {
TclEmitOpcode( INST_POP, envPtr);
if (emptyPrefix) {
PushStringLiteral(envPtr, "");
}
idx1 = idx2 + 1;
idx2 = INDEX_END;
goto replaceHead;
} else if (idx2 == INDEX_END) {
idx2 = idx1 - 1;
idx1 = 0;
goto replaceTail;
} else {
if (idx2 < idx1) {
idx2 = idx1 - 1;
/* Suffix may not be empty; generate bytecode to push it */
TclEmitInstInt4( INST_LIST_RANGE_IMM, suffixStart, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
if (!emptyPrefix) {
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
}
if (idx1 > 0) {
tmpObj = Tcl_NewIntObj(idx1);
Tcl_IncrRefCount(tmpObj);
}
goto replaceRange;
}
/*
* Issue instructions to perform the operations relating to configurations
* that just drop. The only argument pushed on the stack is the list to
* operate on.
*/
dropAll: /* This just ensures the arg is a list. */
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
TclEmitOpcode( INST_POP, envPtr);
PushStringLiteral(envPtr, "");
goto done;
dropEnd:
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
TclEmitInt4( idx2, envPtr);
goto done;
dropRange:
if (tmpObj != NULL) {
/*
* Emit bytecode to check the list length.
*/
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
TclEmitOpcode( INST_GE, envPtr);
offset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
/*
* Emit an error if we've been given an empty list.
*/
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
offset2 = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
"list doesn't contain element %d", idx1), NULL), envPtr);
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
envPtr->codeStart + offset + 1);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
envPtr->codeStart + offset2 + 1);
TclAdjustStackDepth(-1, envPtr);
}
TclEmitOpcode( INST_DUP, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( idx1 - 1, envPtr);
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
TclEmitInt4( INDEX_END, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
goto done;
/*
* Issue instructions to perform the operations relating to configurations
* that do real replacement. All arguments are pushed and assembled into a
* pair: the list of values to replace with, and the list to do the
* surgery on.
*/
replaceAll:
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
TclEmitOpcode( INST_POP, envPtr);
goto done;
replaceHead:
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
TclEmitInt4( idx2, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
goto done;
replaceTail:
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
TclEmitInt4( idx2, envPtr);
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
goto done;
replaceRange:
if (tmpObj != NULL) {
/*
* Emit bytecode to check the list length.
*/
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
/*
* Check the list length vs idx1.
*/
TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
TclEmitOpcode( INST_GE, envPtr);
offset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
/*
* Emit an error if we've been given an empty list.
*/
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
offset2 = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
"list doesn't contain element %d", idx1), NULL), envPtr);
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
envPtr->codeStart + offset + 1);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
envPtr->codeStart + offset2 + 1);
TclAdjustStackDepth(-1, envPtr);
}
TclEmitOpcode( INST_DUP, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( idx1 - 1, envPtr);
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
TclEmitInt4( INDEX_END, envPtr);
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
goto done;
/*
* Clean up the allocated memory.
*/
done:
if (tmpObj != NULL) {
Tcl_DecrRefCount(tmpObj);
}
return TCL_OK;
}
@@ -2933,7 +2858,7 @@ TclCompileVariableCmd(
return TCL_ERROR;
}
/* TODO: Consider what value can pass throug the
/* TODO: Consider what value can pass through the
* IndexTailVarIfKnown() screen. Full CompileWord()
* likely does not apply here. Push known value instead. */
CompileWord(envPtr, varTokenPtr, interp, i);
+183 -137
View File
@@ -107,58 +107,6 @@ const AuxDataType tclJumptableInfoType = {
#define INVOKE(name) \
TclEmitInvoke(envPtr,INST_##name)
#define INDEX_END (-2)
/*
*----------------------------------------------------------------------
*
* GetIndexFromToken --
*
* Parse a token and get the encoded version of the index (as understood
* by TEBC), assuming it is at all knowable at compile time. Only handles
* indices that are integers or 'end' or 'end-integer'.
*
* Returns:
* TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
*
* Side effects:
* Sets *index to the index value if successful.
*
*----------------------------------------------------------------------
*/
static inline int
GetIndexFromToken(
Tcl_Token *tokenPtr,
int *index)
{
Tcl_Obj *tmpObj = Tcl_NewObj();
int result, idx;
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
Tcl_DecrRefCount(tmpObj);
return TCL_ERROR;
}
result = TclGetIntFromObj(NULL, tmpObj, &idx);
if (result == TCL_OK) {
if (idx < 0) {
result = TCL_ERROR;
}
} else {
result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
if (result == TCL_OK && idx > INDEX_END) {
result = TCL_ERROR;
}
}
Tcl_DecrRefCount(tmpObj);
if (result == TCL_OK) {
*index = idx;
}
return result;
}
/*
*----------------------------------------------------------------------
@@ -982,22 +930,48 @@ TclCompileStringRangeCmd(
fromTokenPtr = TokenAfter(stringTokenPtr);
toTokenPtr = TokenAfter(fromTokenPtr);
/* Every path must push the string argument */
CompileWord(envPtr, stringTokenPtr, interp, 1);
/*
* Parse the two indices.
*/
if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
&idx1) != TCL_OK) {
goto nonConstantIndices;
}
if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
/*
* Token parsed as an index expression. We treat all indices before
* the string the same as the start of the string.
*/
if (idx1 == TCL_INDEX_AFTER) {
/* [string range $s end+1 $last] must be empty string */
OP( POP);
PUSH( "");
return TCL_OK;
}
if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
&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 == TCL_INDEX_BEFORE) {
/* [string range $s $first -1] must be empty string */
OP( POP);
PUSH( "");
return TCL_OK;
}
/*
* Push the operand onto the stack and then the substring operation.
*/
CompileWord(envPtr, stringTokenPtr, interp, 1);
OP44( STR_RANGE_IMM, idx1, idx2);
return TCL_OK;
@@ -1006,7 +980,6 @@ TclCompileStringRangeCmd(
*/
nonConstantIndices:
CompileWord(envPtr, stringTokenPtr, interp, 1);
CompileWord(envPtr, fromTokenPtr, interp, 2);
CompileWord(envPtr, toTokenPtr, interp, 3);
OP( STR_RANGE);
@@ -1022,124 +995,197 @@ TclCompileStringReplaceCmd(
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL;
Tcl_Token *tokenPtr, *valueTokenPtr;
DefineLineInformation; /* TIP #280 */
int idx1, idx2;
int first, last;
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
return TCL_ERROR;
}
/* Bytecode to compute/push string argument being replaced */
valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
if (parsePtr->numWords == 5) {
tokenPtr = TokenAfter(valueTokenPtr);
tokenPtr = TokenAfter(tokenPtr);
replacementTokenPtr = TokenAfter(tokenPtr);
}
CompileWord(envPtr, valueTokenPtr, interp, 1);
/*
* Parse the indices. Will only compile special cases if both are
* constants and not an _integer_ less than zero (since we reserve
* negative indices here for end-relative indexing) or an end-based index
* greater than 'end' itself.
* Check for first index known and useful at compile time.
*/
tokenPtr = TokenAfter(valueTokenPtr);
if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
goto genericReplace;
}
tokenPtr = TokenAfter(tokenPtr);
if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
&first) != TCL_OK) {
goto genericReplace;
}
/*
* We handle these replacements specially: first character (where
* idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
* else and the semantics get rather screwy.
* Check for last index known and useful at compile time.
*/
tokenPtr = TokenAfter(tokenPtr);
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
&last) != TCL_OK) {
goto genericReplace;
}
/*
* [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.
*/
if (idx1 == 0 && idx2 == 0) {
int notEq, end;
if ((last == TCL_INDEX_BEFORE) /* Know (last < 0) */
|| (first == TCL_INDEX_AFTER) /* Know (first > end) */
/*
* Just working with the first character.
* 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_AFTER) => cannot tell REJECT
* (last <= TCL_INDEX END) && (last < first) => ACCEPT
* else => cannot tell REJECT
*/
CompileWord(envPtr, valueTokenPtr, interp, 1);
if (replacementTokenPtr == NULL) {
/* Drop first */
OP44( STR_RANGE_IMM, 1, INDEX_END);
return TCL_OK;
}
/* Replace first */
CompileWord(envPtr, replacementTokenPtr, interp, 4);
OP4( OVER, 1);
PUSH( "");
OP( STR_EQ);
JUMP1( JUMP_FALSE, notEq);
OP( POP);
JUMP1( JUMP, end);
FIXJUMP1(notEq);
TclAdjustStackDepth(1, envPtr);
OP4( REVERSE, 2);
OP44( STR_RANGE_IMM, 1, INDEX_END);
OP1( STR_CONCAT1, 2);
FIXJUMP1(end);
return TCL_OK;
} else if (idx1 == INDEX_END && idx2 == INDEX_END) {
int notEq, end;
|| ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END)
&& (last < first)) /* Know (last < first) */
/*
* Just working with the last character.
* (first == TCL_INDEX_BEFORE) &&
* (last == TCL_INDEX_AFTER) => (first < last) REJECT
* (last <= TCL_INDEX_END) => cannot tell REJECT
* else => (first < last) REJECT
*
* else [[first >= TCL_INDEX_START]] &&
* (last == TCL_INDEX_AFTER) => cannot tell REJECT
* (last <= TCL_INDEX_END) => cannot tell REJECT
* else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
*/
CompileWord(envPtr, valueTokenPtr, interp, 1);
if (replacementTokenPtr == NULL) {
/* Drop last */
OP44( STR_RANGE_IMM, 0, INDEX_END-1);
return TCL_OK;
|| ((first >= TCL_INDEX_START) && (last >= TCL_INDEX_START)
&& (last < first))) { /* Know (last < first) */
if (parsePtr->numWords == 5) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 4);
OP( POP); /* Pop newString */
}
/* Replace last */
CompileWord(envPtr, replacementTokenPtr, interp, 4);
OP4( OVER, 1);
PUSH( "");
OP( STR_EQ);
JUMP1( JUMP_FALSE, notEq);
OP( POP);
JUMP1( JUMP, end);
FIXJUMP1(notEq);
TclAdjustStackDepth(1, envPtr);
OP4( REVERSE, 2);
OP44( STR_RANGE_IMM, 0, INDEX_END-1);
OP4( REVERSE, 2);
OP1( STR_CONCAT1, 2);
FIXJUMP1(end);
/* Original string argument now on TOS as result */
return TCL_OK;
}
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_BEFORE) 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 indices (last >= TCL_INDEX_START) and
* (last == TCL_INDEX_AFTER) 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_BEFORE)
* or (last == TCL_INDEX_AFTER). These also permit simplification
* of the prefix|replace|suffix construction. The other constraints,
* though, interfere with getting a guarantee that first <= last.
*/
if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) {
/* empty prefix */
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 4);
OP4( REVERSE, 2);
if (last == TCL_INDEX_AFTER) {
OP( POP); /* Pop original */
} else {
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
OP1( STR_CONCAT1, 2);
}
return TCL_OK;
}
if ((last == TCL_INDEX_AFTER) && (first <= 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 {
/*
* Need to process indices at runtime. This could be because the
* indices are not constants, or because we need to resolve them to
* absolute indices to work out if a replacement is going to happen.
* In any case, to runtime it is.
/*
* 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 == TCL_INDEX_BEFORE) || (first == TCL_INDEX_START)) {
/* empty prefix - build suffix only */
if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
/* empty suffix too => empty result */
OP( POP); /* Pop original */
PUSH ( "");
return TCL_OK;
}
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
return TCL_OK;
} else {
if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
/* empty suffix - build prefix only */
OP44( STR_RANGE_IMM, 0, first-1);
return TCL_OK;
}
OP( DUP);
OP44( STR_RANGE_IMM, 0, first-1);
OP4( REVERSE, 2);
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
OP1( STR_CONCAT1, 2);
return TCL_OK;
}
}
genericReplace:
CompileWord(envPtr, valueTokenPtr, interp, 1);
tokenPtr = TokenAfter(valueTokenPtr);
CompileWord(envPtr, tokenPtr, interp, 2);
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 3);
if (replacementTokenPtr != NULL) {
CompileWord(envPtr, replacementTokenPtr, interp, 4);
if (parsePtr->numWords == 5) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 4);
} else {
PUSH( "");
}
OP( STR_REPLACE);
return TCL_OK;
}
}
int
+1 -1
View File
@@ -22,7 +22,7 @@
* The tree is composed of OpNodes.
*/
typedef struct OpNode {
typedef struct {
int left; /* "Pointer" to the left operand. */
int right; /* "Pointer" to the right operand. */
union {
+4 -22
View File
@@ -129,10 +129,6 @@ InstructionDesc const tclInstructionTable[] = {
{"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) if stktop expr object is false */
{"lor", 1, -1, 0, {OPERAND_NONE}},
/* Logical or: push (stknext || stktop) */
{"land", 1, -1, 0, {OPERAND_NONE}},
/* Logical and: push (stknext && stktop) */
{"bitor", 1, -1, 0, {OPERAND_NONE}},
/* Bitwise or: push (stknext | stktop) */
{"bitxor", 1, -1, 0, {OPERAND_NONE}},
@@ -173,10 +169,6 @@ InstructionDesc const tclInstructionTable[] = {
/* Bitwise not: push ~stktop */
{"not", 1, 0, 0, {OPERAND_NONE}},
/* Logical not: push !stktop */
{"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}},
/* Call builtin math function with index op1; any args are on stk */
{"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
{"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
/* Try converting stktop to first int then double if possible. */
@@ -186,13 +178,6 @@ InstructionDesc const tclInstructionTable[] = {
/* Skip to next iteration of closest enclosing loop; if none, return
* TCL_CONTINUE code. */
{"foreach_start4", 5, 0, 1, {OPERAND_AUX4}},
/* Initialize execution of a foreach loop. Operand is aux data index
* of the ForeachInfo structure for the foreach command. */
{"foreach_step4", 5, +1, 1, {OPERAND_AUX4}},
/* "Step" or begin next iteration of foreach loop. Push 0 if to
* terminate loop, else push 1. */
{"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
/* Record start of catch with the operand's exception index. Push the
* current stack depth onto a special catch stack. */
@@ -340,9 +325,6 @@ InstructionDesc const tclInstructionTable[] = {
{"dictNext", 5, +3, 1, {OPERAND_LVT4}},
/* Get the next iteration from the iterator in op4's local scalar.
* Stack: ... => ... value key doneBool */
{"dictDone", 5, 0, 1, {OPERAND_LVT4}},
/* Terminate the iterator in op4's local scalar. Use unsetScalar
* instead (with 0 for flags). */
{"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}},
/* Create the variables (described in the aux data referred to by the
* second immediate argument) to mirror the state of the dictionary in
@@ -853,8 +835,8 @@ TclSetByteCodeFromAny(
* instruction generator boundaries.
*/
if (iPtr->extra.optimizer) {
(iPtr->extra.optimizer)(&compEnv);
if (iPtr->optimizer) {
(iPtr->optimizer)(&compEnv);
}
/*
@@ -1132,7 +1114,7 @@ CleanupByteCode(
}
}
if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
TclFreeLocalCache(interp, codePtr->localCachePtr);
}
@@ -1428,7 +1410,7 @@ TclInitCompileEnv(
{
Interp *iPtr = (Interp *) interp;
assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL);
envPtr->iPtr = iPtr;
envPtr->source = stringPtr;
+244 -262
View File
@@ -87,7 +87,7 @@ typedef enum {
* to a catch PC offset. */
} ExceptionRangeType;
typedef struct ExceptionRange {
typedef struct {
ExceptionRangeType type; /* The kind of ExceptionRange. */
int nestingLevel; /* Static depth of the exception range. Used
* to find the most deeply-nested range
@@ -162,7 +162,7 @@ typedef struct ExceptionAux {
* source offset is not monotonic.
*/
typedef struct CmdLocation {
typedef struct {
int codeOffset; /* Offset of first byte of command code. */
int numCodeBytes; /* Number of bytes for command's code. */
int srcOffset; /* Offset of first char of the command. */
@@ -180,7 +180,7 @@ typedef struct CmdLocation {
* frame and associated information, like the path of a sourced file.
*/
typedef struct ECL {
typedef struct {
int srcOffset; /* Command location to find the entry. */
int nline; /* Number of words in the command */
int *line; /* Line information for all words in the
@@ -190,7 +190,7 @@ typedef struct ECL {
* lines. */
} ECL;
typedef struct ExtCmdLoc {
typedef struct {
int type; /* Context type. */
int start; /* Starting line for compiled script. Needed
* for the extended recompile check in
@@ -417,7 +417,7 @@ typedef struct ByteCode {
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
size_t compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
@@ -429,7 +429,7 @@ typedef struct ByteCode {
* ByteCode was compiled. Used to invalidate
* code when new namespace resolution rules
* are put into effect. */
int refCount; /* Reference count: set 1 when created plus 1
size_t refCount; /* Reference count: set 1 when created plus 1
* for each execution of the code currently
* active. This structure can be freed when
* refCount becomes zero. */
@@ -519,312 +519,292 @@ typedef struct ByteCode {
* Opcodes for the Tcl bytecode instructions. These must correspond to the
* entries in the table of instruction descriptions, tclInstructionTable, in
* tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
* INST_LOR) must match the entries in the array operatorStrings in
* INST_BITOR) must match the entries in the array operatorStrings in
* tclExecute.c.
*/
/* Opcodes 0 to 9 */
#define INST_DONE 0
#define INST_PUSH1 1
#define INST_PUSH4 2
#define INST_POP 3
#define INST_DUP 4
#define INST_STR_CONCAT1 5
#define INST_INVOKE_STK1 6
#define INST_INVOKE_STK4 7
#define INST_EVAL_STK 8
#define INST_EXPR_STK 9
enum TclInstruction {
/* Opcodes 10 to 23 */
#define INST_LOAD_SCALAR1 10
#define INST_LOAD_SCALAR4 11
#define INST_LOAD_SCALAR_STK 12
#define INST_LOAD_ARRAY1 13
#define INST_LOAD_ARRAY4 14
#define INST_LOAD_ARRAY_STK 15
#define INST_LOAD_STK 16
#define INST_STORE_SCALAR1 17
#define INST_STORE_SCALAR4 18
#define INST_STORE_SCALAR_STK 19
#define INST_STORE_ARRAY1 20
#define INST_STORE_ARRAY4 21
#define INST_STORE_ARRAY_STK 22
#define INST_STORE_STK 23
/* Opcodes 0 to 9 */
INST_DONE = 0,
INST_PUSH1,
INST_PUSH4,
INST_POP,
INST_DUP,
INST_STR_CONCAT1,
INST_INVOKE_STK1,
INST_INVOKE_STK4,
INST_EVAL_STK,
INST_EXPR_STK,
/* Opcodes 24 to 33 */
#define INST_INCR_SCALAR1 24
#define INST_INCR_SCALAR_STK 25
#define INST_INCR_ARRAY1 26
#define INST_INCR_ARRAY_STK 27
#define INST_INCR_STK 28
#define INST_INCR_SCALAR1_IMM 29
#define INST_INCR_SCALAR_STK_IMM 30
#define INST_INCR_ARRAY1_IMM 31
#define INST_INCR_ARRAY_STK_IMM 32
#define INST_INCR_STK_IMM 33
/* Opcodes 10 to 23 */
INST_LOAD_SCALAR1,
INST_LOAD_SCALAR4,
INST_LOAD_SCALAR_STK,
INST_LOAD_ARRAY1,
INST_LOAD_ARRAY4,
INST_LOAD_ARRAY_STK,
INST_LOAD_STK,
INST_STORE_SCALAR1,
INST_STORE_SCALAR4,
INST_STORE_SCALAR_STK,
INST_STORE_ARRAY1,
INST_STORE_ARRAY4,
INST_STORE_ARRAY_STK,
INST_STORE_STK,
/* Opcodes 34 to 39 */
#define INST_JUMP1 34
#define INST_JUMP4 35
#define INST_JUMP_TRUE1 36
#define INST_JUMP_TRUE4 37
#define INST_JUMP_FALSE1 38
#define INST_JUMP_FALSE4 39
/* Opcodes 24 to 33 */
INST_INCR_SCALAR1,
INST_INCR_SCALAR_STK,
INST_INCR_ARRAY1,
INST_INCR_ARRAY_STK,
INST_INCR_STK,
INST_INCR_SCALAR1_IMM,
INST_INCR_SCALAR_STK_IMM,
INST_INCR_ARRAY1_IMM,
INST_INCR_ARRAY_STK_IMM,
INST_INCR_STK_IMM,
/* Opcodes 40 to 64 */
#define INST_LOR 40
#define INST_LAND 41
#define INST_BITOR 42
#define INST_BITXOR 43
#define INST_BITAND 44
#define INST_EQ 45
#define INST_NEQ 46
#define INST_LT 47
#define INST_GT 48
#define INST_LE 49
#define INST_GE 50
#define INST_LSHIFT 51
#define INST_RSHIFT 52
#define INST_ADD 53
#define INST_SUB 54
#define INST_MULT 55
#define INST_DIV 56
#define INST_MOD 57
#define INST_UPLUS 58
#define INST_UMINUS 59
#define INST_BITNOT 60
#define INST_LNOT 61
#define INST_CALL_BUILTIN_FUNC1 62
#define INST_CALL_FUNC1 63
#define INST_TRY_CVT_TO_NUMERIC 64
/* Opcodes 34 to 39 */
INST_JUMP1,
INST_JUMP4,
INST_JUMP_TRUE1,
INST_JUMP_TRUE4,
INST_JUMP_FALSE1,
INST_JUMP_FALSE4,
/* Opcodes 65 to 66 */
#define INST_BREAK 65
#define INST_CONTINUE 66
/* Opcodes 42 to 64 */
INST_BITOR,
INST_BITXOR,
INST_BITAND,
INST_EQ,
INST_NEQ,
INST_LT,
INST_GT,
INST_LE,
INST_GE,
INST_LSHIFT,
INST_RSHIFT,
INST_ADD,
INST_SUB,
INST_MULT,
INST_DIV,
INST_MOD,
INST_UPLUS,
INST_UMINUS,
INST_BITNOT,
INST_LNOT,
INST_TRY_CVT_TO_NUMERIC,
/* Opcodes 67 to 68 */
#define INST_FOREACH_START4 67 /* DEPRECATED */
#define INST_FOREACH_STEP4 68 /* DEPRECATED */
/* Opcodes 65 to 66 */
INST_BREAK,
INST_CONTINUE,
/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4 69
#define INST_END_CATCH 70
#define INST_PUSH_RESULT 71
#define INST_PUSH_RETURN_CODE 72
/* Opcodes 69 to 72 */
INST_BEGIN_CATCH4,
INST_END_CATCH,
INST_PUSH_RESULT,
INST_PUSH_RETURN_CODE,
/* Opcodes 73 to 78 */
#define INST_STR_EQ 73
#define INST_STR_NEQ 74
#define INST_STR_CMP 75
#define INST_STR_LEN 76
#define INST_STR_INDEX 77
#define INST_STR_MATCH 78
/* Opcodes 73 to 78 */
INST_STR_EQ,
INST_STR_NEQ,
INST_STR_CMP,
INST_STR_LEN,
INST_STR_INDEX,
INST_STR_MATCH,
/* Opcodes 78 to 81 */
#define INST_LIST 79
#define INST_LIST_INDEX 80
#define INST_LIST_LENGTH 81
/* Opcodes 79 to 81 */
INST_LIST,
INST_LIST_INDEX,
INST_LIST_LENGTH,
/* Opcodes 82 to 87 */
#define INST_APPEND_SCALAR1 82
#define INST_APPEND_SCALAR4 83
#define INST_APPEND_ARRAY1 84
#define INST_APPEND_ARRAY4 85
#define INST_APPEND_ARRAY_STK 86
#define INST_APPEND_STK 87
/* Opcodes 82 to 87 */
INST_APPEND_SCALAR1,
INST_APPEND_SCALAR4,
INST_APPEND_ARRAY1,
INST_APPEND_ARRAY4,
INST_APPEND_ARRAY_STK,
INST_APPEND_STK,
/* Opcodes 88 to 93 */
#define INST_LAPPEND_SCALAR1 88
#define INST_LAPPEND_SCALAR4 89
#define INST_LAPPEND_ARRAY1 90
#define INST_LAPPEND_ARRAY4 91
#define INST_LAPPEND_ARRAY_STK 92
#define INST_LAPPEND_STK 93
/* Opcodes 88 to 93 */
INST_LAPPEND_SCALAR1,
INST_LAPPEND_SCALAR4,
INST_LAPPEND_ARRAY1,
INST_LAPPEND_ARRAY4,
INST_LAPPEND_ARRAY_STK,
INST_LAPPEND_STK,
/* TIP #22 - LINDEX operator with flat arg list */
/* TIP #22 - LINDEX operator with flat arg list */
INST_LIST_INDEX_MULTI,
#define INST_LIST_INDEX_MULTI 94
/*
* TIP #33 - 'lset' command. Code gen also required a Forth-like
* OVER operation.
*/
INST_OVER,
INST_LSET_LIST,
INST_LSET_FLAT,
/*
* TIP #33 - 'lset' command. Code gen also required a Forth-like
* OVER operation.
*/
/* TIP#90 - 'return' command. */
INST_RETURN_IMM,
#define INST_OVER 95
#define INST_LSET_LIST 96
#define INST_LSET_FLAT 97
/* TIP#123 - exponentiation operator. */
INST_EXPON,
/* TIP#90 - 'return' command. */
/* TIP #157 - {*}... (word expansion) language syntax support. */
INST_EXPAND_START,
INST_EXPAND_STKTOP,
INST_INVOKE_EXPANDED,
#define INST_RETURN_IMM 98
/*
* TIP #57 - 'lassign' command. Code generation requires immediate
* LINDEX and LRANGE operators.
*/
INST_LIST_INDEX_IMM,
INST_LIST_RANGE_IMM,
INST_START_CMD,
INST_LIST_IN,
INST_LIST_NOT_IN,
INST_PUSH_RETURN_OPTIONS,
INST_RETURN_STK,
/* TIP#123 - exponentiation operator. */
/*
* Dictionary (TIP#111) related commands.
*/
INST_DICT_GET,
INST_DICT_SET,
INST_DICT_UNSET,
INST_DICT_INCR_IMM,
INST_DICT_APPEND,
INST_DICT_LAPPEND,
INST_DICT_FIRST,
INST_DICT_NEXT,
INST_DICT_UPDATE_START,
INST_DICT_UPDATE_END,
#define INST_EXPON 99
/*
* Instruction to support jumps defined by tables (instead of the classic
* [switch] technique of chained comparisons).
*/
INST_JUMP_TABLE,
/* TIP #157 - {*}... (word expansion) language syntax support. */
/*
* Instructions to support compilation of global, variable, upvar and
* [namespace upvar].
*/
INST_UPVAR,
INST_NSUPVAR,
INST_VARIABLE,
#define INST_EXPAND_START 100
#define INST_EXPAND_STKTOP 101
#define INST_INVOKE_EXPANDED 102
/* Instruction to support compiling syntax error to bytecode */
INST_SYNTAX,
/*
* TIP #57 - 'lassign' command. Code generation requires immediate
* LINDEX and LRANGE operators.
*/
/* Instruction to reverse N items on top of stack */
INST_REVERSE,
#define INST_LIST_INDEX_IMM 103
#define INST_LIST_RANGE_IMM 104
/* regexp instruction */
INST_REGEXP,
#define INST_START_CMD 105
/* For [info exists] compilation */
INST_EXIST_SCALAR,
INST_EXIST_ARRAY,
INST_EXIST_ARRAY_STK,
INST_EXIST_STK,
#define INST_LIST_IN 106
#define INST_LIST_NOT_IN 107
/* For [subst] compilation */
INST_NOP,
INST_RETURN_CODE_BRANCH,
#define INST_PUSH_RETURN_OPTIONS 108
#define INST_RETURN_STK 109
/* For [unset] compilation */
INST_UNSET_SCALAR,
INST_UNSET_ARRAY,
INST_UNSET_ARRAY_STK,
INST_UNSET_STK,
/*
* Dictionary (TIP#111) related commands.
*/
/* For [dict with], [dict exists], [dict create] and [dict merge] */
INST_DICT_EXPAND,
INST_DICT_RECOMBINE_STK,
INST_DICT_RECOMBINE_IMM,
INST_DICT_EXISTS,
INST_DICT_VERIFY,
#define INST_DICT_GET 110
#define INST_DICT_SET 111
#define INST_DICT_UNSET 112
#define INST_DICT_INCR_IMM 113
#define INST_DICT_APPEND 114
#define INST_DICT_LAPPEND 115
#define INST_DICT_FIRST 116
#define INST_DICT_NEXT 117
#define INST_DICT_DONE 118
#define INST_DICT_UPDATE_START 119
#define INST_DICT_UPDATE_END 120
/* For [string map] and [regsub] compilation */
INST_STR_MAP,
INST_STR_FIND,
INST_STR_FIND_LAST,
INST_STR_RANGE_IMM,
INST_STR_RANGE,
/*
* Instruction to support jumps defined by tables (instead of the classic
* [switch] technique of chained comparisons).
*/
/* For operations to do with coroutines and other NRE-manipulators */
INST_YIELD,
INST_COROUTINE_NAME,
INST_TAILCALL,
#define INST_JUMP_TABLE 121
/* For compilation of basic information operations */
INST_NS_CURRENT,
INST_INFO_LEVEL_NUM,
INST_INFO_LEVEL_ARGS,
INST_RESOLVE_COMMAND,
/*
* Instructions to support compilation of global, variable, upvar and
* [namespace upvar].
*/
/* For compilation relating to TclOO */
INST_TCLOO_SELF,
INST_TCLOO_CLASS,
INST_TCLOO_NS,
INST_TCLOO_IS_OBJECT,
#define INST_UPVAR 122
#define INST_NSUPVAR 123
#define INST_VARIABLE 124
/* For compilation of [array] subcommands */
INST_ARRAY_EXISTS_STK,
INST_ARRAY_EXISTS_IMM,
INST_ARRAY_MAKE_STK,
INST_ARRAY_MAKE_IMM,
/* Instruction to support compiling syntax error to bytecode */
INST_INVOKE_REPLACE,
#define INST_SYNTAX 125
INST_LIST_CONCAT,
/* Instruction to reverse N items on top of stack */
INST_EXPAND_DROP,
#define INST_REVERSE 126
/* New foreach implementation */
INST_FOREACH_START,
INST_FOREACH_STEP,
INST_FOREACH_END,
INST_LMAP_COLLECT,
/* regexp instruction */
/* For compilation of [string trim] and related */
INST_STR_TRIM,
INST_STR_TRIM_LEFT,
INST_STR_TRIM_RIGHT,
#define INST_REGEXP 127
INST_CONCAT_STK,
/* For [info exists] compilation */
#define INST_EXIST_SCALAR 128
#define INST_EXIST_ARRAY 129
#define INST_EXIST_ARRAY_STK 130
#define INST_EXIST_STK 131
INST_STR_UPPER,
INST_STR_LOWER,
INST_STR_TITLE,
INST_STR_REPLACE,
/* For [subst] compilation */
#define INST_NOP 132
#define INST_RETURN_CODE_BRANCH 133
INST_ORIGIN_COMMAND,
/* For [unset] compilation */
#define INST_UNSET_SCALAR 134
#define INST_UNSET_ARRAY 135
#define INST_UNSET_ARRAY_STK 136
#define INST_UNSET_STK 137
INST_TCLOO_NEXT,
INST_TCLOO_NEXT_CLASS,
/* For [dict with], [dict exists], [dict create] and [dict merge] */
#define INST_DICT_EXPAND 138
#define INST_DICT_RECOMBINE_STK 139
#define INST_DICT_RECOMBINE_IMM 140
#define INST_DICT_EXISTS 141
#define INST_DICT_VERIFY 142
INST_YIELD_TO_INVOKE,
/* For [string map] and [regsub] compilation */
#define INST_STR_MAP 143
#define INST_STR_FIND 144
#define INST_STR_FIND_LAST 145
#define INST_STR_RANGE_IMM 146
#define INST_STR_RANGE 147
INST_NUM_TYPE,
INST_TRY_CVT_TO_BOOLEAN,
INST_STR_CLASS,
/* For operations to do with coroutines and other NRE-manipulators */
#define INST_YIELD 148
#define INST_COROUTINE_NAME 149
#define INST_TAILCALL 150
INST_LAPPEND_LIST,
INST_LAPPEND_LIST_ARRAY,
INST_LAPPEND_LIST_ARRAY_STK,
INST_LAPPEND_LIST_STK,
/* For compilation of basic information operations */
#define INST_NS_CURRENT 151
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
INST_CLOCK_READ,
/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
#define INST_TCLOO_IS_OBJECT 158
/* The last opcode */
LAST_INST_OPCODE
};
/* For compilation of [array] subcommands */
#define INST_ARRAY_EXISTS_STK 159
#define INST_ARRAY_EXISTS_IMM 160
#define INST_ARRAY_MAKE_STK 161
#define INST_ARRAY_MAKE_IMM 162
#define INST_INVOKE_REPLACE 163
#define INST_LIST_CONCAT 164
#define INST_EXPAND_DROP 165
/* New foreach implementation */
#define INST_FOREACH_START 166
#define INST_FOREACH_STEP 167
#define INST_FOREACH_END 168
#define INST_LMAP_COLLECT 169
/* For compilation of [string trim] and related */
#define INST_STR_TRIM 170
#define INST_STR_TRIM_LEFT 171
#define INST_STR_TRIM_RIGHT 172
#define INST_CONCAT_STK 173
#define INST_STR_UPPER 174
#define INST_STR_LOWER 175
#define INST_STR_TITLE 176
#define INST_STR_REPLACE 177
#define INST_ORIGIN_COMMAND 178
#define INST_TCLOO_NEXT 179
#define INST_TCLOO_NEXT_CLASS 180
#define INST_YIELD_TO_INVOKE 181
#define INST_NUM_TYPE 182
#define INST_TRY_CVT_TO_BOOLEAN 183
#define INST_STR_CLASS 184
#define INST_LAPPEND_LIST 185
#define INST_LAPPEND_LIST_ARRAY 186
#define INST_LAPPEND_LIST_ARRAY_STK 187
#define INST_LAPPEND_LIST_STK 188
#define INST_CLOCK_READ 189
/* The last opcode */
#define LAST_INST_OPCODE 189
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -1120,6 +1100,8 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
int distThreshold);
MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr,
int before, int after, int *indexPtr);
MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr, CompileEnv *envPtr);
+1 -1
View File
@@ -31,7 +31,7 @@
* the (Tcl_Interp *) in which it is stored, and the encoding.
*/
typedef struct QCCD {
typedef struct {
Tcl_Obj *pkg;
Tcl_Interp *interp;
char *encoding;
+175 -246
View File
File diff suppressed because it is too large Load Diff
+10 -10
View File
@@ -235,7 +235,7 @@ AllocChainEntry(
cPtr = ckalloc(sizeof(ChainEntry));
cPtr->entry.key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
cPtr->entry.clientData = NULL;
Tcl_SetHashValue(&cPtr->entry, NULL);
cPtr->prevPtr = cPtr->nextPtr = NULL;
return &cPtr->entry;
@@ -487,15 +487,14 @@ static void
UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Dict *dict = DICT(dictPtr);
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
const int maxFlags = UINT_MAX / sizeof(int);
/*
* This field is the most useful one in the whole hash structure, and it
@@ -517,10 +516,8 @@ UpdateStringOfDict(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else if (numElems > maxFlags) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
flagPtr = ckalloc(numElems * sizeof(int));
flagPtr = ckalloc(numElems);
}
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
@@ -2312,9 +2309,12 @@ DictAppendCmd(
if (objc == 4) {
appendObjPtr = objv[3];
} else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
objc-3, objv+3, &appendObjPtr)) {
return TCL_ERROR;
} else {
appendObjPtr = TclStringCat(interp, objc-3, objv+3,
TCL_STRING_IN_PLACE);
if (appendObjPtr == NULL) {
return TCL_ERROR;
}
}
}
+13 -13
View File
@@ -254,7 +254,7 @@ DisassembleByteCodeObj(
Tcl_Obj *bufferObj, *fileObj;
TclNewObj(bufferObj);
if (codePtr->refCount <= 0) {
if (!codePtr->refCount) {
return bufferObj; /* Already freed. */
}
@@ -267,9 +267,9 @@ DisassembleByteCodeObj(
*/
Tcl_AppendPrintfToObj(bufferObj,
"ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
"ByteCode %p, refCt %" TCL_LL_MODIFIER "d, epoch %" TCL_LL_MODIFIER "d, interp %p (epoch %" TCL_LL_MODIFIER "d)\n",
codePtr, (Tcl_WideUInt)codePtr->refCount, (Tcl_WideUInt)codePtr->compileEpoch, iPtr,
(Tcl_WideUInt)iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
@@ -312,8 +312,8 @@ DisassembleByteCodeObj(
int numCompiledLocals = procPtr->numCompiledLocals;
Tcl_AppendPrintfToObj(bufferObj,
" Proc %p, refCt %d, args %d, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
" Proc %p, refCt %" TCL_LL_MODIFIER "d, args %d, compiled locals %d\n",
procPtr, (Tcl_WideUInt)procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
@@ -797,7 +797,7 @@ TclNewInstNameObj(
Tcl_Obj *objPtr = Tcl_NewObj();
objPtr->typePtr = &tclInstNameType;
objPtr->internalRep.longValue = (long) inst;
objPtr->internalRep.wideValue = (long) inst;
objPtr->bytes = NULL;
return objPtr;
@@ -817,17 +817,17 @@ static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
int inst = objPtr->internalRep.longValue;
char *s, buf[20];
int len;
size_t len, inst = (size_t)objPtr->internalRep.wideValue;
char *s, buf[TCL_INTEGER_SPACE + 5];
if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
sprintf(buf, "inst_%d", inst);
if (inst >= LAST_INST_OPCODE) {
sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
s = buf;
} else {
s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
s = (char *) tclInstructionTable[inst].name;
}
len = strlen(s);
/* assert (len < UINT_MAX) */
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, s, len + 1);
objPtr->length = len;
+25 -70
View File
@@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src);
* convert between various character sets and UTF-8.
*/
typedef struct Encoding {
typedef struct {
char *name; /* Name of encoding. Malloced because (1) hash
* table entry that owns this encoding may be
* freed prior to this encoding being freed,
@@ -57,7 +57,7 @@ typedef struct Encoding {
* encoding.
*/
typedef struct TableEncodingData {
typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
@@ -91,7 +91,7 @@ typedef struct TableEncodingData {
* for switching character sets.
*/
typedef struct EscapeSubTable {
typedef struct {
unsigned sequenceLen; /* Length of following string. */
char sequence[16]; /* Escape code that marks this encoding. */
char name[32]; /* Name for encoding. */
@@ -100,7 +100,7 @@ typedef struct EscapeSubTable {
* yet. */
} EscapeSubTable;
typedef struct EscapeEncodingData {
typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
@@ -675,68 +675,6 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexUnlock(&encodingMutex);
}
/*
*-------------------------------------------------------------------------
*
* Tcl_GetDefaultEncodingDir --
*
* Legacy public interface to retrieve first directory in the encoding
* searchPath.
*
* Results:
* The directory pathname, as a string, or NULL for an empty encoding
* search path.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
const char *
Tcl_GetDefaultEncodingDir(void)
{
int numDirs;
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
Tcl_ListObjLength(NULL, searchPath, &numDirs);
if (numDirs == 0) {
return NULL;
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
return TclGetString(first);
}
/*
*-------------------------------------------------------------------------
*
* Tcl_SetDefaultEncodingDir --
*
* Legacy public interface to set the first directory in the encoding
* search path.
*
* Results:
* None.
*
* Side effects:
* Modifies the encoding search path.
*
*-------------------------------------------------------------------------
*/
void
Tcl_SetDefaultEncodingDir(
const char *path)
{
Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
Tcl_Obj *directory = Tcl_NewStringObj(path, -1);
searchPath = Tcl_DuplicateObj(searchPath);
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
Tcl_SetEncodingSearchPath(searchPath);
}
/*
*-------------------------------------------------------------------------
*
@@ -2357,8 +2295,15 @@ UtfToUtfProc(
src += 1;
dst += Tcl_UniCharToUtf(*chPtr, dst);
} else {
src += TclUtfToUniChar(src, chPtr);
int len = TclUtfToUniChar(src, chPtr);
src += len;
dst += Tcl_UniCharToUtf(*chPtr, dst);
#if TCL_UTF_MAX <= 4
if (!len) {
src += TclUtfToUniChar(src, chPtr);
dst += Tcl_UniCharToUtf(*chPtr, dst);
}
#endif
}
}
@@ -2764,7 +2709,7 @@ TableFromUtfProc(
}
len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX > 3
#if TCL_UTF_MAX > 4
/*
* This prevents a crash condition. More evaluation is required for
* full support of int Tcl_UniChar. [Bug 1004065]
@@ -2773,6 +2718,10 @@ TableFromUtfProc(
if (ch & 0xffff0000) {
word = 0;
} else
#else
if (!len) {
word = 0;
} else
#endif
word = fromUnicode[(ch >> 8)][ch & 0xff];
@@ -2970,12 +2919,18 @@ Iso88591FromUtfProc(
* Check for illegal characters.
*/
if (ch > 0xff) {
if (ch > 0xff
#if TCL_UTF_MAX <= 4
|| !len
#endif
) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
break;
}
#if TCL_UTF_MAX <= 4
if (!len) len = 4;
#endif
/*
* Plunge on, using '?' as a fallback character.
*/
+187 -149
View File
@@ -146,10 +146,12 @@ TclNamespaceEnsembleCmd(
Tcl_Obj *const objv[])
{
Tcl_Namespace *namespacePtr;
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
const char *simpleName;
int index, done;
if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
@@ -195,13 +197,8 @@ TclNamespaceEnsembleCmd(
objv += 2;
objc -= 2;
/*
* Work out what name to use for the command to create. If supplied,
* it is either fully specified or relative to the current namespace.
* If not supplied, it is exactly the name of the current namespace.
*/
name = nsPtr->fullName;
name = nsPtr->name;
cxtPtr = (Namespace *) nsPtr->parentPtr;
/*
* Parse the option list, applying type checks as we go. Note that we
@@ -221,6 +218,7 @@ TclNamespaceEnsembleCmd(
switch ((enum EnsCreateOpts) index) {
case CRT_CMD:
name = TclGetString(objv[1]);
cxtPtr = nsPtr;
continue;
case CRT_SUBCMDS:
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
@@ -337,6 +335,10 @@ TclNamespaceEnsembleCmd(
}
}
TclGetNamespaceForQualName(interp, name, cxtPtr,
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
&simpleName);
/*
* Create the ensemble. Note that this might delete another ensemble
* linked to the same namespace, so we must be careful. However, we
@@ -344,8 +346,9 @@ TclNamespaceEnsembleCmd(
* we've created it (and after any deletions have occurred.)
*/
token = Tcl_CreateEnsemble(interp, name, NULL,
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
token = TclCreateEnsembleInNs(interp, simpleName,
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -636,48 +639,38 @@ TclNamespaceEnsembleCmd(
/*
*----------------------------------------------------------------------
*
* Tcl_CreateEnsemble --
* TclCreateEnsembleInNs --
*
* Create a simple ensemble attached to the given namespace.
*
* Results:
* The token for the command created.
*
* Side effects:
* The ensemble is created and marked for compilation.
* Like Tcl_CreateEnsemble, but additionally accepts as an argument the
* name of the namespace to create the command in.
*
*----------------------------------------------------------------------
*/
Tcl_Command
Tcl_CreateEnsemble(
TclCreateEnsembleInNs(
Tcl_Interp *interp,
const char *name,
Tcl_Namespace *namespacePtr,
int flags)
const char *name, /* Simple name of command to create (no */
/* namespace components). */
Tcl_Namespace /* Name of namespace to create the command in. */
*nameNsPtr,
Tcl_Namespace
*ensembleNsPtr, /* Name of the namespace for the ensemble. */
int flags
)
{
Namespace *nsPtr = (Namespace *) namespacePtr;
EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
Tcl_Obj *nameObj = NULL;
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
EnsembleConfig *ensemblePtr;
Tcl_Command token;
if (nsPtr == NULL) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
/*
* Make the name of the ensemble into a fully qualified name. This might
* allocate a temporary object.
*/
if (!(name[0] == ':' && name[1] == ':')) {
nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
if (nsPtr->parentPtr == NULL) {
Tcl_AppendStringsToObj(nameObj, name, NULL);
} else {
Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
}
Tcl_IncrRefCount(nameObj);
name = TclGetString(nameObj);
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
token = TclNRCreateCommandInNs(interp, name,
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
if (token == NULL) {
ckfree(ensemblePtr);
return NULL;
}
ensemblePtr->nsPtr = nsPtr;
@@ -690,9 +683,7 @@ Tcl_CreateEnsemble(
ensemblePtr->numParameters = 0;
ensemblePtr->parameterList = NULL;
ensemblePtr->unknownHandler = NULL;
ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
ensemblePtr, DeleteEnsembleConfig);
ensemblePtr->token = token;
ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
@@ -709,11 +700,52 @@ Tcl_CreateEnsemble(
((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
}
if (nameObj != NULL) {
TclDecrRefCount(nameObj);
}
return ensemblePtr->token;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateEnsemble
*
* Create a simple ensemble attached to the given namespace.
*
* Deprecated by TclCreateEnsembleInNs.
*
* Value
*
* The token for the command created.
*
* Effect
* The ensemble is created and marked for compilation.
*
*
*----------------------------------------------------------------------
*/
Tcl_Command
Tcl_CreateEnsemble(
Tcl_Interp *interp,
const char *name,
Tcl_Namespace *namespacePtr,
int flags)
{
Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
*actualNsPtr;
const char * simpleName;
if (nsPtr == NULL) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
return TclCreateEnsembleInNs(interp, simpleName,
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}
/*
*----------------------------------------------------------------------
@@ -1885,6 +1917,7 @@ NsEnsembleImplementationCmdNR(
TclSkipTailcall(interp);
Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
@@ -2398,14 +2431,32 @@ MakeCachedEnsembleCommand(
*----------------------------------------------------------------------
*/
static void
ClearTable(
EnsembleConfig *ensemblePtr)
{
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
if (hash->numEntries != 0) {
Tcl_HashSearch search;
Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);
while (hPtr != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
Tcl_DecrRefCount(prefixObj);
hPtr = Tcl_NextHashEntry(&search);
}
ckfree((char *) ensemblePtr->subcommandArrayPtr);
}
Tcl_DeleteHashTable(hash);
}
static void
DeleteEnsembleConfig(
ClientData clientData)
{
EnsembleConfig *ensemblePtr = clientData;
Namespace *nsPtr = ensemblePtr->nsPtr;
Tcl_HashSearch search;
Tcl_HashEntry *hEnt;
/*
* Unlink from the ensemble chain if it has not been marked as having been
@@ -2439,17 +2490,7 @@ DeleteEnsembleConfig(
* Kill the pointer-containing fields.
*/
if (ensemblePtr->subcommandTable.numEntries != 0) {
ckfree(ensemblePtr->subcommandArrayPtr);
}
hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
while (hEnt != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
Tcl_DecrRefCount(prefixObj);
hEnt = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
ClearTable(ensemblePtr);
if (ensemblePtr->subcmdList != NULL) {
Tcl_DecrRefCount(ensemblePtr->subcmdList);
}
@@ -2505,100 +2546,101 @@ BuildEnsembleConfig(
int i, j, isNew;
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
Tcl_HashEntry *hPtr;
Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
Tcl_Obj *subList = ensemblePtr->subcmdList;
if (hash->numEntries != 0) {
/*
* Remove pre-existing table.
*/
ClearTable(ensemblePtr);
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
ckfree(ensemblePtr->subcommandArrayPtr);
hPtr = Tcl_FirstHashEntry(hash, &search);
while (hPtr != NULL) {
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
if (subList) {
int subc;
Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
char *name;
Tcl_DecrRefCount(prefixObj);
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(hash);
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
}
/*
* There is a list of exactly what subcommands go in the table.
* Must determine the target for each.
*/
/*
* See if we've got an export list. If so, we will only export exactly
* those commands, which may be either implemented by the prefix in the
* subcommandDict or mapped directly onto the namespace's commands.
*/
Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
if (subList == mapDict) {
/*
* Strange case where explicit list of subcommands is same value
* as the dict mapping to targets.
*/
if (ensemblePtr->subcmdList != NULL) {
Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
int subcmdc;
for (i = 0; i < subc; i += 2) {
name = TclGetString(subv[i]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
if (!isNew) {
cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
Tcl_DecrRefCount(cmdObj);
}
Tcl_SetHashValue(hPtr, subv[i+1]);
Tcl_IncrRefCount(subv[i+1]);
TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
&subcmdv);
for (i=0 ; i<subcmdc ; i++) {
const char *name = TclGetString(subcmdv[i]);
name = TclGetString(subv[i+1]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
if (isNew) {
cmdObj = Tcl_NewStringObj(name, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
}
}
} else {
/* Usual case where we can freely act on the list and dict. */
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
for (i = 0; i < subc; i++) {
name = TclGetString(subv[i]);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
if (!isNew) {
continue;
}
/*
* Skip non-unique cases.
*/
/* Lookup target in the dictionary */
if (mapDict) {
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
if (target) {
Tcl_SetHashValue(hPtr, target);
Tcl_IncrRefCount(target);
continue;
}
}
if (!isNew) {
continue;
}
/*
* target was not in the dictionary so map onto the namespace.
* Note in this case that we do not guarantee that the
* command is actually there; that is the programmer's
* responsibility (or [::unknown] of course).
*/
cmdObj = Tcl_NewStringObj(name, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
}
}
} else if (mapDict) {
/*
* No subcmd list, but we do have a mapping dictionary so we should
* use the keys of that. Convert the dictionary's contents into the
* form required for the ensemble's internal hashtable.
*/
/*
* Look in our dictionary (if present) for the command.
*/
Tcl_DictSearch dictSearch;
Tcl_Obj *keyObj, *valueObj;
int done;
if (ensemblePtr->subcommandDict != NULL) {
Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
&target);
if (target != NULL) {
Tcl_SetHashValue(hPtr, target);
Tcl_IncrRefCount(target);
continue;
}
}
Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
&keyObj, &valueObj, &done);
while (!done) {
char *name = TclGetString(keyObj);
/*
* Not there, so map onto the namespace. Note in this case that we
* do not guarantee that the command is actually there; that is
* the programmer's responsibility (or [::unknown] of course).
*/
cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
if (ensemblePtr->nsPtr->parentPtr != NULL) {
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
} else {
Tcl_AppendStringsToObj(cmdObj, name, NULL);
}
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
}
} else if (ensemblePtr->subcommandDict != NULL) {
/*
* No subcmd list, but we do have a mapping dictionary so we should
* use the keys of that. Convert the dictionary's contents into the
* form required for the ensemble's internal hashtable.
*/
Tcl_DictSearch dictSearch;
Tcl_Obj *keyObj, *valueObj;
int done;
Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
&keyObj, &valueObj, &done);
while (!done) {
const char *name = TclGetString(keyObj);
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
Tcl_SetHashValue(hPtr, valueObj);
Tcl_IncrRefCount(valueObj);
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
}
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
Tcl_SetHashValue(hPtr, valueObj);
Tcl_IncrRefCount(valueObj);
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
}
} else {
/*
* Discover what commands are actually exported by the namespace.
@@ -2634,11 +2676,7 @@ BuildEnsembleConfig(
if (isNew) {
Tcl_Obj *cmdObj, *cmdPrefixObj;
TclNewObj(cmdObj);
Tcl_AppendStringsToObj(cmdObj,
ensemblePtr->nsPtr->fullName,
(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
nsCmdName, NULL);
cmdObj = Tcl_NewStringObj(nsCmdName, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
-1
View File
@@ -1057,7 +1057,6 @@ TclInitSubsystems(void)
* mutexes. */
TclInitIOSubsystem(); /* Inits a tsd key (noop). */
TclInitEncodingSubsystem(); /* Process wide encoding init. */
TclpSetInterfaces();
TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
subsystemsInitialized = 1;
}
+358 -1108
View File
File diff suppressed because it is too large Load Diff
+10 -10
View File
@@ -363,14 +363,7 @@ TclFileDeleteCmd(
*/
if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
/*
* Trying to delete a file that does not exist is not considered
* an error, just a no-op
*/
if (errno != ENOENT) {
result = TCL_ERROR;
}
result = TCL_ERROR;
} else if (S_ISDIR(statBuf.st_mode)) {
/*
* We own a reference count on errorBuffer, if it was set as a
@@ -406,13 +399,20 @@ TclFileDeleteCmd(
}
if (result != TCL_OK) {
result = TCL_ERROR;
/*
* Avoid possible race condition (file/directory deleted after call
* of lstat), so bypass ENOENT because not an error, just a no-op
*/
if (errno == ENOENT) {
result = TCL_OK;
continue;
}
/*
* It is important that we break on error, otherwise we might end
* up owning reference counts on numerous errorBuffers.
*/
result = TCL_ERROR;
break;
}
}
+1 -1
View File
@@ -142,7 +142,7 @@ Tcl_GetBoolean(
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
*boolPtr = obj.internalRep.longValue;
*boolPtr = obj.internalRep.wideValue != 0;
}
return code;
}
+18 -43
View File
@@ -13,13 +13,6 @@
#include "tclInt.h"
/*
* Prevent macros from clashing with function definitions.
*/
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
/*
* When there are this many entries per bucket, on average, rebuild the hash
* table to make it larger.
@@ -35,7 +28,7 @@
*/
#define RANDOM_INDEX(tablePtr, i) \
((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)
/*
* Prototypes for the array hash key methods.
@@ -200,7 +193,7 @@ Tcl_InitCustomHashTable(
/*
*----------------------------------------------------------------------
*
* Tcl_FindHashEntry --
* FindHashEntry --
*
* Given a hash table find the entry with a matching key.
*
@@ -214,14 +207,6 @@ Tcl_InitCustomHashTable(
*----------------------------------------------------------------------
*/
Tcl_HashEntry *
Tcl_FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const void *key) /* Key to use to find matching entry. */
{
return (*((tablePtr)->findProc))(tablePtr, key);
}
static Tcl_HashEntry *
FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -234,7 +219,7 @@ FindHashEntry(
/*
*----------------------------------------------------------------------
*
* Tcl_CreateHashEntry --
* CreateHashEntry --
*
* Given a hash table with string keys, and a string key, find the entry
* with a matching key. If there is no matching entry, then create a new
@@ -252,17 +237,6 @@ FindHashEntry(
*----------------------------------------------------------------------
*/
Tcl_HashEntry *
Tcl_CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const void *key, /* Key to use to find or create matching
* entry. */
int *newPtr) /* Store info here telling whether a new entry
* was created. */
{
return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
}
static Tcl_HashEntry *
CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -274,7 +248,7 @@ CreateHashEntry(
register Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
unsigned int hash;
int index;
unsigned int index;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
@@ -308,7 +282,7 @@ CreateHashEntry(
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
if (hash != PTR2UINT(hPtr->hash)) {
if (hash != hPtr->hash) {
continue;
}
if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
@@ -321,7 +295,7 @@ CreateHashEntry(
} else {
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
if (hash != PTR2UINT(hPtr->hash)) {
if (hash != hPtr->hash) {
continue;
}
if (key == hPtr->key.oneWordValue) {
@@ -351,7 +325,7 @@ CreateHashEntry(
}
hPtr->tablePtr = tablePtr;
hPtr->hash = UINT2PTR(hash);
hPtr->hash = hash;
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
tablePtr->numEntries++;
@@ -393,7 +367,7 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
int index;
unsigned int index;
tablePtr = entryPtr->tablePtr;
@@ -410,9 +384,9 @@ Tcl_DeleteHashEntry(
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
index = RANDOM_INDEX(tablePtr, entryPtr->hash);
} else {
index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
index = entryPtr->hash & tablePtr->mask;
}
bucketPtr = &tablePtr->buckets[index];
@@ -767,14 +741,14 @@ HashArrayKey(
void *keyPtr) /* Key from which to compute hash value. */
{
register const int *array = (const int *) keyPtr;
register unsigned int result;
register TCL_HASH_TYPE result;
int count;
for (result = 0, count = tablePtr->keyType; count > 0;
count--, array++) {
result += *array;
}
return (TCL_HASH_TYPE) result;
return result;
}
/*
@@ -863,7 +837,7 @@ HashStringKey(
void *keyPtr) /* Key from which to compute hash value. */
{
register const char *string = keyPtr;
register unsigned int result;
register TCL_HASH_TYPE result;
register char c;
/*
@@ -903,7 +877,7 @@ HashStringKey(
result += (result << 3) + UCHAR(c);
}
}
return (TCL_HASH_TYPE) result;
return result;
}
/*
@@ -985,7 +959,8 @@ static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
int count, index, oldSize = tablePtr->numBuckets;
int count, oldSize = tablePtr->numBuckets;
unsigned int index;
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
@@ -1038,9 +1013,9 @@ RebuildTable(
*oldChainPtr = hPtr->nextPtr;
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
index = RANDOM_INDEX(tablePtr, hPtr->hash);
} else {
index = PTR2UINT(hPtr->hash) & tablePtr->mask;
index = hPtr->hash & tablePtr->mask;
}
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
+13 -21
View File
@@ -721,17 +721,18 @@ Tcl_SetStdChannel(
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int init = channel ? 1 : -1;
switch (type) {
case TCL_STDIN:
tsdPtr->stdinInitialized = 1;
tsdPtr->stdinInitialized = init;
tsdPtr->stdinChannel = channel;
break;
case TCL_STDOUT:
tsdPtr->stdoutInitialized = 1;
tsdPtr->stdoutInitialized = init;
tsdPtr->stdoutChannel = channel;
break;
case TCL_STDERR:
tsdPtr->stderrInitialized = 1;
tsdPtr->stderrInitialized = init;
tsdPtr->stderrChannel = channel;
break;
}
@@ -768,8 +769,8 @@ Tcl_GetStdChannel(
switch (type) {
case TCL_STDIN:
if (!tsdPtr->stdinInitialized) {
tsdPtr->stdinInitialized = -1;
tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
tsdPtr->stdinInitialized = 1;
/*
* Artificially bump the refcount to ensure that the channel is
@@ -781,6 +782,7 @@ Tcl_GetStdChannel(
*/
if (tsdPtr->stdinChannel != NULL) {
tsdPtr->stdinInitialized = 1;
Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);
}
}
@@ -788,9 +790,10 @@ Tcl_GetStdChannel(
break;
case TCL_STDOUT:
if (!tsdPtr->stdoutInitialized) {
tsdPtr->stdoutInitialized = -1;
tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
tsdPtr->stdoutInitialized = 1;
if (tsdPtr->stdoutChannel != NULL) {
tsdPtr->stdoutInitialized = 1;
Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);
}
}
@@ -798,9 +801,10 @@ Tcl_GetStdChannel(
break;
case TCL_STDERR:
if (!tsdPtr->stderrInitialized) {
tsdPtr->stderrInitialized = -1;
tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
tsdPtr->stderrInitialized = 1;
if (tsdPtr->stderrChannel != NULL) {
tsdPtr->stderrInitialized = 1;
Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
}
}
@@ -1068,7 +1072,7 @@ CheckForStdChannelsBeingClosed(
ChannelState *statePtr = ((Channel *) chan)->state;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->stdinInitialized
if (tsdPtr->stdinInitialized == 1
&& tsdPtr->stdinChannel != NULL
&& statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
if (statePtr->refCount < 2) {
@@ -1076,7 +1080,7 @@ CheckForStdChannelsBeingClosed(
tsdPtr->stdinChannel = NULL;
return;
}
} else if (tsdPtr->stdoutInitialized
} else if (tsdPtr->stdoutInitialized == 1
&& tsdPtr->stdoutChannel != NULL
&& statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
if (statePtr->refCount < 2) {
@@ -1084,7 +1088,7 @@ CheckForStdChannelsBeingClosed(
tsdPtr->stdoutChannel = NULL;
return;
}
} else if (tsdPtr->stderrInitialized
} else if (tsdPtr->stderrInitialized == 1
&& tsdPtr->stderrChannel != NULL
&& statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
if (statePtr->refCount < 2) {
@@ -9032,18 +9036,6 @@ ZeroTransferTimerProc(
*----------------------------------------------------------------------
*/
int
TclCopyChannelOld(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Channel inChan, /* Channel to read from. */
Tcl_Channel outChan, /* Channel to write to. */
int toRead, /* Amount of data to copy, or -1 for all. */
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
{
return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
cmdPtr);
}
int
TclCopyChannel(
Tcl_Interp *interp, /* Current interpreter. */
+1 -28
View File
@@ -15,7 +15,7 @@
* Callback structure for accept callback in a TCP server.
*/
typedef struct AcceptCallback {
typedef struct {
Tcl_Obj *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
@@ -137,19 +137,6 @@ Tcl_PutsObjCmd(
chanObjPtr = objv[2];
string = objv[3];
break;
#if TCL_MAJOR_VERSION < 9
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
* maybe even earlier.
*/
chanObjPtr = objv[1];
string = objv[2];
break;
#endif
}
/* Fall through */
default: /* [puts] or
@@ -439,25 +426,11 @@ Tcl_ReadObjCmd(
if (i < objc) {
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
#if TCL_MAJOR_VERSION < 9
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
* maybe even earlier.
*/
if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
#endif
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected non-negative integer but got \"%s\"",
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
#if TCL_MAJOR_VERSION < 9
}
newline = 1;
#endif
}
}
+3 -3
View File
@@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = {
* layers upon reading from the channel, plus the functions to manage such.
*/
typedef struct _ResultBuffer_ {
typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
int allocated; /* Allocated size of the buffer area. */
int used; /* Number of bytes in the buffer,
@@ -253,7 +253,7 @@ typedef enum {
* sharing problems.
*/
typedef struct ForwardParamBase {
typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
@@ -298,7 +298,7 @@ typedef struct ForwardingResult ForwardingResult;
* General event structure, with reference to operation specific data.
*/
typedef struct ForwardingEvent {
typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
+1 -1
View File
@@ -223,7 +223,7 @@ TclCreateSocketAddress(
* using AI_ADDRCONFIG is probably low even in situations where it works,
* we'll leave it out for now. After all, it is just an optimisation.
*
* Missing on: OpenBSD, NetBSD.
* Missing on NetBSD.
* Causes failure when used on AIX 5.1 and HP-UX
*/
+1 -11
View File
@@ -245,7 +245,7 @@ static Tcl_ThreadDataKey fsDataKey;
* code.
*/
typedef struct FsDivertLoad {
typedef struct {
Tcl_LoadHandle loadHandle;
Tcl_FSUnloadFileProc *unloadProcPtr;
Tcl_Obj *divertedFile;
@@ -412,7 +412,6 @@ Tcl_GetCwd(
return Tcl_DStringValue(cwdPtr);
}
/* Obsolete */
int
Tcl_EvalFile(
Tcl_Interp *interp, /* Interpreter in which to process file. */
@@ -831,15 +830,6 @@ TclResetFilesystem(void)
if (++theFilesystemEpoch == 0) {
++theFilesystemEpoch;
}
#ifdef _WIN32
/*
* Cleans up the win32 API filesystem proc lookup table. This must happen
* very late in finalization so that deleting of copied dlls can occur.
*/
TclWinResetInterfaces();
#endif
}
/*
+4 -32
View File
@@ -876,33 +876,11 @@ Tcl_WrongNumArgs(
* NULL. */
{
Tcl_Obj *objPtr;
int i, len, elemLen, flags;
int i, len, elemLen;
char flags;
Interp *iPtr = (Interp *) interp;
const char *elementStr;
/*
* [incr Tcl] does something fairly horrific when generating error
* messages for its ensembles; it passes the whole set of ensemble
* arguments as a list in the first argument. This means that this code
* causes a problem in iTcl if it attempts to correctly quote all
* arguments, which would be the correct thing to do. We work around this
* nasty behaviour for now, and hope that we can remove it all in the
* future...
*/
#ifndef AVOID_HACKS_FOR_ITCL
int isFirst = 1; /* Special flag used to inhibit the treating
* of the first word as a list element so the
* hacky way Itcl generates error messages for
* its ensembles will still work. [Bug
* 1066837] */
# define MAY_QUOTE_WORD (!isFirst)
# define AFTER_FIRST_WORD (isFirst = 0)
#else /* !AVOID_HACKS_FOR_ITCL */
# define MAY_QUOTE_WORD 1
# define AFTER_FIRST_WORD (void) 0
#endif /* AVOID_HACKS_FOR_ITCL */
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
@@ -969,7 +947,7 @@ Tcl_WrongNumArgs(
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned)len + 1);
@@ -981,8 +959,6 @@ Tcl_WrongNumArgs(
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
AFTER_FIRST_WORD;
/*
* Add a space if the word is not the last one (which has a
* moderately complex condition here).
@@ -1020,7 +996,7 @@ Tcl_WrongNumArgs(
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned) len + 1);
@@ -1033,8 +1009,6 @@ Tcl_WrongNumArgs(
}
}
AFTER_FIRST_WORD;
/*
* Append a space character (" ") if there is more text to follow
* (either another element from objv, or the message string).
@@ -1057,8 +1031,6 @@ Tcl_WrongNumArgs(
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
#undef MAY_QUOTE_WORD
#undef AFTER_FIRST_WORD
}
/*
+189 -163
View File
@@ -50,10 +50,11 @@ declare 6 {
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
declare 8 {
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}
# Removed in 9.0:
#declare 8 {
# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}
# TclCreatePipeline unofficially exported for use by BLT.
@@ -73,7 +74,7 @@ declare 11 {
declare 12 {
void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}
# Removed in 8.5
# Removed in 8.5:
#declare 13 {
# int TclDoGlob(Tcl_Interp *interp, char *separators,
# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
@@ -88,7 +89,7 @@ declare 14 {
declare 16 {
void TclExprFloatError(Tcl_Interp *interp, double value)
}
# Removed in 8.4
# Removed in 8.4:
#declare 17 {
# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
@@ -114,7 +115,7 @@ declare 23 {
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
int TclFormatInt(char *buffer, long n)
int TclFormatInt(char *buffer, Tcl_WideInt n)
}
declare 25 {
void TclFreePackageInfo(Interp *iPtr)
@@ -123,7 +124,7 @@ declare 25 {
# declare 26 {
# char *TclGetCwd(Tcl_Interp *interp)
# }
# Removed in 8.5
# Removed in 8.5:
#declare 27 {
# int TclGetDate(char *p, unsigned long now, long zone,
# unsigned long *timePtr)
@@ -147,7 +148,7 @@ declare 32 {
int TclGetFrame(Tcl_Interp *interp, const char *str,
CallFrame **framePtrPtr)
}
# Removed in Tcl 8.5
# Removed in 8.5:
#declare 33 {
# TclCmdProcType TclGetInterpProc(void)
#}
@@ -160,7 +161,7 @@ declare 34 {
# Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
# int flags)
#}
# Removed in 8.6a2
# Removed in 8.6a2:
#declare 36 {
# int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
@@ -183,11 +184,11 @@ 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 Tcl 8.5a2
# Removed in 8.5a2:
#declare 43 {
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 44 {
@@ -220,14 +221,14 @@ declare 50 {
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
# Removed in Tcl 8.5a2
# Removed in 8.5a2:
#declare 52 {
# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 53 {
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
int argc, CONST84 char **argv)
int argc, const char **argv)
}
declare 54 {
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
@@ -273,7 +274,7 @@ declare 64 {
int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int flags)
}
# Removed in Tcl 8.5a2
# Removed in 8.5a2:
#declare 65 {
# int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
# Tcl_Obj *const objv[], int flags)
@@ -314,10 +315,10 @@ declare 76 {
unsigned long TclpGetSeconds(void)
}
# deprecated
declare 77 {
void TclpGetTime(Tcl_Time *time)
}
# Removed in 9.0:
#declare 77 {
# void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
# int TclpGetTimeZone(unsigned long time)
@@ -357,10 +358,11 @@ declare 81 {
# declare 87 {
# void TclPlatformInit(Tcl_Interp *interp)
# }
declare 88 {
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags)
}
# Removed in 9.0:
#declare 88 {
# char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
# const char *name1, const char *name2, int flags)
#}
declare 89 {
int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
Tcl_Command cmd)
@@ -380,7 +382,7 @@ declare 92 {
declare 93 {
void TclProcDeleteProc(ClientData clientData)
}
# Removed in Tcl 8.5:
# Removed in 8.5:
#declare 94 {
# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
# int argc, const char **argv)
@@ -410,7 +412,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)
@@ -419,9 +421,10 @@ declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
declare 104 {
int TclSockMinimumBuffersOld(int sock, int size)
}
# Removed in 9.0:
#declare 104 {
# int TclSockMinimumBuffersOld(int sock, int size)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
# int TclStat(const char *path, Tcl_StatBuf *buf)
@@ -454,29 +457,35 @@ declare 111 {
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 112 {
int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
declare 113 {
Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 114 {
void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 115 {
int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst)
}
declare 116 {
Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 117 {
Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
# Removed in 9.0:
#declare 112 {
# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {
# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern, int resetListFirst)
#}
# Removed in 9.0:
#declare 116 {
# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
# Tcl_Namespace *contextNsPtr, int flags)
#}
# Removed in 9.0:
#declare 117 {
# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
# Tcl_Namespace *contextNsPtr, int flags)
#}
declare 118 {
int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolverInfo *resInfo)
@@ -489,31 +498,37 @@ declare 120 {
Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 121 {
int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern)
}
declare 122 {
Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 123 {
void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
declare 124 {
Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
}
declare 125 {
Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
}
# Removed in 9.0:
#declare 121 {
# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern)
#}
# Removed in 9.0:
#declare 122 {
# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 123 {
# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
# Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 124 {
# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 125 {
# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
#}
declare 126 {
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
declare 127 {
int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite)
}
# Removed in 9.0:
#declare 127 {
# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern, int allowOverwrite)
#}
declare 128 {
void Tcl_PopCallFrame(Tcl_Interp *interp)
}
@@ -532,9 +547,10 @@ declare 131 {
declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
declare 133 {
struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 9.0
#declare 133 {
# struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
# Removed in 8.5
#declare 134 {
# size_t TclpStrftime(char *s, size_t maxsize, const char *format,
@@ -550,7 +566,7 @@ declare 133 {
# int TclpChdir(const char *dirName)
#}
declare 138 {
CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
@@ -562,7 +578,7 @@ declare 138 {
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -625,14 +641,14 @@ declare 156 {
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
declare 158 {
void TclSetStartupScriptFileName(const char *filename)
}
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
declare 159 {
const char *TclGetStartupScriptFileName(void)
}
# REMOVED - use public Tcl_SetStartupScript()
#declare 158 {
# void TclSetStartupScriptFileName(const char *filename)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 159 {
# const char *TclGetStartupScriptFileName(void)
#}
#declare 160 {
# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
# Tcl_DString *dirPtr, char *pattern, char *tail,
@@ -677,14 +693,14 @@ declare 166 {
}
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
declare 167 {
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
declare 168 {
Tcl_Obj *TclGetStartupScriptPath(void)
}
# REMOVED - use public Tcl_SetStartupScript()
#declare 167 {
# void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
# Tcl_Obj *TclGetStartupScriptPath(void)
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
@@ -730,13 +746,13 @@ declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
# TIP 338 made these public - now declared in tcl.h too
declare 178 {
void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
declare 179 {
Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
}
# TIP 338 made these public - now declared in tcl.h
#declare 178 {
# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
#}
# REMOVED
# Allocate lists without copying arrays
@@ -748,14 +764,14 @@ declare 179 {
# const char *file, int line)
#}
# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
declare 182 {
struct tm *TclpLocaltime(const time_t *clock)
}
declare 183 {
struct tm *TclpGmtime(const time_t *clock)
}
# Removed in 9.0
#declare 182 {
# struct tm *TclpLocaltime(const time_t *clock)
#}
# Removed in 9.0
#declare 183 {
# struct tm *TclpGmtime(const time_t *clock)
#}
# For the new "Thread Storage" subsystem.
@@ -940,9 +956,9 @@ declare 235 {
# TIP 337 made this one public
declare 236 {
void TclBackgroundException(Tcl_Interp *interp, int code)
}
#declare 236 {
# void TclBackgroundException(Tcl_Interp *interp, int code)
#}
# TIP #285: Script cancellation support.
declare 237 {
@@ -1051,17 +1067,20 @@ interface tclIntPlat
declare 0 win {
void TclWinConvertError(DWORD errCode)
}
declare 1 win {
void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
struct servent *TclWinGetServByName(const char *nm,
const char *proto)
}
declare 3 win {
int TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
}
# Removed in 9.0:
#declare 1 win {
# void TclWinConvertWSAError(DWORD errCode)
#}
# Removed in 9.0:
#declare 2 win {
# struct servent *TclWinGetServByName(const char *nm,
# const char *proto)
#}
# Removed in 9.0:
#declare 3 win {
# int TclWinGetSockOpt(SOCKET s, int level, int optname,
# char *optval, int *optlen)
#}
declare 4 win {
HINSTANCE TclWinGetTclInstance(void)
}
@@ -1073,24 +1092,27 @@ declare 5 win {
# declare 5 win {
# HINSTANCE TclWinLoadLibrary(char *name)
# }
declare 6 win {
unsigned short TclWinNToHS(unsigned short ns)
}
declare 7 win {
int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
}
# Removed in 9.0:
#declare 6 win {
# unsigned short TclWinNToHS(unsigned short ns)
#}
# Removed in 9.0:
#declare 7 win {
# int TclWinSetSockOpt(SOCKET s, int level, int optname,
# const char *optval, int optlen)
#}
declare 8 win {
int TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
int TclWinGetPlatformId(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 10 win {
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Removed in 8.3.1 (for Win32s only)
# Removed in 9.0:
#declare 9 win {
# int TclWinGetPlatformId(void)
#}
# Removed in 9.0:
#declare 10 win {
# Tcl_DirEntry *TclpReaddir(DIR *dir)
#}
# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}
@@ -1140,10 +1162,10 @@ declare 19 win {
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
# new for 8.4.20+/8.5.12+
declare 21 win {
char *TclpInetNtoa(struct in_addr addr)
}
# Removed in 9.0:
#declare 21 win {
# char *TclpInetNtoa(struct in_addr addr)
#}
# removed permanently for 8.4
#declare 21 win {
# void TclpAsyncMark(Tcl_AsyncHandler async)
@@ -1164,9 +1186,10 @@ declare 24 win {
#declare 25 win {
# TclPlatformType *TclWinGetPlatform(void)
#}
declare 26 win {
void TclWinSetInterfaces(int wide)
}
# Removed in 9.0:
#declare 26 win {
# void TclWinSetInterfaces(int wide)
#}
# Added in Tcl 8.3.3 / 8.4
@@ -1176,9 +1199,10 @@ declare 27 win {
# Added in 8.4.2
declare 28 win {
void TclWinResetInterfaces(void)
}
# Removed in 9.0:
#declare 28 win {
# void TclWinResetInterfaces(void)
#}
################################
# Unix specific functions
@@ -1225,20 +1249,22 @@ declare 9 unix {
# Added in 8.4:
declare 10 unix {
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
declare 11 unix {
struct tm *TclpLocaltime_unix(const time_t *clock)
}
declare 12 unix {
struct tm *TclpGmtime_unix(const time_t *clock)
}
declare 13 unix {
char *TclpInetNtoa(struct in_addr addr)
}
# Removed in 9.0:
#declare 10 unix {
# Tcl_DirEntry *TclpReaddir(DIR *dir)
#}
# Removed in 9.0:
#declare 11 unix {
# struct tm *TclpLocaltime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 12 unix {
# struct tm *TclpGmtime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 13 unix {
# char *TclpInetNtoa(struct in_addr addr)
#}
# Added in 8.5:
+165 -120
View File
@@ -25,19 +25,6 @@
#undef ACCEPT_NAN
/*
* In Tcl 8.7, stop supporting special hacks for legacy Itcl 3.
* Itcl 4 doesn't need them. Itcl 3 can be updated to not need them
* using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+
* releases. Perhaps Tcl 8.7 will add even better public interfaces
* supporting all the re-invocation mechanisms extensions like Itcl 3
* need. As an absolute last resort, folks who must make Itcl 3 work
* unchanged with Tcl 8.7 can remove this line to regain the migration
* support. Tcl 9 will no longer offer even that option.
*/
#define AVOID_HACKS_FOR_ITCL 1
/*
* Common include files needed by most of the Tcl source files are included
* here, so that system-dependent personalizations for the include files only
@@ -161,13 +148,13 @@ typedef struct Tcl_ResolvedVarInfo {
} Tcl_ResolvedVarInfo;
typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
CONST84 char *name, int length, Tcl_Namespace *context,
const char *name, int length, Tcl_Namespace *context,
Tcl_ResolvedVarInfo **rPtr);
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
typedef struct Tcl_ResolverInfo {
@@ -191,9 +178,6 @@ typedef struct Tcl_ResolverInfo {
* - Bug #696893 - variable is either proc-local or in the current
* namespace; never follow the second (global) resolution path
* - Bug #631741 - do not use special namespace or interp resolvers
*
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
* (Bug #835020)
*/
#define TCL_AVOID_RESOLVERS 0x40000
@@ -275,7 +259,7 @@ typedef struct Namespace {
* frames for this namespace that are on the
* Tcl call stack. The namespace won't be
* freed until activationCount becomes zero. */
int refCount; /* Count of references by namespaceName
size_t refCount; /* Count of references by namespaceName
* objects. The namespace can't be freed until
* refCount becomes zero. */
Tcl_HashTable cmdTable; /* Contains all the commands currently
@@ -427,7 +411,7 @@ struct NamespacePathEntry {
*/
typedef struct EnsembleConfig {
Namespace *nsPtr; /* The namspace backing this ensemble up. */
Namespace *nsPtr; /* The namespace backing this ensemble up. */
Tcl_Command token; /* The token for the command that provides
* ensemble support for the namespace, or NULL
* if the command has been deleted (or never
@@ -546,7 +530,7 @@ typedef struct CommandTrace {
struct CommandTrace *nextPtr;
/* Next in list of traces associated with a
* particular command. */
int refCount; /* Used to ensure this structure is not
size_t refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
@@ -619,7 +603,7 @@ typedef struct Var {
typedef struct VarInHash {
Var var;
int refCount; /* Counts number of active uses of this
size_t refCount; /* Counts number of active uses of this
* variable: 1 for the entry in the hash
* table, 1 for each additional variable whose
* linkPtr points here, 1 for each nested
@@ -951,7 +935,7 @@ typedef struct CompiledLocal {
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command is
* defined. */
int refCount; /* Reference count: 1 if still present in
size_t refCount; /* Reference count: 1 if still present in
* command table plus 1 for each call to the
* procedure that is currently active. This
* structure can be freed when refCount
@@ -1068,7 +1052,7 @@ typedef struct AssocData {
*/
typedef struct LocalCache {
int refCount;
size_t refCount;
int numVars;
Tcl_Obj *varName0;
} LocalCache;
@@ -1230,7 +1214,7 @@ typedef struct CmdFrame {
typedef struct CFWord {
CmdFrame *framePtr; /* CmdFrame to access. */
int word; /* Index of the word in the command. */
int refCount; /* Number of times the word is on the
size_t refCount; /* Number of times the word is on the
* stack. */
} CFWord;
@@ -1493,11 +1477,11 @@ typedef struct LiteralEntry {
* NULL if end of chain. */
Tcl_Obj *objPtr; /* Points to Tcl object that holds the
* literal's bytes and length. */
int refCount; /* If in an interpreter's global literal
size_t refCount; /* If in an interpreter's global literal
* table, the number of ByteCode structures
* that share the literal object; the literal
* entry can be freed when refCount drops to
* 0. If in a local literal table, -1. */
* 0. If in a local literal table, (size_t)-1. */
Namespace *nsPtr; /* Namespace in which this literal is used. We
* try to avoid sharing literal non-FQ command
* names among different namespaces to reduce
@@ -1517,7 +1501,7 @@ typedef struct LiteralTable {
* table. */
int rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
int mask; /* Mask value used in hashing function. */
unsigned int mask; /* Mask value used in hashing function. */
} LiteralTable;
/*
@@ -1635,7 +1619,7 @@ typedef struct Command {
* recreated). */
Namespace *nsPtr; /* Points to the namespace containing this
* command. */
int refCount; /* 1 if in command hashtable plus 1 for each
size_t refCount; /* 1 if in command hashtable plus 1 for each
* reference from a CmdName Tcl object
* representing a command's name in a ByteCode
* instruction sequence. This structure can be
@@ -1811,15 +1795,7 @@ typedef struct Interp {
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
union {
void (*optimizer)(void *envPtr);
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
* unused space in interp was repurposed for
* pluggable bytecode optimizers. The core
* contains one optimizer, which can be
* selectively overriden by extensions. */
} extra;
void (*optimizer)(void *envPtr);
/*
* Information related to procedures and variables. See tclProc.c and
* tclVar.c for usage.
@@ -1875,7 +1851,7 @@ typedef struct Interp {
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
unsigned int compileEpoch; /* Holds the current "compilation epoch" for
size_t compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
* invalidate existing ByteCodes when, e.g., a
* command with a compile procedure is
@@ -2216,7 +2192,7 @@ typedef struct Interp {
* use the rand() or srand() functions.
* SAFE_INTERP: Non zero means that the current interp is a safe
* interp (i.e. it has only the safe commands installed,
* less priviledge than a regular interp).
* less privilege than a regular interp).
* INTERP_DEBUG_FRAME: Used for switching on various extra interpreter
* debug/info mechanisms (e.g. info frame eval/uplevel
* tracing) which are performance intensive.
@@ -2349,7 +2325,7 @@ typedef enum TclEolTranslation {
*/
typedef struct List {
int refCount;
size_t refCount;
int maxElemCount; /* Total number of element array slots. */
int elemCount; /* Current number of list elements. */
int canonicalFlag; /* Set if the string representation was
@@ -2357,7 +2333,7 @@ typedef struct List {
* be ignored if there is no string rep at
* all.*/
Tcl_Obj *elements; /* First list element; the struct is grown to
* accomodate all elements. */
* accommodate all elements. */
} List;
#define LIST_MAX \
@@ -2410,40 +2386,45 @@ typedef struct List {
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
/*
* Macros providing a faster path to integers: Tcl_GetLongFromObj,
* Tcl_GetIntFromObj and TclGetIntForIndex.
* Macros providing a faster path to booleans and integers:
* Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
* and TclGetIntForIndex.
*
* WARNING: these macros eval their args more than once.
*/
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
(((objPtr)->typePtr == &tclIntType \
|| (objPtr)->typePtr == &tclBooleanType) \
? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#if (LONG_MAX == INT_MAX)
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX)) \
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.longValue >= -(Tcl_WideInt)(UINT_MAX) \
&& (objPtr)->internalRep.longValue <= (Tcl_WideInt)(UINT_MAX)) \
? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.longValue >= INT_MIN \
&& (objPtr)->internalRep.longValue <= INT_MAX) \
? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
&& (objPtr)->internalRep.wideValue >= INT_MIN \
&& (objPtr)->internalRep.wideValue <= INT_MAX) \
? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#endif
/*
* Macro used to save a function call for common uses of
@@ -2453,21 +2434,11 @@ typedef struct List {
* Tcl_WideInt *wideIntPtr);
*/
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(wideIntPtr) = (Tcl_WideInt) \
((objPtr)->internalRep.longValue), TCL_OK) : \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclWideIntType) \
? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
((objPtr)->typePtr == &tclIntType) \
? (*(wideIntPtr) = (Tcl_WideInt) \
((objPtr)->internalRep.longValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */
/*
* Flag values for TclTraceDictPath().
@@ -2479,13 +2450,13 @@ typedef struct List {
* tip of the path, so duplication of shared objects should be done along the
* way.
*
* DICT_PATH_EXISTS indicates that we are performing an existance test and a
* DICT_PATH_EXISTS indicates that we are performing an existence test and a
* lookup failure should therefore not be an error. If (and only if) this flag
* is set, TclTraceDictPath() will return the special value
* DICT_PATH_NON_EXISTENT if the path is not traceable.
*
* DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set)
* indicates that we are to create non-existant dictionaries on the path.
* indicates that we are to create non-existent dictionaries on the path.
*/
#define DICT_PATH_READ 0
@@ -2693,9 +2664,6 @@ MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
#ifndef TCL_WIDE_INT_IS_LONG
MODULE_SCOPE const Tcl_ObjType tclWideIntType;
#endif
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;
@@ -2730,6 +2698,10 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
MODULE_SCOPE char tclEmptyString;
enum CheckEmptyStringResult {
TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
};
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside world,
@@ -2745,6 +2717,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
@@ -2858,8 +2831,6 @@ MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
CmdFrame *cfPtr);
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
int strLen, const unsigned char *pattern,
@@ -2867,10 +2838,14 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
MODULE_SCOPE double TclCeil(const mp_int *a);
MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
@@ -2880,12 +2855,25 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
Tcl_Interp *interp,
const char *name,
Tcl_Namespace *nameNamespacePtr,
Tcl_Namespace *ensembleNamespacePtr,
int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evulation, with line information. */
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
int *clNextOuter, const char *outerScript);
@@ -2908,6 +2896,8 @@ MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp,
Tcl_Namespace *namespacePtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
@@ -2934,6 +2924,15 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *encodingName);
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
@@ -3006,6 +3005,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n,
int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
int toIdx);
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
@@ -3094,7 +3095,6 @@ MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_PathPart portion);
MODULE_SCOPE char * TclpReadlink(const char *fileName,
Tcl_DString *linkPtr);
MODULE_SCOPE void TclpSetInterfaces(void);
MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp);
MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
@@ -3108,7 +3108,7 @@ MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
int *quantifiersFoundPtr);
MODULE_SCOPE int TclScanElement(const char *string, int length,
int *flagPtr);
char *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
@@ -3125,20 +3125,10 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int inPlace,
int objc, Tcl_Obj *const objv[],
Tcl_Obj **objPtrPtr);
MODULE_SCOPE int TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
int start);
MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
int last);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE int TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
int count, Tcl_Obj **objPtrPtr);
MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes,
int numBytes, int flags, int line,
struct CompileEnv *envPtr);
@@ -3150,10 +3140,13 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count, int *tokensLeftPtr, int line,
int *clNextOuter, const char *outerScript);
MODULE_SCOPE int TclTrim(const char *bytes, int numBytes,
const char *trim, int numTrim, int *trimRight);
MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
const char *trim, int numTrim);
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
const char *trim, int numTrim);
MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
@@ -3203,11 +3196,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#ifndef TCL_NO_DEPRECATED
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#endif
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3941,6 +3929,30 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
/*
* Routines that provide the [string] ensemble functionality. Possible
* candidates for public interface.
*/
MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags);
MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
int start);
MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
int last);
MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
int count, int flags);
MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
int first, int count, Tcl_Obj *insertPtr,
int flags);
MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags);
/* Flag values for the [string] ensemble functions. */
#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)
/*
* Functions defined in generic/tclVar.c and currently exported only for use
@@ -3997,6 +4009,45 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE int TclFullFinalizationRequested(void);
/*
* TIP #462.
*/
/*
* The following enum values give the status of a spawned process.
*/
typedef enum TclProcessWaitStatus {
TCL_PROCESS_ERROR = -1, /* Error waiting for process to exit */
TCL_PROCESS_UNCHANGED = 0, /* No change since the last call. */
TCL_PROCESS_EXITED = 1, /* Process has exited. */
TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
TCL_PROCESS_UNKNOWN_STATUS = 4
/* Child wait status didn't make sense. */
} TclProcessWaitStatus;
MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
int *codePtr, Tcl_Obj **msgObjPtr,
Tcl_Obj **errorObjPtr);
/*
* Utility routines for encoding index values as integers. Used by both
* some of the command compilers and by [lsort] and [lsearch].
*/
MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
int before, int after, int *indexPtr);
MODULE_SCOPE int TclIndexDecode(int encoded, int endValue);
/* Constants used in index value encoding routines. */
#define TCL_INDEX_END (-2)
#define TCL_INDEX_BEFORE (-1)
#define TCL_INDEX_START (0)
#define TCL_INDEX_AFTER (INT_MAX)
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
@@ -4381,7 +4432,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclUtfToUniChar(str, chPtr) \
((((unsigned char) *(str)) < 0xC0) ? \
((((unsigned char) *(str)) < 0x80) ? \
((*(chPtr) = (unsigned char) *(str)), 1) \
: Tcl_UtfToUniChar(str, chPtr))
@@ -4426,6 +4477,12 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclIsPureList(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to compare Unicode strings. On big-endian
@@ -4506,30 +4563,19 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* core. They should only be called on unshared objects. The ANSI C
* "prototypes" for these macros are:
*
* MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue);
* MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
*----------------------------------------------------------------
*/
#define TclSetLongObj(objPtr, i) \
#define TclSetIntObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
(objPtr)->internalRep.longValue = (long)(i); \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
(objPtr)->typePtr = &tclIntType; \
} while (0)
#ifndef TCL_WIDE_INT_IS_LONG
#define TclSetWideIntObj(objPtr, w) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
(objPtr)->typePtr = &tclWideIntType; \
} while (0)
#endif
#define TclSetDoubleObj(objPtr, d) \
do { \
TclInvalidateStringRep(objPtr); \
@@ -4544,8 +4590,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* types, avoiding the corresponding function calls in time critical parts of
* the core. The ANSI C "prototypes" for these macros are:
*
* MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l);
* MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len);
* MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
@@ -4554,13 +4599,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#ifndef TCL_MEM_DEBUG
#define TclNewLongObj(objPtr, i) \
#define TclNewIntObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.longValue = (long)(i); \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
(objPtr)->typePtr = &tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -4587,8 +4632,8 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewLongObj(objPtr, l) \
(objPtr) = Tcl_NewLongObj(l)
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
+90 -230
View File
@@ -28,22 +28,6 @@
# endif
#endif
/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
#undef Tcl_CreateNamespace
#undef Tcl_DeleteNamespace
#undef Tcl_AppendExportList
#undef Tcl_Export
#undef Tcl_Import
#undef Tcl_ForgetImport
#undef Tcl_GetCurrentNamespace
#undef Tcl_GetGlobalNamespace
#undef Tcl_FindNamespace
#undef Tcl_FindCommand
#undef Tcl_GetCommandFromObj
#undef Tcl_GetCommandFullName
#undef Tcl_SetStartupScript
#undef Tcl_GetStartupScript
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
@@ -74,10 +58,7 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
/* 7 */
EXTERN int TclCopyAndCollapse(int count, const char *src,
char *dst);
/* 8 */
EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
int toRead, Tcl_Obj *cmdPtr);
/* Slot 8 is reserved */
/* 9 */
EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc,
const char **argv, Tcl_Pid **pidArrayPtr,
@@ -113,7 +94,7 @@ EXTERN int TclFindElement(Tcl_Interp *interp,
/* 23 */
EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
EXTERN int TclFormatInt(char *buffer, long n);
EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
EXTERN void TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
@@ -151,7 +132,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 */
@@ -173,7 +154,7 @@ EXTERN int TclInterpInit(Tcl_Interp *interp);
/* 53 */
EXTERN int TclInvokeObjectCommand(ClientData clientData,
Tcl_Interp *interp, int argc,
CONST84 char **argv);
const char **argv);
/* 54 */
EXTERN int TclInvokeStringCommand(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -217,8 +198,7 @@ EXTERN void TclpFree(char *ptr);
EXTERN unsigned long TclpGetClicks(void);
/* 76 */
EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
EXTERN void TclpGetTime(Tcl_Time *time);
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -230,10 +210,7 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size);
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
EXTERN char * TclPrecTraceProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
/* Slot 88 is reserved */
/* 89 */
EXTERN int TclPreventAliasLoop(Tcl_Interp *interp,
Tcl_Interp *cmdInterp, Tcl_Command cmd);
@@ -260,14 +237,13 @@ 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 */
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
EXTERN int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -283,25 +259,12 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
Tcl_ResolveCmdProc *cmdProc,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
EXTERN int Tcl_AppendExportList(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
const char *name, ClientData clientData,
Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst);
/* 116 */
EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
/* 118 */
EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp,
const char *name, Tcl_ResolverInfo *resInfo);
@@ -313,25 +276,15 @@ EXTERN int Tcl_GetNamespaceResolvers(
EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
EXTERN int Tcl_ForgetImport(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 123 */
EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
/* 125 */
EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
/* 126 */
EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp,
Tcl_Var variable, Tcl_Obj *objPtr);
/* 127 */
EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite);
/* Slot 127 is reserved */
/* 128 */
EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
@@ -349,20 +302,17 @@ EXTERN void Tcl_SetNamespaceResolvers(
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
EXTERN int TclpHasSockets(Tcl_Interp *interp);
/* 133 */
EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
Tcl_DString *valuePtr);
EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
Tcl_DString *cwdPtr);
EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr, CompileHookProc *hookProc,
@@ -400,10 +350,8 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
/* 157 */
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
const char *varName);
/* 158 */
EXTERN void TclSetStartupScriptFileName(const char *filename);
/* 159 */
EXTERN const char * TclGetStartupScriptFileName(void);
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform(Tcl_Interp *interp,
@@ -421,10 +369,8 @@ EXTERN void TclpSetInitialEncodings(void);
EXTERN int TclListObjSetElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj *valuePtr);
/* 167 */
EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
EXTERN Tcl_Obj * TclGetStartupScriptPath(void);
/* Slot 167 is reserved */
/* Slot 168 is reserved */
/* 169 */
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
unsigned long n);
@@ -456,17 +402,12 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr);
EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
const char *part2, const char *operation,
const char *reason);
/* 178 */
EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr,
const char *encodingName);
/* 179 */
EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
/* Slot 178 is reserved */
/* Slot 179 is reserved */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
EXTERN struct tm * TclpLocaltime(const time_t *clock);
/* 183 */
EXTERN struct tm * TclpGmtime(const time_t *clock);
/* Slot 182 is reserved */
/* Slot 183 is reserved */
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -569,8 +510,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
/* 235 */
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
/* 236 */
EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
/* Slot 236 is reserved */
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -652,7 +592,7 @@ typedef struct TclIntStubs {
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
void (*reserved8)(void);
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
@@ -668,7 +608,7 @@ typedef struct TclIntStubs {
void (*reserved21)(void);
int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
int (*tclFormatInt) (char *buffer, long n); /* 24 */
int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
void (*reserved26)(void);
void (*reserved27)(void);
@@ -686,7 +626,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 */
@@ -697,7 +637,7 @@ typedef struct TclIntStubs {
void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
void (*reserved52)(void);
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
void (*reserved56)(void);
@@ -721,7 +661,7 @@ typedef struct TclIntStubs {
void (*tclpFree) (char *ptr); /* 74 */
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
void (*tclpGetTime) (Tcl_Time *time); /* 77 */
void (*reserved77)(void);
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
@@ -732,7 +672,7 @@ typedef struct TclIntStubs {
void (*reserved85)(void);
void (*reserved86)(void);
void (*reserved87)(void);
char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
void (*reserved88)(void);
int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
void (*reserved90)(void);
void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
@@ -745,10 +685,10 @@ 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 */
int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved104)(void);
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
@@ -756,36 +696,36 @@ typedef struct TclIntStubs {
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
void (*reserved112)(void);
void (*reserved113)(void);
void (*reserved114)(void);
void (*reserved115)(void);
void (*reserved116)(void);
void (*reserved117)(void);
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
void (*reserved121)(void);
void (*reserved122)(void);
void (*reserved123)(void);
void (*reserved124)(void);
void (*reserved125)(void);
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
void (*reserved127)(void);
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
void (*reserved133)(void);
void (*reserved134)(void);
void (*reserved135)(void);
void (*reserved136)(void);
void (*reserved137)(void);
CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
void (*reserved139)(void);
void (*reserved140)(void);
CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
@@ -802,8 +742,8 @@ typedef struct TclIntStubs {
void (*reserved155)(void);
void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
const char * (*tclGetStartupScriptFileName) (void); /* 159 */
void (*reserved158)(void);
void (*reserved159)(void);
void (*reserved160)(void);
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
@@ -811,8 +751,8 @@ typedef struct TclIntStubs {
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
void (*tclpSetInitialEncodings) (void); /* 165 */
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
void (*reserved167)(void);
void (*reserved168)(void);
int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
@@ -822,12 +762,12 @@ typedef struct TclIntStubs {
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
void (*reserved178)(void);
void (*reserved179)(void);
void (*reserved180)(void);
void (*reserved181)(void);
struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
void (*reserved182)(void);
void (*reserved183)(void);
void (*reserved184)(void);
void (*reserved185)(void);
void (*reserved186)(void);
@@ -880,7 +820,7 @@ typedef struct TclIntStubs {
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
@@ -927,8 +867,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCleanupCommand) /* 6 */
#define TclCopyAndCollapse \
(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
#define TclCopyChannelOld \
(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
/* Slot 8 is reserved */
#define TclCreatePipeline \
(tclIntStubsPtr->tclCreatePipeline) /* 9 */
#define TclCreateProc \
@@ -1035,8 +974,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
(tclIntStubsPtr->tclpGetTime) /* 77 */
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -1048,8 +986,7 @@ extern const TclIntStubs *tclIntStubsPtr;
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
#define TclPrecTraceProc \
(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
/* Slot 88 is reserved */
#define TclPreventAliasLoop \
(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
/* Slot 90 is reserved */
@@ -1075,8 +1012,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
(tclIntStubsPtr->tclSockGetPort) /* 103 */
#define TclSockMinimumBuffersOld \
(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -1088,38 +1024,26 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define Tcl_AppendExportList \
(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
#define Tcl_CreateNamespace \
(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
#define Tcl_DeleteNamespace \
(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
#define Tcl_Export \
(tclIntStubsPtr->tcl_Export) /* 115 */
#define Tcl_FindCommand \
(tclIntStubsPtr->tcl_FindCommand) /* 116 */
#define Tcl_FindNamespace \
(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
#define Tcl_GetInterpResolvers \
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
#define Tcl_ForgetImport \
(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
#define Tcl_GetCommandFromObj \
(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
#define Tcl_GetCommandFullName \
(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
#define Tcl_GetCurrentNamespace \
(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
#define Tcl_GetGlobalNamespace \
(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
#define Tcl_GetVariableFullName \
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#define Tcl_Import \
(tclIntStubsPtr->tcl_Import) /* 127 */
/* Slot 127 is reserved */
#define Tcl_PopCallFrame \
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
@@ -1130,8 +1054,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#define TclpHasSockets \
(tclIntStubsPtr->tclpHasSockets) /* 132 */
#define TclpGetDate \
(tclIntStubsPtr->tclpGetDate) /* 133 */
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
@@ -1172,10 +1095,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclRegError) /* 156 */
#define TclVarTraceExists \
(tclIntStubsPtr->tclVarTraceExists) /* 157 */
#define TclSetStartupScriptFileName \
(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
#define TclGetStartupScriptFileName \
(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
#define TclChannelTransform \
(tclIntStubsPtr->tclChannelTransform) /* 161 */
@@ -1189,10 +1110,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
#define TclListObjSetElement \
(tclIntStubsPtr->tclListObjSetElement) /* 166 */
#define TclSetStartupScriptPath \
(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
#define TclGetStartupScriptPath \
(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
/* Slot 167 is reserved */
/* Slot 168 is reserved */
#define TclpUtfNcmp2 \
(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
#define TclCheckInterpTraces \
@@ -1210,16 +1129,12 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
#define Tcl_SetStartupScript \
(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
#define Tcl_GetStartupScript \
(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
/* Slot 178 is reserved */
/* Slot 179 is reserved */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
(tclIntStubsPtr->tclpLocaltime) /* 182 */
#define TclpGmtime \
(tclIntStubsPtr->tclpGmtime) /* 183 */
/* Slot 182 is reserved */
/* Slot 183 is reserved */
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -1300,8 +1215,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
#define TclBackgroundException \
(tclIntStubsPtr->tclBackgroundException) /* 236 */
/* Slot 236 is reserved */
#define TclResetCancellation \
(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
@@ -1350,58 +1264,4 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclGetStartupScriptFileName
#undef TclSetStartupScriptFileName
#undef TclGetStartupScriptPath
#undef TclSetStartupScriptPath
#undef TclBackgroundException
#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
# undef Tcl_SetStartupScript
# define Tcl_SetStartupScript \
(tclStubsPtr->tcl_SetStartupScript) /* 622 */
# undef Tcl_GetStartupScript
# define Tcl_GetStartupScript \
(tclStubsPtr->tcl_GetStartupScript) /* 623 */
# undef Tcl_CreateNamespace
# define Tcl_CreateNamespace \
(tclStubsPtr->tcl_CreateNamespace) /* 506 */
# undef Tcl_DeleteNamespace
# define Tcl_DeleteNamespace \
(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
# undef Tcl_AppendExportList
# define Tcl_AppendExportList \
(tclStubsPtr->tcl_AppendExportList) /* 508 */
# undef Tcl_Export
# define Tcl_Export \
(tclStubsPtr->tcl_Export) /* 509 */
# undef Tcl_Import
# define Tcl_Import \
(tclStubsPtr->tcl_Import) /* 510 */
# undef Tcl_ForgetImport
# define Tcl_ForgetImport \
(tclStubsPtr->tcl_ForgetImport) /* 511 */
# undef Tcl_GetCurrentNamespace
# define Tcl_GetCurrentNamespace \
(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
# undef Tcl_GetGlobalNamespace
# define Tcl_GetGlobalNamespace \
(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
# undef Tcl_FindNamespace
# define Tcl_FindNamespace \
(tclStubsPtr->tcl_FindNamespace) /* 514 */
# undef Tcl_FindCommand
# define Tcl_FindCommand \
(tclStubsPtr->tcl_FindCommand) /* 515 */
# undef Tcl_GetCommandFromObj
# define Tcl_GetCommandFromObj \
(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
# undef Tcl_GetCommandFullName
# define Tcl_GetCommandFullName \
(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#endif
#undef TclCopyChannelOld
#undef TclSockMinimumBuffersOld
#endif /* _TCLINTDECLS */
+55 -108
View File
@@ -71,14 +71,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
/* 11 */
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
@@ -107,29 +103,19 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
EXTERN void TclWinConvertWSAError(DWORD errCode);
/* 2 */
EXTERN struct servent * TclWinGetServByName(const char *nm,
const char *proto);
/* 3 */
EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen);
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
/* 4 */
EXTERN HINSTANCE TclWinGetTclInstance(void);
/* 5 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN unsigned short TclWinNToHS(unsigned short ns);
/* 7 */
EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
EXTERN int TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -158,20 +144,17 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
/* 21 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void TclWinSetInterfaces(int wide);
/* Slot 26 is reserved */
/* 27 */
EXTERN void TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void TclWinResetInterfaces(void);
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
@@ -205,14 +188,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
/* 11 */
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
@@ -269,10 +248,10 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
void (*reserved10)(void);
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
void (*reserved15)(void);
void (*reserved16)(void);
@@ -293,16 +272,16 @@ typedef struct TclIntPlatStubs {
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
void (*reserved1)(void);
void (*reserved2)(void);
void (*reserved3)(void);
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
void (*reserved6)(void);
void (*reserved7)(void);
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
void (*reserved9)(void);
void (*reserved10)(void);
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
@@ -313,14 +292,14 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
void (*reserved21)(void);
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
void (*reserved23)(void);
char * (*tclWinNoBackslash) (char *path); /* 24 */
void (*reserved25)(void);
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*reserved26)(void);
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
@@ -335,10 +314,10 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
void (*reserved10)(void);
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
@@ -391,14 +370,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
/* Slot 15 is reserved */
@@ -423,26 +398,19 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclWinGetServByName \
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
#define TclWinGetSockOpt \
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclWinNToHS \
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */
#define TclpGetPid \
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
/* Slot 9 is reserved */
/* Slot 10 is reserved */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
@@ -463,20 +431,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
/* Slot 26 is reserved */
#define TclWinFlushDirtyChannels \
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
@@ -502,14 +467,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
@@ -543,23 +504,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
#if defined(_WIN32)
# undef TclWinNToHS
# undef TclWinGetServByName
# undef TclWinGetSockOpt
# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
# define TclWinGetServByName getservbyname
# define TclWinGetSockOpt getsockopt
# define TclWinSetSockOpt setsockopt
#else
#if !defined(_WIN32)
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
#endif
+9 -13
View File
@@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL;
struct Target;
/*
* struct Alias:
* Alias:
*
* Stores information about an alias. Is stored in the slave interpreter and
* used by the source command to find the target command in the master when
* the source command is invoked.
*/
typedef struct Alias {
typedef struct {
Tcl_Obj *token; /* Token for the alias command in the slave
* interp. This used to be the command name in
* the slave when the alias was first
@@ -66,14 +66,14 @@ typedef struct Alias {
/*
*
* struct Slave:
* Slave:
*
* Used by the "interp" command to record and find information about slave
* interpreters. Maps from a command name in the master to information about a
* slave interpreter, e.g. what aliases are defined in it.
*/
typedef struct Slave {
typedef struct {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
Tcl_HashEntry *slaveEntryPtr;
/* Hash entry in masters slave table for this
@@ -112,7 +112,7 @@ typedef struct Target {
} Target;
/*
* struct Master:
* Master:
*
* This record is used for two purposes: First, slaveTable (a hashtable) maps
* from names of commands to slave interpreters. This hashtable is used to
@@ -127,7 +127,7 @@ typedef struct Target {
* only load safe extensions.
*/
typedef struct Master {
typedef struct {
Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps
* from command names to Slave records. */
Target *targetsPtr; /* The head of a doubly-linked list of all the
@@ -144,7 +144,7 @@ typedef struct Master {
* on a per-interp basis.
*/
typedef struct InterpInfo {
typedef struct {
Master master; /* Keeps track of all interps for which this
* interp is the Master. */
Slave slave; /* Information necessary for this interp to
@@ -158,7 +158,7 @@ typedef struct InterpInfo {
* likely to work properly on 64-bit architectures.
*/
typedef struct ScriptLimitCallback {
typedef struct {
Tcl_Interp *interp; /* The interpreter in which to execute the
* callback. */
Tcl_Obj *scriptObj; /* The script to execute to perform the
@@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback {
* table. */
} ScriptLimitCallback;
typedef struct ScriptLimitCallbackKey {
typedef struct {
Tcl_Interp *interp; /* The interpreter that the limit callback was
* attached to. This is not the interpreter
* that the callback runs in! */
@@ -3208,10 +3208,6 @@ Tcl_MakeSafe(
(void) Tcl_EvalEx(interp,
"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
"::tcl::mathfunc::min", 0, NULL);
(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
"::tcl::mathfunc::max", 0, NULL);
}
iPtr->flags |= SAFE_INTERP;
+2 -2
View File
@@ -21,7 +21,7 @@
* variable.
*/
typedef struct Link {
typedef struct {
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
Tcl_Obj *varName; /* Name of variable (must be global). This is
* needed during trace callbacks, since the
@@ -654,7 +654,7 @@ static Tcl_ObjType invalidRealType = {
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
SetInvalidRealFromAny /* setFromAnyProc */
NULL /* setFromAnyProc */
};
static int
+95 -24
View File
@@ -136,8 +136,8 @@ NewListIntRep(
*
* AttemptNewList --
*
* Like NewListIntRep, but additionally sets an error message on failure.
*
* Like NewListIntRep, but additionally sets an error message on failure.
*
*----------------------------------------------------------------------
*/
@@ -234,12 +234,12 @@ Tcl_NewListObj(
*----------------------------------------------------------------------
*
* Tcl_DbNewListObj --
*
*
* Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
* file name and line number from its caller. This simplifies debugging
* since the [memory active] command will report the correct file
* name and line number when reporting objects that haven't been freed.
*
*
* When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
*
*----------------------------------------------------------------------
@@ -384,6 +384,87 @@ TclListObjCopy(
return copyPtr;
}
/*
*----------------------------------------------------------------------
*
* TclListObjRange --
*
* Makes a slice of a list value.
* *listPtr must be known to be a valid list.
*
* Results:
* Returns a pointer to the sliced list.
* This may be a new object or the same object if not shared.
*
* Side effects:
* The possible conversion of the object referenced by listPtr
* to a list object.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclListObjRange(
Tcl_Obj *listPtr, /* List object to take a range from. */
int fromIdx, /* Index of first element to include. */
int toIdx) /* Index of last element to include. */
{
Tcl_Obj **elemPtrs;
int listLen, i, newLen;
List *listRepPtr;
TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
if (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx >= listLen) {
toIdx = listLen-1;
}
if (fromIdx > toIdx) {
return Tcl_NewObj();
}
newLen = toIdx - fromIdx + 1;
if (Tcl_IsShared(listPtr) ||
((ListRepPtr(listPtr)->refCount > 1))) {
return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
}
/*
* In-place is possible.
*/
/*
* Even if nothing below cause any changes, we still want the
* string-canonizing effect of [lrange 0 end].
*/
TclInvalidateStringRep(listPtr);
/*
* Delete elements that should not be included.
*/
for (i = 0; i < fromIdx; i++) {
TclDecrRefCount(elemPtrs[i]);
}
for (i = toIdx + 1; i < listLen; i++) {
TclDecrRefCount(elemPtrs[i]);
}
if (fromIdx > 0) {
memmove(elemPtrs, &elemPtrs[fromIdx],
(size_t) newLen * sizeof(Tcl_Obj*));
}
listRepPtr = ListRepPtr(listPtr);
listRepPtr->elemCount = newLen;
return listPtr;
}
/*
*----------------------------------------------------------------------
*
@@ -695,7 +776,7 @@ Tcl_ListObjAppendElement(
* object should be treated as readonly and its 'refCount' is _not_
* incremented. The caller must do that if it holds on to the
* reference.
*
*
* TCL_ERROR
*
* 'listPtr' is not a valid list. An an error message is left in the
@@ -984,11 +1065,7 @@ Tcl_ListObjReplace(
if (listRepPtr == NULL) {
for (i = 0; i < objc; i++) {
/* See bug 3598580 */
#if TCL_MAJOR_VERSION > 8
Tcl_DecrRefCount(objv[i]);
#else
objv[i]->refCount--;
#endif
}
return TCL_ERROR;
}
@@ -1145,17 +1222,11 @@ TclLindexList(
return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
if (indexListCopy->typePtr == &tclListType) {
List *listRepPtr = ListRepPtr(indexListCopy);
{
int indexCount = -1; /* Size of the array of list indices. */
Tcl_Obj **indices = NULL; /* Array of list indices. */
listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
&listRepPtr->elements);
} else {
int indexCount = -1; /* Size of the array of list indices. */
Tcl_Obj **indices = NULL;
/* Array of list indices. */
Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
}
Tcl_DecrRefCount(indexListCopy);
@@ -1337,9 +1408,9 @@ TclLsetList(
* reference. The caller is expected to store the result in the
* variable and decrement its reference count. (INST_STORE_* does
* exactly this.)
*
*
* NULL
*
*
* An error occurred. If 'listPtr' was duplicated, the reference
* count on the duplicate is decremented so that it is 0, causing any
* memory allocated by this function to be freed.
@@ -1938,8 +2009,8 @@ static void
UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
# define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
# define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
int i, length, bytesNeeded = 0;
@@ -1976,7 +2047,7 @@ UpdateStringOfList(
* We know numElems <= LIST_MAX, so this is safe.
*/
flagPtr = ckalloc(numElems * sizeof(int));
flagPtr = ckalloc(numElems);
}
elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
+12 -11
View File
@@ -186,7 +186,7 @@ TclCreateLiteral(
{
LiteralTable *globalTablePtr = &iPtr->literalTable;
LiteralEntry *globalPtr;
int globalHash;
unsigned int globalHash;
Tcl_Obj *objPtr;
/*
@@ -393,7 +393,8 @@ TclRegisterLiteral(
LiteralEntry *globalPtr, *localPtr;
Tcl_Obj *objPtr;
unsigned hash;
int localHash, objIndex, new;
unsigned int localHash;
int objIndex, new;
Namespace *nsPtr;
if (length < 0) {
@@ -537,7 +538,8 @@ TclHideLiteral(
{
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
LiteralTable *localTablePtr = &envPtr->localLitTable;
int localHash, length;
unsigned int localHash;
int length;
const char *bytes;
Tcl_Obj *newObjPtr;
@@ -556,7 +558,7 @@ TclHideLiteral(
lPtr->objPtr = newObjPtr;
bytes = TclGetStringFromObj(newObjPtr, &length);
localHash = (HashString(bytes, length) & localTablePtr->mask);
localHash = HashString(bytes, length) & localTablePtr->mask;
nextPtrPtr = &localTablePtr->buckets[localHash];
for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
@@ -612,7 +614,7 @@ TclAddLiteralObj(
lPtr = &envPtr->literalArrayPtr[objIndex];
lPtr->objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
lPtr->refCount = -1; /* i.e., unused */
lPtr->refCount = (size_t)-1; /* i.e., unused */
lPtr->nextPtr = NULL;
if (litPtrPtr) {
@@ -809,7 +811,8 @@ TclReleaseLiteral(
LiteralTable *globalTablePtr;
register LiteralEntry *entryPtr, *prevPtr;
const char *bytes;
int length, index;
int length;
unsigned int index;
if (iPtr == NULL) {
goto done;
@@ -828,15 +831,13 @@ TclReleaseLiteral(
for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
entryPtr->refCount--;
/*
* If the literal is no longer being used by any ByteCode, delete
* the entry then remove the reference corresponding to the global
* literal table entry (decrement the ref count of the object).
*/
if (entryPtr->refCount == 0) {
if (entryPtr->refCount-- <= 1) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
} else {
@@ -954,8 +955,8 @@ RebuildLiteralTable(
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
const char *bytes;
unsigned int oldSize;
int count, index, length;
unsigned int oldSize, index;
int count, length;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
+1 -1
View File
@@ -471,7 +471,7 @@ Tcl_LoadObjCmd(
if (code != TCL_OK) {
Interp *iPtr = (Interp *) target;
if (iPtr->legacyResult && !iPtr->legacyFreeProc) {
if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) {
/*
* A call to Tcl_InitStubs() determined the caller extension and
* this interp are incompatible in their stubs mechanisms, and
+1 -5
View File
@@ -266,18 +266,14 @@ Tcl_SourceRCFile(
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
if (c != NULL) {
Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1);
Tcl_Close(NULL, c);
Tcl_IncrRefCount(fullNameObj);
if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) {
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
Tcl_WriteChars(chan, "\n", 1);
}
}
Tcl_DecrRefCount(fullNameObj);
}
}
Tcl_DStringFree(&temp);
+39 -13
View File
@@ -52,7 +52,7 @@ static Tcl_ThreadDataKey dataKey;
* with some information that is used to check the cached pointer's validity.
*/
typedef struct ResolvedNsName {
typedef struct {
Namespace *nsPtr; /* A cached pointer to the Namespace that the
* name resolved to. */
Namespace *refNsPtr; /* Points to the namespace context in which
@@ -402,7 +402,7 @@ Tcl_PopCallFrame(
}
if (framePtr->numCompiledLocals > 0) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
if (--framePtr->localCachePtr->refCount == 0) {
if (framePtr->localCachePtr->refCount-- <= 1) {
TclFreeLocalCache(interp, framePtr->localCachePtr);
}
framePtr->localCachePtr = NULL;
@@ -915,6 +915,11 @@ Tcl_DeleteNamespace(
Tcl_HashSearch search;
Command *cmdPtr;
/*
* Ensure that this namespace doesn't get deallocated in the meantime.
*/
nsPtr->refCount++;
/*
* Give anyone interested - notably TclOO - a chance to use this namespace
* normally despite the fact that the namespace is going to go. Allows the
@@ -1047,16 +1052,7 @@ Tcl_DeleteNamespace(
#endif
Tcl_DeleteHashTable(&nsPtr->cmdTable);
/*
* If the reference count is 0, then discard the namespace.
* Otherwise, mark it as "dead" so that it can't be used.
*/
if (nsPtr->refCount == 0) {
NamespaceFree(nsPtr);
} else {
nsPtr->flags |= NS_DEAD;
}
nsPtr ->flags |= NS_DEAD;
} else {
/*
* Restore the ::errorInfo and ::errorCode traces.
@@ -1073,6 +1069,7 @@ Tcl_DeleteNamespace(
nsPtr->flags &= ~(NS_DYING|NS_KILLED);
}
}
TclNsDecrRefCount(nsPtr);
}
/*
@@ -2421,6 +2418,35 @@ TclGetNamespaceForQualName(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclEnsureNamespace --
*
* Provide a namespace that is not deleted.
*
* Value
*
* namespacePtr, if it is not scheduled for deletion, or a pointer to a
* new namespace with the same name otherwise.
*
* Effect
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Namespace *
TclEnsureNamespace(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr)
{
Namespace *nsPtr = (Namespace *) namespacePtr;
if (!(nsPtr->flags & NS_DYING)) {
return namespacePtr;
}
return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
@@ -2638,7 +2664,7 @@ Tcl_FindCommand(
Namespace *nsPtr[2];
register int search;
TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
TclGetNamespaceForQualName(interp, name, cxtNsPtr,
flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
/*
+570 -615
View File
File diff suppressed because it is too large Load Diff
+2 -2
View File
@@ -95,7 +95,7 @@ typedef struct {
/*
* The correct value for the version field of the Tcl_MethodType structure.
* This allows new versions of the structure to be introduced without breaking
* binary compatability.
* binary compatibility.
*/
#define TCL_OO_METHOD_VERSION_CURRENT 1
@@ -122,7 +122,7 @@ typedef struct {
/*
* The correct value for the version field of the Tcl_ObjectMetadataType
* structure. This allows new versions of the structure to be introduced
* without breaking binary compatability.
* without breaking binary compatibility.
*/
#define TCL_OO_METADATA_VERSION_CURRENT 1
-13
View File
@@ -1206,22 +1206,10 @@ TclOOCopyObjectCmd(
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
} else {
const char *name, *namespaceName;
Tcl_DString buffer;
name = TclGetString(objv[2]);
Tcl_DStringInit(&buffer);
if (name[0] == '\0') {
name = NULL;
} else if (name[0]!=':' || name[1]!=':') {
Interp *iPtr = (Interp *) interp;
if (iPtr->varFramePtr != NULL) {
Tcl_DStringAppend(&buffer,
iPtr->varFramePtr->nsPtr->fullName, -1);
}
TclDStringAppendLiteral(&buffer, "::");
Tcl_DStringAppend(&buffer, name, -1);
name = Tcl_DStringValue(&buffer);
}
/*
@@ -1243,7 +1231,6 @@ TclOOCopyObjectCmd(
}
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
Tcl_DStringFree(&buffer);
}
if (o2Ptr == NULL) {
+12 -1
View File
@@ -110,7 +110,12 @@ TclOODeleteContext(
TclOODeleteChain(contextPtr->callPtr);
if (oPtr != NULL) {
TclStackFree(oPtr->fPtr->interp, contextPtr);
DelRef(oPtr);
/*
* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
*/
TclOODecrRefCount(oPtr);
}
}
@@ -900,6 +905,7 @@ InitCallChain(
* ----------------------------------------------------------------------
*
* IsStillValid --
*
* Calculates whether the given call chain can be used for executing a
* method for the given object. The condition on a chain from a cached
* location being reusable is:
@@ -1171,6 +1177,11 @@ TclOOGetCallContext(
returnContext:
contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
contextPtr->oPtr = oPtr;
/*
* Corresponding TclOODecrRefCount() in TclOODeleteContext
*/
AddRef(oPtr);
contextPtr->callPtr = callPtr;
contextPtr->skip = 2;
+72 -27
View File
@@ -123,6 +123,7 @@ static const struct DeclaredSlot slots[] = {
* ----------------------------------------------------------------------
*
* BumpGlobalEpoch --
*
* Utility that ensures that call chains that are invalid will get thrown
* away at an appropriate time. Note that exactly which epoch gets
* advanced will depend on exactly what the class is tangled up in; in
@@ -167,6 +168,7 @@ BumpGlobalEpoch(
* ----------------------------------------------------------------------
*
* RecomputeClassCacheFlag --
*
* Determine whether the object is prototypical of its class, and hence
* able to use the class's method chain cache.
*
@@ -189,6 +191,7 @@ RecomputeClassCacheFlag(
* ----------------------------------------------------------------------
*
* TclOOObjectSetFilters --
*
* Install a list of filter method names into an object.
*
* ----------------------------------------------------------------------
@@ -247,6 +250,7 @@ TclOOObjectSetFilters(
* ----------------------------------------------------------------------
*
* TclOOClassSetFilters --
*
* Install a list of filter method names into a class.
*
* ----------------------------------------------------------------------
@@ -309,6 +313,7 @@ TclOOClassSetFilters(
* ----------------------------------------------------------------------
*
* TclOOObjectSetMixins --
*
* Install a list of mixin classes into an object.
*
* ----------------------------------------------------------------------
@@ -326,9 +331,8 @@ TclOOObjectSetMixins(
if (numMixins == 0) {
if (oPtr->mixins.num != 0) {
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr) {
TclOORemoveFromInstances(oPtr, mixinPtr);
}
TclOORemoveFromInstances(oPtr, mixinPtr);
TclOODecrRefCount(mixinPtr->thisPtr);
}
ckfree(oPtr->mixins.list);
oPtr->mixins.num = 0;
@@ -340,6 +344,7 @@ TclOOObjectSetMixins(
if (mixinPtr && mixinPtr != oPtr->selfCls) {
TclOORemoveFromInstances(oPtr, mixinPtr);
}
TclOODecrRefCount(mixinPtr->thisPtr);
}
oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
sizeof(Class *) * numMixins);
@@ -352,6 +357,8 @@ TclOOObjectSetMixins(
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr != oPtr->selfCls) {
TclOOAddToInstances(oPtr, mixinPtr);
/* For the new copy created by memcpy */
AddRef(mixinPtr->thisPtr);
}
}
}
@@ -362,6 +369,7 @@ TclOOObjectSetMixins(
* ----------------------------------------------------------------------
*
* TclOOClassSetMixins --
*
* Install a list of mixin classes into a class.
*
* ----------------------------------------------------------------------
@@ -381,6 +389,7 @@ TclOOClassSetMixins(
if (classPtr->mixins.num != 0) {
FOREACH(mixinPtr, classPtr->mixins) {
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
TclOODecrRefCount(mixinPtr->thisPtr);
}
ckfree(classPtr->mixins.list);
classPtr->mixins.num = 0;
@@ -389,6 +398,7 @@ TclOOClassSetMixins(
if (classPtr->mixins.num != 0) {
FOREACH(mixinPtr, classPtr->mixins) {
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
TclOODecrRefCount(mixinPtr->thisPtr);
}
classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
sizeof(Class *) * numMixins);
@@ -399,6 +409,8 @@ TclOOClassSetMixins(
memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
FOREACH(mixinPtr, classPtr->mixins) {
TclOOAddToMixinSubs(classPtr, mixinPtr);
/* For the new copy created by memcpy */
AddRef(mixinPtr->thisPtr);
}
}
BumpGlobalEpoch(interp, classPtr);
@@ -408,6 +420,7 @@ TclOOClassSetMixins(
* ----------------------------------------------------------------------
*
* RenameDeleteMethod --
*
* Core of the code to rename and delete methods.
*
* ----------------------------------------------------------------------
@@ -497,6 +510,7 @@ RenameDeleteMethod(
* ----------------------------------------------------------------------
*
* TclOOUnknownDefinition --
*
* Handles what happens when an unknown command is encountered during the
* processing of a definition script. Works by finding a command in the
* operating definition namespace that the requested command is a unique
@@ -575,6 +589,7 @@ TclOOUnknownDefinition(
* ----------------------------------------------------------------------
*
* FindCommand --
*
* Specialized version of Tcl_FindCommand that handles command prefixes
* and disallows namespace magic.
*
@@ -635,6 +650,7 @@ FindCommand(
* ----------------------------------------------------------------------
*
* InitDefineContext --
*
* Does the magic incantations necessary to push the special stack frame
* used when processing object definitions. It is up to the caller to
* dispose of the frame (with TclPopStackFrame) when finished.
@@ -660,7 +676,9 @@ InitDefineContext(
return TCL_ERROR;
}
/* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
/*
* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
*/
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, FRAME_IS_OO_DEFINE);
@@ -675,6 +693,7 @@ InitDefineContext(
* ----------------------------------------------------------------------
*
* TclOOGetDefineCmdContext --
*
* Extracts the magic token from the current stack frame, or returns NULL
* (and leaves an error message) otherwise.
*
@@ -711,6 +730,7 @@ TclOOGetDefineCmdContext(
* ----------------------------------------------------------------------
*
* GetClassInOuterContext --
*
* Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
* context that called oo::define (or equivalent). Note that this may
* have to go up multiple levels to get the level that we started doing
@@ -753,6 +773,7 @@ GetClassInOuterContext(
* ----------------------------------------------------------------------
*
* GenerateErrorInfo --
*
* Factored out code to generate part of the error trace messages.
*
* ----------------------------------------------------------------------
@@ -791,6 +812,7 @@ GenerateErrorInfo(
* ----------------------------------------------------------------------
*
* MagicDefinitionInvoke --
*
* Part of the implementation of the "oo::define" and "oo::objdefine"
* commands that is used to implement the more-than-one-argument case,
* applying ensemble-like tricks with dispatch so that error messages are
@@ -854,6 +876,7 @@ MagicDefinitionInvoke(
* ----------------------------------------------------------------------
*
* TclOODefineObjCmd --
*
* Implementation of the "oo::define" command. Works by effectively doing
* the same as 'namespace eval', but with extra magic applied so that the
* object to be modified is known to the commands in the target
@@ -914,7 +937,7 @@ TclOODefineObjCmd(
} else {
result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
}
DelRef(oPtr);
TclOODecrRefCount(oPtr);
/*
* Restore the previous "current" namespace.
@@ -928,6 +951,7 @@ TclOODefineObjCmd(
* ----------------------------------------------------------------------
*
* TclOOObjDefObjCmd --
*
* Implementation of the "oo::objdefine" command. Works by effectively
* doing the same as 'namespace eval', but with extra magic applied so
* that the object to be modified is known to the commands in the target
@@ -981,7 +1005,7 @@ TclOOObjDefObjCmd(
} else {
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
}
DelRef(oPtr);
TclOODecrRefCount(oPtr);
/*
* Restore the previous "current" namespace.
@@ -995,6 +1019,7 @@ TclOOObjDefObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineSelfObjCmd --
*
* Implementation of the "self" subcommand of the "oo::define" command.
* Works by effectively doing the same as 'namespace eval', but with
* extra magic applied so that the object to be modified is known to the
@@ -1048,7 +1073,7 @@ TclOODefineSelfObjCmd(
} else {
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
}
DelRef(oPtr);
TclOODecrRefCount(oPtr);
/*
* Restore the previous "current" namespace.
@@ -1062,6 +1087,7 @@ TclOODefineSelfObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineObjSelfObjCmd --
*
* Implementation of the "self" subcommand of the "oo::objdefine"
* command.
*
@@ -1095,6 +1121,7 @@ TclOODefineObjSelfObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineClassObjCmd --
*
* Implementation of the "class" subcommand of the "oo::objdefine"
* command.
*
@@ -1110,7 +1137,6 @@ TclOODefineClassObjCmd(
{
Object *oPtr;
Class *clsPtr;
Foundation *fPtr = TclOOGetFoundation(interp);
/*
* Parse the context to get the object to operate on.
@@ -1147,20 +1173,6 @@ TclOODefineClassObjCmd(
return TCL_ERROR;
}
/*
* Apply semantic checks. In particular, classes and non-classes are not
* interchangable (too complicated to do the conversion!) so we must
* produce an error if any attempt is made to swap from one to the other.
*/
if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"may not change a %sclass object into a %sclass object",
(oPtr->classPtr==NULL ? "non-" : ""),
(oPtr->classPtr==NULL ? "" : "non-")));
Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
return TCL_ERROR;
}
/*
* Set the object's class.
@@ -1168,11 +1180,11 @@ TclOODefineClassObjCmd(
if (oPtr->selfCls != clsPtr) {
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
TclOODecrRefCount(oPtr->selfCls->thisPtr);
oPtr->selfCls = clsPtr;
AddRef(oPtr->selfCls->thisPtr);
TclOOAddToInstances(oPtr, oPtr->selfCls);
if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
oPtr->flags &= ~CLASS_GONE;
}
if (oPtr->classPtr != NULL) {
BumpGlobalEpoch(interp, oPtr->classPtr);
} else {
@@ -1186,6 +1198,7 @@ TclOODefineClassObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineConstructorObjCmd --
*
* Implementation of the "constructor" subcommand of the "oo::define"
* command.
*
@@ -1254,6 +1267,7 @@ TclOODefineConstructorObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineDeleteMethodObjCmd --
*
* Implementation of the "deletemethod" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
@@ -1310,6 +1324,7 @@ TclOODefineDeleteMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineDestructorObjCmd --
*
* Implementation of the "destructor" subcommand of the "oo::define"
* command.
*
@@ -1374,6 +1389,7 @@ TclOODefineDestructorObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineExportObjCmd --
*
* Implementation of the "export" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1468,6 +1484,7 @@ TclOODefineExportObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineForwardObjCmd --
*
* Implementation of the "forward" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1528,6 +1545,7 @@ TclOODefineForwardObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineMethodObjCmd --
*
* Implementation of the "method" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1585,6 +1603,7 @@ TclOODefineMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineMixinObjCmd --
*
* Implementation of the "mixin" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1648,6 +1667,7 @@ TclOODefineMixinObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineRenameMethodObjCmd --
*
* Implementation of the "renamemethod" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
@@ -1704,6 +1724,7 @@ TclOODefineRenameMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineUnexportObjCmd --
*
* Implementation of the "unexport" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1798,6 +1819,7 @@ TclOODefineUnexportObjCmd(
* ----------------------------------------------------------------------
*
* Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
*
* How to install a constructor or destructor into a class; API to call
* from C.
*
@@ -1852,6 +1874,7 @@ Tcl_ClassSetDestructor(
* ----------------------------------------------------------------------
*
* TclOODefineSlots --
*
* Create the "::oo::Slot" class and its standard instances. Class
* definition is empty at the stage (added by scripting).
*
@@ -1895,6 +1918,7 @@ TclOODefineSlots(
* ----------------------------------------------------------------------
*
* ClassFilterGet, ClassFilterSet --
*
* Implementation of the "filter" slot accessors of the "oo::define"
* command.
*
@@ -1974,6 +1998,7 @@ ClassFilterSet(
* ----------------------------------------------------------------------
*
* ClassMixinGet, ClassMixinSet --
*
* Implementation of the "mixin" slot accessors of the "oo::define"
* command.
*
@@ -2055,6 +2080,7 @@ ClassMixinSet(
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
i--;
goto freeAndError;
}
if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
@@ -2078,6 +2104,7 @@ ClassMixinSet(
* ----------------------------------------------------------------------
*
* ClassSuperGet, ClassSuperSet --
*
* Implementation of the "superclass" slot accessors of the "oo::define"
* command.
*
@@ -2172,16 +2199,19 @@ ClassSuperSet(
if (superc == 0) {
superclasses = ckrealloc(superclasses, sizeof(Class *));
superclasses[0] = oPtr->fPtr->objectCls;
superc = 1;
if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
superclasses[0] = oPtr->fPtr->classCls;
} else {
superclasses[0] = oPtr->fPtr->objectCls;
}
superc = 1;
AddRef(superclasses[0]->thisPtr);
} else {
for (i=0 ; i<superc ; i++) {
superclasses[i] = GetClassInOuterContext(interp, superv[i],
"only a class can be a superclass");
if (superclasses[i] == NULL) {
i--;
goto failedAfterAlloc;
}
for (j=0 ; j<i ; j++) {
@@ -2198,9 +2228,19 @@ ClassSuperSet(
"attempt to form circular dependency graph", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
failedAfterAlloc:
for (; i > 0; i--) {
TclOODecrRefCount(superclasses[i]->thisPtr);
}
ckfree(superclasses);
return TCL_ERROR;
}
/*
* Corresponding TclOODecrRefCount() is near the end of this
* function.
*/
AddRef(superclasses[i]->thisPtr);
}
}
@@ -2214,6 +2254,7 @@ ClassSuperSet(
if (oPtr->classPtr->superclasses.num != 0) {
FOREACH(superPtr, oPtr->classPtr->superclasses) {
TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
TclOODecrRefCount(superPtr->thisPtr);
}
ckfree(oPtr->classPtr->superclasses.list);
}
@@ -2231,6 +2272,7 @@ ClassSuperSet(
* ----------------------------------------------------------------------
*
* ClassVarsGet, ClassVarsSet --
*
* Implementation of the "variable" slot accessors of the "oo::define"
* command.
*
@@ -2373,6 +2415,7 @@ ClassVarsSet(
* ----------------------------------------------------------------------
*
* ObjectFilterGet, ObjectFilterSet --
*
* Implementation of the "filter" slot accessors of the "oo::objdefine"
* command.
*
@@ -2440,6 +2483,7 @@ ObjFilterSet(
* ----------------------------------------------------------------------
*
* ObjectMixinGet, ObjectMixinSet --
*
* Implementation of the "mixin" slot accessors of the "oo::objdefine"
* command.
*
@@ -2525,6 +2569,7 @@ ObjMixinSet(
* ----------------------------------------------------------------------
*
* ObjectVarsGet, ObjectVarsSet --
*
* Implementation of the "variable" slot accessors of the "oo::objdefine"
* command.
*
+22 -28
View File
@@ -193,9 +193,10 @@ typedef struct Object {
* destroyed. */
#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been
* called. */
#define CLASS_GONE 4 /* Indicates that the class of this object has
* been deleted, and so the object should not
* attempt to remove itself from its class. */
#define CLASS_GONE 4 /* Obsolete. Indicates that the class of this
* object has been deleted, and so the object
* should not attempt to remove itself from its
* class. */
#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
* the class hierarchy and should be treated
* specially during teardown. */
@@ -222,10 +223,6 @@ typedef struct Object {
typedef struct Class {
Object *thisPtr; /* Reference to the object associated with
* this class. */
int refCount; /* Number of strong references to this class.
* Weak references are not counted; the
* purpose of this is to avoid Tcl_Preserve as
* that is quite slow. */
int flags; /* Assorted flags. */
LIST_STATIC(struct Class *) superclasses;
/* List of superclasses, used for generation
@@ -495,6 +492,11 @@ MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
const char *nsNameStr, int objc,
Tcl_Obj *const *objv, int skip,
Tcl_Object *objectPtr);
MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp,
Class *classPtr,
const char *nameStr,
const char *nsNameStr);
MODULE_SCOPE int TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
@@ -524,10 +526,10 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr,
MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr,
Class *mixinPtr);
MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr,
MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr,
Class *superPtr);
MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp,
CallChain *callPtr);
@@ -541,19 +543,22 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
#include "tclOOIntDecls.h"
/*
* Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
*/
#define AddRef(ptr) ((ptr)->refCount++)
/*
* A convenience macro for iterating through the lists used in the internal
* memory management of objects. This is a bit gnarly because we want to do
* the assignment of the picked-out value only when the body test succeeds,
* but we cannot rely on the assigned value being useful, forcing us to do
* some nasty stuff with the comma operator. The compiler's optimizer should
* be able to sort it all out!
*
* memory management of objects.
* REQUIRES DECLARATION: int i;
*/
#define FOREACH(var,ary) \
for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
continue; \
} else if (var = (ary).list[i], 1)
/*
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
@@ -588,17 +593,6 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
} \
} while(0)
/*
* Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
*/
#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do { \
if ((ptr)->refCount-- <= 1) { \
ckfree(ptr); \
} \
} while(0)
#endif /* TCL_OO_INTERNAL_H */
/*
+28 -585
View File
@@ -57,7 +57,7 @@ char tclEmptyString = '\0';
* for sanity checking purposes.
*/
typedef struct ObjData {
typedef struct {
Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
const char *file; /* The name of the source file calling this
* function; used for debugging. */
@@ -210,10 +210,6 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
static void UpdateStringOfInt(Tcl_Obj *objPtr);
#ifndef TCL_WIDE_INT_IS_LONG
static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
static void FreeBignum(Tcl_Obj *objPtr);
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
@@ -242,15 +238,8 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
static const Tcl_ObjType oldBooleanType = {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclBooleanType = {
"booleanString", /* name */
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
@@ -270,15 +259,6 @@ const Tcl_ObjType tclIntType = {
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
#ifndef TCL_WIDE_INT_IS_LONG
const Tcl_ObjType tclWideIntType = {
"wideInt", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfWideInt, /* updateStringProc */
SetWideIntFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
@@ -395,8 +375,6 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
@@ -405,12 +383,6 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
#ifndef TCL_WIDE_INT_IS_LONG
Tcl_RegisterObjType(&tclWideIntType);
#endif
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced = 0;
@@ -1721,146 +1693,6 @@ Tcl_InvalidateStringRep(
TclInvalidateStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewBooleanObj --
*
* This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
* initializes it from the argument boolean value. A nonzero "boolValue"
* is coerced to 1.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewLongObj.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewBooleanObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, boolValue!=0);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewBooleanObj --
*
* This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
* same as the Tcl_NewBooleanObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
* When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewBooleanObj.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewBooleanObj(
register int boolValue, /* Boolean used to initialize new object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.longValue = (boolValue != 0);
objPtr->typePtr = &tclIntType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewBooleanObj(
register int boolValue, /* Boolean used to initialize new object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewBooleanObj(boolValue);
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_SetBooleanObj --
*
* Modify an object to be a boolean object and to have the specified
* boolean value. A nonzero "boolValue" is coerced to 1.
*
* Results:
* None.
*
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetBooleanObj
void
Tcl_SetBooleanObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
TclSetLongObj(objPtr, boolValue!=0);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
@@ -1887,12 +1719,8 @@ Tcl_GetBooleanFromObj(
register int *boolPtr) /* Place to store resulting boolean. */
{
do {
if (objPtr->typePtr == &tclIntType) {
*boolPtr = (objPtr->internalRep.longValue != 0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBooleanType) {
*boolPtr = (int) objPtr->internalRep.longValue;
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
@@ -1916,12 +1744,6 @@ Tcl_GetBooleanFromObj(
*boolPtr = 1;
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
#endif
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
@@ -1942,7 +1764,7 @@ Tcl_GetBooleanFromObj(
*
* Side effects:
* If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
* representation and the type of "objPtr" is set to boolean.
* representation and the type of "objPtr" is set to boolean or int.
*
*----------------------------------------------------------------------
*/
@@ -1960,8 +1782,7 @@ TclSetBooleanFromAny(
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType) {
switch (objPtr->internalRep.longValue) {
case 0L: case 1L:
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
@@ -1971,12 +1792,6 @@ TclSetBooleanFromAny(
goto badBoolean;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
goto badBoolean;
}
#endif
if (objPtr->typePtr == &tclDoubleType) {
goto badBoolean;
}
@@ -2107,13 +1922,13 @@ ParseBoolean(
goodBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = newBool;
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
numericBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = newBool;
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType;
return TCL_OK;
}
@@ -2294,7 +2109,7 @@ Tcl_GetDoubleFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*dblPtr = objPtr->internalRep.longValue;
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
@@ -2304,12 +2119,6 @@ Tcl_GetDoubleFromObj(
*dblPtr = TclBignumToDouble(&big);
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
#endif
} while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
return TCL_ERROR;
}
@@ -2349,8 +2158,7 @@ SetDoubleFromAny(
* UpdateStringOfDouble --
*
* Update the string representation for a double-precision floating point
* object. This must obey the current tcl_precision value for
* double-to-string conversions. Note: This function does not free an
* object. Note: This function does not free an
* existing old string rep so storage will be lost if this has not
* already been done.
*
@@ -2379,90 +2187,6 @@ UpdateStringOfDouble(
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewIntObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj to create a new integer object end up calling the
* debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewIntObj result in a call to one of the two
* Tcl_NewIntObj implementations below. We provide two implementations so
* that the Tcl core can be compiled to do memory debugging of the core
* even if a client does not request it for itself.
*
* Integer and long integer objects share the same "integer" type
* implementation. We store all integers as longs and Tcl_GetIntFromObj
* checks whether the current value of the long can be represented by an
* int.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewIntObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, intValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_SetIntObj --
*
* Modify an object to be an integer and to have the specified integer
* value.
*
* Results:
* None.
*
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetIntObj
void
Tcl_SetIntObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
TclSetLongObj(objPtr, intValue);
}
/*
*----------------------------------------------------------------------
*
@@ -2477,7 +2201,7 @@ Tcl_SetIntObj(
* Success.
*
* TCL_ERROR
*
*
* An error occurred during conversion or the integral value can not
* be represented as an integer (it might be too large). An error
* message is left in the interpreter's result if 'interp' is not
@@ -2541,9 +2265,8 @@ SetIntFromAny(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
long l;
return TclGetLongFromObj(interp, objPtr, &l);
Tcl_WideInt w;
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
/*
@@ -2572,167 +2295,13 @@ UpdateStringOfInt(
char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
len = TclFormatInt(buffer, objPtr->internalRep.wideValue);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewLongObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewLongObj to create a new long integer object end up calling the
* debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewLongObj result in a call to one of the two
* Tcl_NewLongObj implementations below. We provide two implementations
* so that the Tcl core can be compiled to do memory debugging of the
* core even if a client does not request it for itself.
*
* Integer and long integer objects share the same "integer" type
* implementation. We store all integers as longs and Tcl_GetIntFromObj
* checks whether the current value of the long can be represented by an
* int.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewLongObj
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
* new object. */
{
return Tcl_DbNewLongObj(longValue, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
* new object. */
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, longValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewLongObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
* objects end up calling the debugging function Tcl_DbNewLongObj
* instead. We provide two implementations of Tcl_DbNewLongObj so that
* whether the Tcl core is compiled to do memory debugging of the core is
* independent of whether a client requests debugging for itself.
*
* When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
* calls Tcl_DbCkalloc directly with the file name and line number from
* its caller. This simplifies debugging since then the [memory active]
* command will report the caller's file name and line number when
* reporting objects that haven't been freed.
*
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
* this function just returns the result of calling Tcl_NewLongObj.
*
* Results:
* The newly created long integer object is returned. This object will
* have an invalid string representation. The returned object has ref
* count 0.
*
* Side effects:
* Allocates memory.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewLongObj(
register long longValue, /* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.longValue = longValue;
objPtr->typePtr = &tclIntType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewLongObj(
register long longValue, /* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewLongObj(longValue);
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_SetLongObj --
*
* Modify an object to be an integer object and to have the specified
* long integer value.
*
* Results:
* None.
*
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
}
TclSetLongObj(objPtr, longValue);
}
/*
*----------------------------------------------------------------------
*
@@ -2761,12 +2330,13 @@ Tcl_GetLongFromObj(
register long *longPtr) /* Place to store resulting long. */
{
do {
#ifdef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclIntType) {
*longPtr = objPtr->internalRep.longValue;
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
#else
if (objPtr->typePtr == &tclIntType) {
/*
* We return any integer in the range -ULONG_MAX to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
@@ -2839,49 +2409,6 @@ Tcl_GetLongFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
*
* UpdateStringOfWideInt --
*
* Update the string representation for a wide integer object. Note: this
* function does not free an existing old string rep so storage will be
* lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
* The object's string is set to a valid string that results from the
* wideInt-to-string conversion.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfWideInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE+2];
register unsigned len;
register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
/*
* Note that sprintf will generate a compiler warning under Mingw claiming
* %I64 is an unknown format specifier. Just ignore this warning. We can't
* use %L as the format specifier since that gets printed as a 32 bit
* value.
*/
sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
len = strlen(buffer);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -2931,7 +2458,7 @@ Tcl_NewWideIntObj(
register Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetWideIntObj(objPtr, wideValue);
TclSetIntObj(objPtr, wideValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2983,7 +2510,7 @@ Tcl_DbNewWideIntObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetWideIntObj(objPtr, wideValue);
TclSetIntObj(objPtr, wideValue);
return objPtr;
}
@@ -3032,19 +2559,7 @@ Tcl_SetWideIntObj(
Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
}
if ((wideValue >= (Tcl_WideInt) LONG_MIN)
&& (wideValue <= (Tcl_WideInt) LONG_MAX)) {
TclSetLongObj(objPtr, (long) wideValue);
} else {
#ifndef TCL_WIDE_INT_IS_LONG
TclSetWideIntObj(objPtr, wideValue);
#else
mp_int big;
TclInitBignumFromWideInt(&big, wideValue);
Tcl_SetBignumObj(objPtr, &big);
#endif
}
TclSetIntObj(objPtr, wideValue);
}
/*
@@ -3076,14 +2591,8 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
#endif
if (objPtr->typePtr == &tclIntType) {
*wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
@@ -3136,33 +2645,6 @@ Tcl_GetWideIntFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
*
* SetWideIntFromAny --
*
* Attempts to force the internal representation for a Tcl object to
* tclWideIntType, specifically.
*
* Results:
* The return value is a standard object Tcl result. If an error occurs
* during conversion, an error message is left in the interpreter's
* result unless "interp" is NULL.
*
*----------------------------------------------------------------------
*/
static int
SetWideIntFromAny(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
Tcl_WideInt w;
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -3405,16 +2887,10 @@ GetBignumFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
TclInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
TclInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
return TCL_OK;
}
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3524,36 +3000,11 @@ Tcl_SetBignumObj(
Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
}
if ((size_t) bignumValue->used
<= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
unsigned long value = 0, numBytes = sizeof(long);
long scratch;
unsigned char *bytes = (unsigned char *) &scratch;
if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
goto tooLargeForLong;
}
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
goto tooLargeForLong;
}
if (bignumValue->sign) {
TclSetLongObj(objPtr, -(long)value);
} else {
TclSetLongObj(objPtr, (long)value);
}
mp_clear(bignumValue);
return;
}
tooLargeForLong:
#ifndef TCL_WIDE_INT_IS_LONG
if ((size_t) bignumValue->used
<= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
<= (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
Tcl_WideUInt value = 0;
unsigned long numBytes = sizeof(Tcl_WideInt);
Tcl_WideInt scratch;
unsigned char *bytes = (unsigned char *)&scratch;
unsigned long numBytes = sizeof(Tcl_WideUInt);
Tcl_WideUInt scratch;
unsigned char *bytes = (unsigned char *) &scratch;
if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
goto tooLargeForWide;
@@ -3565,15 +3016,14 @@ Tcl_SetBignumObj(
goto tooLargeForWide;
}
if (bignumValue->sign) {
TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
TclSetIntObj(objPtr, -(Tcl_WideInt)value);
} else {
TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
TclSetIntObj(objPtr, (Tcl_WideInt)value);
}
mp_clear(bignumValue);
return;
}
tooLargeForWide:
#endif
TclInvalidateStringRep(objPtr);
TclFreeIntRep(objPtr);
TclSetBignumIntRep(objPtr, bignumValue);
@@ -3655,17 +3105,10 @@ TclGetNumberFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*typePtr = TCL_NUMBER_LONG;
*clientDataPtr = &objPtr->internalRep.longValue;
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*typePtr = TCL_NUMBER_WIDE;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
#endif
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
-2
View File
@@ -287,8 +287,6 @@ ConvertZeroEffectToNOP(
case INST_INCR_ARRAY_STK:
case INST_INCR_SCALAR_STK:
case INST_INCR_STK:
case INST_LOR:
case INST_LAND:
case INST_EQ:
case INST_NEQ:
case INST_LT:
+4 -5
View File
@@ -72,7 +72,7 @@ static const Tcl_ObjType tclFsPathType = {
*
*/
typedef struct FsPath {
typedef struct {
Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
* is NULL, then this is a pure normalized,
* absolute path object, in which the parent
@@ -91,7 +91,7 @@ typedef struct FsPath {
* below. */
ClientData nativePathPtr; /* Native representation of this path, which
* is filesystem dependent. */
int filesystemEpoch; /* Used to ensure the path representation was
size_t filesystemEpoch; /* Used to ensure the path representation was
* generated during the correct filesystem
* epoch. The epoch changes when
* filesystem-mounts are changed. */
@@ -1809,7 +1809,6 @@ Tcl_FSGetNormalizedPath(
*/
(void) TclGetStringFromObj(dir, &cwdLen);
cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
/* Normalize the combined string. */
@@ -1831,12 +1830,12 @@ Tcl_FSGetNormalizedPath(
* normalized head, we can more efficiently normalize the combined
* path by passing over only the unnormalized tail portion. When
* this is sufficient, prior developers claim this should be much
* faster. We use 'cwdLen-1' so that we are already pointing at
* faster. We use 'cwdLen' so that we are already pointing at
* the dir-separator that we know about. The normalization code
* will actually start off directly after that separator.
*/
TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
TclFSNormalizeToUniquePath(interp, copy, cwdLen);
}
/* Now we need to construct the new path object. */
+21 -57
View File
@@ -221,13 +221,13 @@ Tcl_ReapDetachedProcs(void)
{
register Detached *detPtr;
Detached *nextPtr, *prevPtr;
int status;
Tcl_Pid pid;
int status, code;
Tcl_MutexLock(&pipeMutex);
for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL);
if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR
&& code != ECHILD)) {
prevPtr = detPtr;
detPtr = detPtr->nextPtr;
continue;
@@ -277,38 +277,21 @@ TclCleanupChildren(
{
int result = TCL_OK;
int i, abnormalExit, anyErrorInfo;
Tcl_Pid pid;
int waitStatus;
const char *msg;
unsigned long resolvedPid;
TclProcessWaitStatus waitStatus;
int code;
Tcl_Obj *msg, *error;
abnormalExit = 0;
for (i = 0; i < numPids; i++) {
/*
* We need to get the resolved pid before we wait on it as the windows
* implementation of Tcl_WaitPid deletes the information such that any
* following calls to TclpGetPid fail.
*/
resolvedPid = TclpGetPid(pidPtr[i]);
pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0);
if (pid == (Tcl_Pid) -1) {
waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
if (waitStatus == TCL_PROCESS_ERROR) {
result = TCL_ERROR;
if (interp != NULL) {
msg = Tcl_PosixError(interp);
if (errno == ECHILD) {
/*
* This changeup in message suggested by Mark Diekhans to
* remind people that ECHILD errors can occur on some
* systems if SIGCHLD isn't in its default state.
*/
msg =
"child process lost (is SIGCHLD ignored or trapped?)";
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"error waiting for process to exit: %s", msg));
Tcl_SetObjErrorCode(interp, error);
Tcl_SetObjResult(interp, msg);
}
Tcl_DecrRefCount(error);
Tcl_DecrRefCount(msg);
continue;
}
@@ -319,39 +302,19 @@ TclCleanupChildren(
* removed).
*/
if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
if (waitStatus != TCL_PROCESS_EXITED || code != 0) {
result = TCL_ERROR;
sprintf(msg1, "%lu", resolvedPid);
if (WIFEXITED(waitStatus)) {
if (waitStatus == TCL_PROCESS_EXITED) {
if (interp != NULL) {
sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
Tcl_SetObjErrorCode(interp, error);
}
abnormalExit = 1;
} else if (interp != NULL) {
const char *p;
if (WIFSIGNALED(waitStatus)) {
p = Tcl_SignalMsg(WTERMSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"child killed: %s\n", p));
} else if (WIFSTOPPED(waitStatus)) {
p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"child suspended: %s\n", p));
} else {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"child wait status didn't make sense\n", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"ODDWAITRESULT", msg1, NULL);
}
Tcl_SetObjErrorCode(interp, error);
Tcl_SetObjResult(interp, msg);
}
Tcl_DecrRefCount(error);
Tcl_DecrRefCount(msg);
}
}
@@ -936,6 +899,7 @@ TclCreatePipeline(
pidPtr[numPids] = pid;
numPids++;
TclProcessCreated(pid);
/*
* Close off our copies of file descriptors that were set up for this
+467 -313
View File
@@ -55,7 +55,7 @@ typedef struct PkgFiles {
* "Tk" (no version number).
*/
typedef struct Package {
typedef struct {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
* (malloc'ed). NULL means the package doesn't
@@ -65,6 +65,18 @@ typedef struct Package {
const void *clientData; /* Client data. */
} Package;
typedef struct Require {
void * clientDataPtr;
const char *name;
Package *pkgPtr;
char *versionToProvide;
} Require;
typedef struct RequireProcArgs {
const char *name;
void *clientDataPtr;
} RequireProcArgs;
/*
* Prototypes for functions defined in this file:
*/
@@ -85,9 +97,15 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc,
static void AddRequirementsToDString(Tcl_DString *dstring,
int reqc, Tcl_Obj *const reqv[]);
static Package * FindPackage(Tcl_Interp *interp, const char *name);
static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
int reqc, Tcl_Obj *const reqv[],
void *clientDataPtr);
static int PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result);
static int PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result);
static int PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result);
static int PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result);
static int PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result);
static int TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result);
static int SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result);
static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);
/*
* Helper macros.
@@ -365,7 +383,10 @@ Tcl_PkgRequireEx(
*/
if (version == NULL) {
result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
result = Tcl_GetStringResult(interp);
Tcl_ResetResult(interp);
}
} else {
if (exact && TCL_OK
!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
@@ -376,10 +397,12 @@ Tcl_PkgRequireEx(
Tcl_AppendStringsToObj(ov, "-", version, NULL);
}
Tcl_IncrRefCount(ov);
result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
result = Tcl_GetStringResult(interp);
Tcl_ResetResult(interp);
}
TclDecrRefCount(ov);
}
return result;
}
@@ -394,320 +417,130 @@ Tcl_PkgRequireProc(
* available. */
void *clientDataPtr)
{
const char *result =
PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
RequireProcArgs args;
args.name = name;
args.clientDataPtr = clientDataPtr;
return Tcl_NRCallObjProc(interp, TclNRPkgRequireProc, (void *)&args, reqc, reqv);
}
if (result == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
static int
TclNRPkgRequireProc(
ClientData clientData,
Tcl_Interp *interp,
int reqc,
Tcl_Obj *const reqv[]) {
RequireProcArgs *args = clientData;
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)args->name, INT2PTR(reqc), (void *)reqv, args->clientDataPtr);
return TCL_OK;
}
static const char *
PkgRequireCore(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[], /* 0 means to use the latest version
* available. */
void *clientDataPtr)
static int
PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result)
{
Interp *iPtr = (Interp *) interp;
Package *pkgPtr;
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
char *availVersion, *bestVersion;
/* Internal rep. of versions */
int availStable, code, satisfies, pass;
char *script, *pkgVersionI;
const char *name = data[0];
int reqc = PTR2INT(data[1]);
Tcl_Obj *const *reqv = data[2];
int code = CheckAllRequirements(interp, reqc, reqv);
Require *reqPtr;
if (code != TCL_OK) {
return code;
}
reqPtr = ckalloc(sizeof(Require));
Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
reqPtr->clientDataPtr = data[3];
reqPtr->name = name;
reqPtr->pkgPtr = FindPackage(interp, name);
if (reqPtr->pkgPtr->version == NULL) {
Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1);
} else {
Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
}
return TCL_OK;
}
static int
PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) {
Tcl_DString command;
char *script;
Require *reqPtr = data[0];
int reqc = PTR2INT(data[1]);
Tcl_Obj **const reqv = data[2];
const char *name = reqPtr->name /* Name of desired package. */;
if (reqPtr->pkgPtr->version == NULL) {
/*
* The package is not in the database. If there is a "package unknown"
* command, invoke it.
*/
if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
return NULL;
script = ((Interp *) interp)->packageUnknown;
if (script == NULL) {
Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
} else {
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, script, -1);
Tcl_DStringAppendElement(&command, name);
AddRequirementsToDString(&command, reqc, reqv);
Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
Tcl_NREvalObj(interp,
Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)),
TCL_EVAL_GLOBAL
);
Tcl_DStringFree(&command);
}
return TCL_OK;
} else {
Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
}
return TCL_OK;
}
/*
* It can take up to three passes to find the package: one pass to run the
* "package unknown" script, one to run the "package ifneeded" script for
* a specific version, and a final pass to lookup the package loaded by
* the "package ifneeded" script.
*/
for (pass=1 ;; pass++) {
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version != NULL) {
break;
}
/*
* Check whether we're already attempting to load some version of this
* package (circular dependency detection).
*/
if (pkgPtr->clientData != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"circular package dependency:"
" attempt to provide %s %s requires %s",
name, (char *) pkgPtr->clientData, name));
AddRequirementsToResult(interp, reqc, reqv);
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
return NULL;
}
/*
* The package isn't yet present. Search the list of available
* versions and invoke the script for the best available version. We
* are actually locating the best, and the best stable version. One of
* them is then chosen based on the selection mode.
*/
bestPtr = NULL;
bestStablePtr = NULL;
bestVersion = NULL;
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
if (CheckVersionAndConvert(interp, availPtr->version,
&availVersion, &availStable) != TCL_OK) {
/*
* The provided version number has invalid syntax. This
* should not happen. This should have been caught by the
* 'package ifneeded' registering the package.
*/
continue;
}
if (bestPtr != NULL) {
int res = CompareVersions(availVersion, bestVersion, NULL);
/*
* Note: Use internal reps!
*/
if (res <= 0) {
/*
* The version of the package sought is not as good as the
* currently selected version. Ignore it.
*/
ckfree(availVersion);
availVersion = NULL;
continue;
}
}
/*
* We have found a version which is better than our max.
*/
if (reqc > 0) {
/* Check satisfaction of requirements. */
satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
if (!satisfies) {
ckfree(availVersion);
availVersion = NULL;
continue;
}
}
bestPtr = availPtr;
if (bestVersion != NULL) {
ckfree(bestVersion);
}
bestVersion = availVersion;
/*
* If this new best version is stable then it also has to be
* better than the max stable version found so far.
*/
if (availStable) {
bestStablePtr = availPtr;
}
}
if (bestVersion != NULL) {
ckfree(bestVersion);
}
/*
* Now choose a version among the two best. For 'latest' we simply
* take (actually keep) the best. For 'stable' we take the best
* stable, if there is any, or the best if there is nothing stable.
*/
if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
&& (bestStablePtr != NULL)) {
bestPtr = bestStablePtr;
}
if (bestPtr != NULL) {
/*
* We found an ifneeded script for the package. Be careful while
* executing it: this could cause reentrancy, so (a) protect the
* script itself from deletion and (b) don't assume that bestPtr
* will still exist when the script completes.
*/
char *versionToProvide = bestPtr->version;
PkgFiles *pkgFiles;
PkgName *pkgName;
script = bestPtr->script;
pkgPtr->clientData = versionToProvide;
Tcl_Preserve(versionToProvide);
Tcl_Preserve(script);
pkgFiles = TclInitPkgFiles(interp);
/* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
pkgName = ckalloc(sizeof(PkgName) + strlen(name));
pkgName->nextPtr = pkgFiles->names;
strcpy(pkgName->name, name);
pkgFiles->names = pkgName;
if (bestPtr->pkgIndex) {
TclPkgFileSeen(interp, bestPtr->pkgIndex);
}
code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
/* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
pkgFiles->names = pkgName->nextPtr;
ckfree(pkgName);
Tcl_Release(script);
pkgPtr = FindPackage(interp, name);
if (code == TCL_OK) {
Tcl_ResetResult(interp);
if (pkgPtr->version == NULL) {
code = TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" no version of package %s provided",
name, versionToProvide, name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
NULL);
} else {
char *pvi, *vi;
if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
NULL) != TCL_OK) {
code = TCL_ERROR;
} else if (CheckVersionAndConvert(interp,
versionToProvide, &vi, NULL) != TCL_OK) {
ckfree(pvi);
code = TCL_ERROR;
} else {
int res = CompareVersions(pvi, vi, NULL);
ckfree(pvi);
ckfree(vi);
if (res != 0) {
code = TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" package %s %s provided instead",
name, versionToProvide,
name, pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
"WRONGPROVIDE", NULL);
}
}
}
} else if (code != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(code);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" bad return code: %s",
name, versionToProvide, TclGetString(codePtr)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
TclDecrRefCount(codePtr);
code = TCL_ERROR;
}
if (code == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"package ifneeded %s %s\" script)",
name, versionToProvide));
}
Tcl_Release(versionToProvide);
if (code != TCL_OK) {
/*
* Take a non-TCL_OK code from the script as an indication the
* package wasn't loaded properly, so the package system
* should not remember an improper load.
*
* This is consistent with our returning NULL. If we're not
* willing to tell our caller we got a particular version, we
* shouldn't store that version for telling future callers
* either.
*/
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
pkgPtr->version = NULL;
}
pkgPtr->clientData = NULL;
return NULL;
}
break;
}
/*
* The package is not in the database. If there is a "package unknown"
* command, invoke it (but only on the first pass; after that, we
* should not get here in the first place).
*/
if (pass > 1) {
break;
}
script = ((Interp *) interp)->packageUnknown;
if (script != NULL) {
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, script, -1);
Tcl_DStringAppendElement(&command, name);
AddRequirementsToDString(&command, reqc, reqv);
code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
Tcl_DStringFree(&command);
if ((code != TCL_OK) && (code != TCL_ERROR)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad return code: %d", code));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
code = TCL_ERROR;
}
if (code == TCL_ERROR) {
Tcl_AddErrorInfo(interp,
"\n (\"package unknown\" script)");
return NULL;
}
Tcl_ResetResult(interp);
}
static int
PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) {
Require *reqPtr = data[0];
int reqc = PTR2INT(data[1]);
Tcl_Obj **const reqv = data[2];
const char *name = reqPtr->name /* Name of desired package. */;
if ((result != TCL_OK) && (result != TCL_ERROR)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad return code: %d", result));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp,
"\n (\"package unknown\" script)");
return result;
}
Tcl_ResetResult(interp);
/* pkgPtr may now be invalid, so refresh it. */
reqPtr->pkgPtr = FindPackage(interp, name);
Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreFinal);
return TCL_OK;
}
if (pkgPtr->version == NULL) {
static int
PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {
Require *reqPtr = data[0];
int reqc = PTR2INT(data[1]), satisfies;
Tcl_Obj **const reqv = data[2];
char *pkgVersionI;
void *clientDataPtr = reqPtr->clientDataPtr;
const char *name = reqPtr->name /* Name of desired package. */;
if (reqPtr->pkgPtr->version == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't find package %s", name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
AddRequirementsToResult(interp, reqc, reqv);
return NULL;
return TCL_ERROR;
}
/*
* At this point we know that the package is present. Make sure that the
* provided version meets the current requirements.
* Ensure that the provided version meets the current requirements.
*/
if (reqc != 0) {
CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
ckfree(pkgVersionI);
@@ -715,20 +548,301 @@ PkgRequireCore(
if (!satisfies) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"version conflict for package \"%s\": have %s, need",
name, pkgPtr->version));
name, reqPtr->pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
NULL);
AddRequirementsToResult(interp, reqc, reqv);
return NULL;
return TCL_ERROR;
}
}
if (clientDataPtr) {
const void **ptr = (const void **) clientDataPtr;
*ptr = pkgPtr->clientData;
*ptr = reqPtr->pkgPtr->clientData;
}
return pkgPtr->version;
Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
return TCL_OK;
}
static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
ckfree(data[0]);
return result;
}
static int
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
char *availVersion, *bestVersion, *bestStableVersion;
/* Internal rep. of versions */
int availStable, satisfies;
Require *reqPtr = data[0];
int reqc = PTR2INT(data[1]);
Tcl_Obj **const reqv = data[2];
const char *name = reqPtr->name;
Package *pkgPtr = reqPtr->pkgPtr;
Interp *iPtr = (Interp *) interp;
/*
* Check whether we're already attempting to load some version of this
* package (circular dependency detection).
*/
if (pkgPtr->clientData != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"circular package dependency:"
" attempt to provide %s %s requires %s",
name, (char *) pkgPtr->clientData, name));
AddRequirementsToResult(interp, reqc, reqv);
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
return TCL_ERROR;
}
/*
* The package isn't yet present. Search the list of available
* versions and invoke the script for the best available version. We
* are actually locating the best, and the best stable version. One of
* them is then chosen based on the selection mode.
*/
bestPtr = NULL;
bestStablePtr = NULL;
bestVersion = NULL;
bestStableVersion = NULL;
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
if (CheckVersionAndConvert(interp, availPtr->version,
&availVersion, &availStable) != TCL_OK) {
/*
* The provided version number has invalid syntax. This
* should not happen. This should have been caught by the
* 'package ifneeded' registering the package.
*/
continue;
}
/* Check satisfaction of requirements before considering the current version further. */
if (reqc > 0) {
satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
if (!satisfies) {
ckfree(availVersion);
availVersion = NULL;
continue;
}
}
if (bestPtr != NULL) {
int res = CompareVersions(availVersion, bestVersion, NULL);
/*
* Note: Used internal reps in the comparison!
*/
if (res > 0) {
/*
* The version of the package sought is better than the
* currently selected version.
*/
ckfree(bestVersion);
bestVersion = NULL;
goto newbest;
}
} else {
newbest:
/* We have found a version which is better than our max. */
bestPtr = availPtr;
CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
}
if (!availStable) {
ckfree(availVersion);
availVersion = NULL;
continue;
}
if (bestStablePtr != NULL) {
int res = CompareVersions(availVersion, bestStableVersion, NULL);
/*
* Note: Used internal reps in the comparison!
*/
if (res > 0) {
/*
* This stable version of the package sought is better
* than the currently selected stable version.
*/
ckfree(bestStableVersion);
bestStableVersion = NULL;
goto newstable;
}
} else {
newstable:
/* We have found a stable version which is better than our max stable. */
bestStablePtr = availPtr;
CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
}
ckfree(availVersion);
availVersion = NULL;
} /* end for */
/*
* Clean up memorized internal reps, if any.
*/
if (bestVersion != NULL) {
ckfree(bestVersion);
bestVersion = NULL;
}
if (bestStableVersion != NULL) {
ckfree(bestStableVersion);
bestStableVersion = NULL;
}
/*
* Now choose a version among the two best. For 'latest' we simply
* take (actually keep) the best. For 'stable' we take the best
* stable, if there is any, or the best if there is nothing stable.
*/
if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
&& (bestStablePtr != NULL)) {
bestPtr = bestStablePtr;
}
if (bestPtr == NULL) {
Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
} else {
/*
* We found an ifneeded script for the package. Be careful while
* executing it: this could cause reentrancy, so (a) protect the
* script itself from deletion and (b) don't assume that bestPtr
* will still exist when the script completes.
*/
char *versionToProvide = bestPtr->version;
PkgFiles *pkgFiles;
PkgName *pkgName;
Tcl_Preserve(versionToProvide);
pkgPtr->clientData = versionToProvide;
pkgFiles = TclInitPkgFiles(interp);
/* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
pkgName = ckalloc(sizeof(PkgName) + strlen(name));
pkgName->nextPtr = pkgFiles->names;
strcpy(pkgName->name, name);
pkgFiles->names = pkgName;
if (bestPtr->pkgIndex) {
TclPkgFileSeen(interp, bestPtr->pkgIndex);
}
reqPtr->versionToProvide = versionToProvide;
Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]);
Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL);
}
return TCL_OK;
}
static int
SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
Require *reqPtr = data[0];
int reqc = PTR2INT(data[1]);
Tcl_Obj **const reqv = data[2];
const char *name = reqPtr->name;
char *versionToProvide = reqPtr->versionToProvide;
/* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
PkgName *pkgName = pkgFiles->names;
pkgFiles->names = pkgName->nextPtr;
ckfree(pkgName);
reqPtr->pkgPtr = FindPackage(interp, name);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
if (reqPtr->pkgPtr->version == NULL) {
result = TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" no version of package %s provided",
name, versionToProvide, name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
NULL);
} else {
char *pvi, *vi;
if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
NULL) != TCL_OK) {
result = TCL_ERROR;
} else if (CheckVersionAndConvert(interp,
versionToProvide, &vi, NULL) != TCL_OK) {
ckfree(pvi);
result = TCL_ERROR;
} else {
int res = CompareVersions(pvi, vi, NULL);
ckfree(pvi);
ckfree(vi);
if (res != 0) {
result = TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" package %s %s provided instead",
name, versionToProvide,
name, reqPtr->pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
"WRONGPROVIDE", NULL);
}
}
}
} else if (result != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(result);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" bad return code: %s",
name, versionToProvide, TclGetString(codePtr)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
TclDecrRefCount(codePtr);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"package ifneeded %s %s\" script)",
name, versionToProvide));
}
Tcl_Release(versionToProvide);
if (result != TCL_OK) {
/*
* Take a non-TCL_OK code from the script as an indication the
* package wasn't loaded properly, so the package system
* should not remember an improper load.
*
* This is consistent with our returning NULL. If we're not
* willing to tell our caller we got a particular version, we
* shouldn't store that version for telling future callers
* either.
*/
if (reqPtr->pkgPtr->version != NULL) {
ckfree(reqPtr->pkgPtr->version);
reqPtr->pkgPtr->version = NULL;
}
reqPtr->pkgPtr->clientData = NULL;
return result;
}
Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
return TCL_OK;
}
/*
@@ -834,10 +948,19 @@ Tcl_PkgPresentEx(
*
*----------------------------------------------------------------------
*/
int
Tcl_PackageObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv);
}
/* ARGSUSED */
int
Tcl_PackageObjCmd(
TclNRPackageObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -854,7 +977,7 @@ Tcl_PackageObjCmd(
PKG_VERSIONS, PKG_VSATISFIES
};
Interp *iPtr = (Interp *) interp;
int optionIndex, exact, i, satisfies;
int optionIndex, exact, i, newobjc, satisfies;
PkgAvail *availPtr, *prevPtr;
Package *pkgPtr;
Tcl_HashEntry *hPtr;
@@ -863,6 +986,7 @@ Tcl_PackageObjCmd(
const char *version;
const char *argv2, *argv3, *argv4;
char *iva = NULL, *ivb = NULL;
Tcl_Obj *objvListPtr, **newObjvPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
@@ -921,6 +1045,7 @@ Tcl_PackageObjCmd(
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
availPtr->pkgIndex = NULL;
}
ckfree(availPtr);
}
@@ -974,6 +1099,7 @@ Tcl_PackageObjCmd(
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
availPtr->pkgIndex = NULL;
}
break;
}
@@ -985,7 +1111,7 @@ Tcl_PackageObjCmd(
}
if (availPtr == NULL) {
availPtr = ckalloc(sizeof(PkgAvail));
availPtr->pkgIndex = 0;
availPtr->pkgIndex = NULL;
DupBlock(availPtr->version, argv3, (unsigned) length + 1);
if (prevPtr == NULL) {
@@ -1106,7 +1232,6 @@ Tcl_PackageObjCmd(
argv2 = TclGetString(objv[2]);
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
Tcl_Obj *ov;
int res;
if (objc != 5) {
goto requireSyntax;
@@ -1126,17 +1251,38 @@ Tcl_PackageObjCmd(
Tcl_AppendStringsToObj(ov, "-", version, NULL);
version = NULL;
argv3 = TclGetString(objv[3]);
Tcl_IncrRefCount(objv[3]);
Tcl_IncrRefCount(ov);
res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
TclDecrRefCount(ov);
return res;
objvListPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(objvListPtr);
Tcl_ListObjAppendElement(interp, objvListPtr, ov);
Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL);
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL);
return TCL_OK;
} else {
int i, newobjc = objc-3;
Tcl_Obj *const *newobjv = objv + 3;
if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
return TCL_ERROR;
}
objvListPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(objvListPtr);
Tcl_IncrRefCount(objv[2]);
for (i = 0; i < newobjc; i++) {
return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
/*
* Tcl_Obj structures may have come from another interpreter,
* so duplicate them.
*/
Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i]));
}
Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL);
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv2, INT2PTR(newobjc), newObjvPtr, NULL);
return TCL_OK;
}
break;
case PKG_UNKNOWN: {
@@ -1276,6 +1422,13 @@ Tcl_PackageObjCmd(
}
return TCL_OK;
}
static int
TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result) {
TclDecrRefCount((Tcl_Obj *)data[0]);
TclDecrRefCount((Tcl_Obj *)data[1]);
return result;
}
/*
*----------------------------------------------------------------------
@@ -1357,6 +1510,7 @@ TclFreePackageInfo(
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
availPtr->pkgIndex = NULL;
}
ckfree(availPtr);
}
+1 -1
View File
@@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
* objects that we don't want to live any longer than necessary.
*/
typedef struct HandleStruct {
typedef struct {
void *ptr; /* Pointer to the memory block being tracked.
* This field will become NULL when the memory
* block is deleted. This field must be the
+16 -44
View File
@@ -124,11 +124,10 @@ Tcl_ProcObjCmd(
{
register Interp *iPtr = (Interp *) interp;
Proc *procPtr;
const char *fullName;
const char *procName, *procArgs, *procBody;
const char *procName;
const char *simpleName, *procArgs, *procBody;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
Tcl_DString ds;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "name args body");
@@ -141,29 +140,21 @@ Tcl_ProcObjCmd(
* namespace.
*/
fullName = TclGetString(objv[1]);
TclGetNamespaceForQualName(interp, fullName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
procName = TclGetString(objv[1]);
TclGetNamespaceForQualName(interp, procName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
if (nsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": unknown namespace",
fullName));
procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": bad procedure name",
fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\" in non-global namespace with"
" name starting with \":\"", procName));
procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
@@ -172,31 +163,16 @@ Tcl_ProcObjCmd(
* Create the data structure to represent the procedure.
*/
if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3],
&procPtr) != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, procName);
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
/*
* Now create a command for the procedure. This will initially be in the
* current namespace unless the procedure's name included namespace
* qualifiers. To create the new command in the right namespace, we
* generate a fully qualified name for it.
*/
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
TclDStringAppendLiteral(&ds, "::");
}
Tcl_DStringAppend(&ds, procName, -1);
cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
TclNRInterpProc, procPtr, TclProcDeleteProc);
Tcl_DStringFree(&ds);
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
@@ -814,7 +790,7 @@ TclObjGetFrame(
level = curLevel - level;
result = 1;
} else if (objPtr->typePtr == &levelReferenceType) {
level = (int) objPtr->internalRep.longValue;
level = (int) objPtr->internalRep.wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
@@ -822,7 +798,7 @@ TclObjGetFrame(
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
TclFreeIntRep(objPtr);
objPtr->typePtr = &levelReferenceType;
objPtr->internalRep.longValue = level;
objPtr->internalRep.wideValue = level;
result = 1;
} else {
result = -1;
@@ -1075,11 +1051,7 @@ ProcWrongNumArgs(
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
@@ -1338,7 +1310,7 @@ InitLocalCache(
*namePtr = NULL;
} else {
*namePtr = TclCreateLiteral(iPtr, localPtr->name,
localPtr->nameLength, /* hash */ (unsigned int) -1,
localPtr->nameLength, /* hash */ -1,
&new, /* nsPtr */ NULL, 0, NULL);
Tcl_IncrRefCount(*namePtr);
}
@@ -2404,7 +2376,7 @@ FreeLambdaInternalRep(
Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
if (procPtr->refCount-- == 1) {
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
+957
View File
@@ -0,0 +1,957 @@
/*
* tclProcess.c --
*
* This file implements the "tcl::process" ensemble for subprocess
* management as defined by TIP #462.
*
* Copyright (c) 2017 Frederic Bonnet.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
* Autopurge flag. Process-global because of the way Tcl manages child
* processes (see tclPipe.c).
*/
static int autopurge = 1; /* Autopurge flag. */
/*
* Hash tables that keeps track of all child process statuses. Keys are the
* child process ids and resolved pids, values are (ProcessInfo *).
*/
typedef struct ProcessInfo {
Tcl_Pid pid; /* Process id. */
int resolvedPid; /* Resolved process id. */
int purge; /* Purge eventualy. */
TclProcessWaitStatus status;/* Process status. */
int code; /* Error code, exit status or signal
number. */
Tcl_Obj *msg; /* Error message. */
Tcl_Obj *error; /* Error code. */
} ProcessInfo;
static Tcl_HashTable infoTablePerPid;
static Tcl_HashTable infoTablePerResolvedPid;
static int infoTablesInitialized = 0; /* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(infoTablesMutex)
/*
* Prototypes for functions defined later in this file:
*/
static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
int resolvedPid);
static void FreeProcessInfo(ProcessInfo *info);
static int RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
int options, int *codePtr, Tcl_Obj **msgPtr,
Tcl_Obj **errorObjPtr);
static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info);
static int ProcessListObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int ProcessStatusObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int ProcessPurgeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int ProcessAutopurgeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------------
*
* InitProcessInfo --
*
* Initializes the ProcessInfo structure.
*
* Results:
* None.
*
* Side effects:
* Memory written.
*
*----------------------------------------------------------------------
*/
void
InitProcessInfo(
ProcessInfo *info, /* Structure to initialize. */
Tcl_Pid pid, /* Process id. */
int resolvedPid) /* Resolved process id. */
{
info->pid = pid;
info->resolvedPid = resolvedPid;
info->purge = 0;
info->status = TCL_PROCESS_UNCHANGED;
info->code = 0;
info->msg = NULL;
info->error = NULL;
}
/*
*----------------------------------------------------------------------
*
* FreeProcessInfo --
*
* Free the ProcessInfo structure.
*
* Results:
* None.
*
* Side effects:
* Memory deallocated, Tcl_Obj refcount decreased.
*
*----------------------------------------------------------------------
*/
void
FreeProcessInfo(
ProcessInfo *info) /* Structure to free. */
{
/*
* Free stored Tcl_Objs.
*/
if (info->msg) {
Tcl_DecrRefCount(info->msg);
}
if (info->error) {
Tcl_DecrRefCount(info->error);
}
/*
* Free allocated structure.
*/
ckfree(info);
}
/*
*----------------------------------------------------------------------
*
* RefreshProcessInfo --
*
* Refresh process info.
*
* Results:
* Nonzero if state changed, else zero.
*
* Side effects:
* May call WaitProcessStatus, which can block if WNOHANG option is set.
*
*----------------------------------------------------------------------
*/
int
RefreshProcessInfo(
ProcessInfo *info, /* Structure to refresh. */
int options /* Options passed to WaitProcessStatus. */
)
{
if (info->status == TCL_PROCESS_UNCHANGED) {
/*
* Refresh & store status.
*/
info->status = WaitProcessStatus(info->pid, info->resolvedPid,
options, &info->code, &info->msg, &info->error);
if (info->msg) Tcl_IncrRefCount(info->msg);
if (info->error) Tcl_IncrRefCount(info->error);
return (info->status != TCL_PROCESS_UNCHANGED);
} else {
/*
* No change.
*/
return 0;
}
}
/*
*----------------------------------------------------------------------
*
* WaitProcessStatus --
*
* Wait for process status to change.
*
* Results:
* TclProcessWaitStatus enum value.
*
* Side effects:
* May call WaitProcessStatus, which can block if WNOHANG option is set.
*
*----------------------------------------------------------------------
*/
TclProcessWaitStatus
WaitProcessStatus(
Tcl_Pid pid, /* Process id. */
int resolvedPid, /* Resolved process id. */
int options, /* Options passed to Tcl_WaitPid. */
int *codePtr, /* If non-NULL, will receive either:
* - 0 for normal exit.
* - errno in case of error.
* - non-zero exit code for abormal exit.
* - signal number if killed or suspended.
* - Tcl_WaitPid status in all other cases.
*/
Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */
Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */
{
int waitStatus;
Tcl_Obj *errorStrings[5];
const char *msg;
pid = Tcl_WaitPid(pid, &waitStatus, options);
if (pid == 0) {
/*
* No change.
*/
return TCL_PROCESS_UNCHANGED;
}
/*
* Get process status.
*/
if (pid == (Tcl_Pid) -1) {
/*
* POSIX errName msg
*/
msg = Tcl_ErrnoMsg(errno);
if (errno == ECHILD) {
/*
* This changeup in message suggested by Mark Diekhans to
* remind people that ECHILD errors can occur on some
* systems if SIGCHLD isn't in its default state.
*/
msg = "child process lost (is SIGCHLD ignored or trapped?)";
}
if (codePtr) *codePtr = errno;
if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
"error waiting for process to exit: %s", msg);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("POSIX", -1);
errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
errorStrings[2] = Tcl_NewStringObj(msg, -1);
*errorObjPtr = Tcl_NewListObj(3, errorStrings);
}
return TCL_PROCESS_ERROR;
} else if (WIFEXITED(waitStatus)) {
if (codePtr) *codePtr = WEXITSTATUS(waitStatus);
if (!WEXITSTATUS(waitStatus)) {
/*
* Normal exit.
*/
if (msgObjPtr) *msgObjPtr = NULL;
if (errorObjPtr) *errorObjPtr = NULL;
} else {
/*
* CHILDSTATUS pid code
*
* Child exited with a non-zero exit status.
*/
if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
"child process exited abnormally", -1);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
errorStrings[1] = Tcl_NewIntObj(resolvedPid);
errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus));
*errorObjPtr = Tcl_NewListObj(3, errorStrings);
}
}
return TCL_PROCESS_EXITED;
} else if (WIFSIGNALED(waitStatus)) {
/*
* CHILDKILLED pid sigName msg
*
* Child killed because of a signal.
*/
msg = Tcl_SignalMsg(WTERMSIG(waitStatus));
if (codePtr) *codePtr = WTERMSIG(waitStatus);
if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
"child killed: %s", msg);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
errorStrings[1] = Tcl_NewIntObj(resolvedPid);
errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
errorStrings[3] = Tcl_NewStringObj(msg, -1);
*errorObjPtr = Tcl_NewListObj(4, errorStrings);
}
return TCL_PROCESS_SIGNALED;
} else if (WIFSTOPPED(waitStatus)) {
/*
* CHILDSUSP pid sigName msg
*
* Child suspended because of a signal.
*/
msg = Tcl_SignalMsg(WSTOPSIG(waitStatus));
if (codePtr) *codePtr = WSTOPSIG(waitStatus);
if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
"child suspended: %s", msg);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
errorStrings[1] = Tcl_NewIntObj(resolvedPid);
errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
errorStrings[3] = Tcl_NewStringObj(msg, -1);
*errorObjPtr = Tcl_NewListObj(4, errorStrings);
}
return TCL_PROCESS_STOPPED;
} else {
/*
* TCL OPERATION EXEC ODDWAITRESULT
*
* Child wait status didn't make sense.
*/
if (codePtr) *codePtr = waitStatus;
if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
"child wait status didn't make sense\n", -1);
if (errorObjPtr) {
errorStrings[0] = Tcl_NewStringObj("TCL", -1);
errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
errorStrings[4] = Tcl_NewIntObj(resolvedPid);
*errorObjPtr = Tcl_NewListObj(5, errorStrings);
}
return TCL_PROCESS_UNKNOWN_STATUS;
}
}
/*
*----------------------------------------------------------------------
*
* BuildProcessStatusObj --
*
* Build a list object with process status. The first element is always
* a standard Tcl return value, which can be either TCL_OK or TCL_ERROR.
* In the latter case, the second element is the error message and the
* third element is a Tcl error code (see tclvars).
*
* Results:
* A list object.
*
* Side effects:
* Tcl_Objs are created.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
BuildProcessStatusObj(
ProcessInfo *info)
{
Tcl_Obj *resultObjs[3];
if (info->status == TCL_PROCESS_UNCHANGED) {
/*
* Process still running, return empty obj.
*/
return Tcl_NewObj();
}
if (info->status == TCL_PROCESS_EXITED && info->code == 0) {
/*
* Normal exit, return TCL_OK.
*/
return Tcl_NewIntObj(TCL_OK);
}
/*
* Abnormal exit, return {TCL_ERROR msg error}
*/
resultObjs[0] = Tcl_NewIntObj(TCL_ERROR);
resultObjs[1] = info->msg;
resultObjs[2] = info->error;
return Tcl_NewListObj(3, resultObjs);
}
/*----------------------------------------------------------------------
*
* ProcessListObjCmd --
*
* This function implements the 'tcl::process list' Tcl command.
* Refer to the user documentation for details on what it does.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* Access to the internal structures is protected by infoTablesMutex.
*
*----------------------------------------------------------------------
*/
static int
ProcessListObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *list;
Tcl_HashEntry *entry;
Tcl_HashSearch search;
ProcessInfo *info;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
/*
* Return the list of all chid process ids.
*/
list = Tcl_NewListObj(0, NULL);
Tcl_MutexLock(&infoTablesMutex);
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
info = (ProcessInfo *) Tcl_GetHashValue(entry);
Tcl_ListObjAppendElement(interp, list,
Tcl_NewIntObj(info->resolvedPid));
}
Tcl_MutexUnlock(&infoTablesMutex);
Tcl_SetObjResult(interp, list);
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ProcessStatusObjCmd --
*
* This function implements the 'tcl::process status' Tcl command.
* Refer to the user documentation for details on what it does.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* Access to the internal structures is protected by infoTablesMutex.
* Calls RefreshProcessInfo, which can block if -wait switch is given.
*
*----------------------------------------------------------------------
*/
static int
ProcessStatusObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *dict;
int index, options = WNOHANG;
Tcl_HashEntry *entry;
Tcl_HashSearch search;
ProcessInfo *info;
int numPids;
Tcl_Obj **pidObjs;
int result;
int i;
int pid;
Tcl_Obj *const *savedobjv = objv;
static const char *const switches[] = {
"-wait", "--", NULL
};
enum switches {
STATUS_WAIT, STATUS_LAST
};
while (objc > 1) {
if (TclGetString(objv[1])[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[1], switches, "switches", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
++objv; --objc;
if (STATUS_WAIT == (enum switches) index) {
options = 0;
} else {
break;
}
}
if (objc != 1 && objc != 2) {
Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?");
return TCL_ERROR;
}
if (objc == 1) {
/*
* Return a dict with all child process statuses.
*/
dict = Tcl_NewDictObj();
Tcl_MutexLock(&infoTablesMutex);
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
info = (ProcessInfo *) Tcl_GetHashValue(entry);
RefreshProcessInfo(info, options);
if (info->purge && autopurge) {
/*
* Purge entry.
*/
Tcl_DeleteHashEntry(entry);
entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
Tcl_DeleteHashEntry(entry);
FreeProcessInfo(info);
} else {
/*
* Add to result.
*/
Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
BuildProcessStatusObj(info));
}
}
Tcl_MutexUnlock(&infoTablesMutex);
} else {
/*
* Only return statuses of provided processes.
*/
result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
dict = Tcl_NewDictObj();
Tcl_MutexLock(&infoTablesMutex);
for (i = 0; i < numPids; i++) {
result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
if (result != TCL_OK) {
Tcl_MutexUnlock(&infoTablesMutex);
Tcl_DecrRefCount(dict);
return result;
}
entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
if (!entry) {
/*
* Skip unknown process.
*/
continue;
}
info = (ProcessInfo *) Tcl_GetHashValue(entry);
RefreshProcessInfo(info, options);
if (info->purge && autopurge) {
/*
* Purge entry.
*/
Tcl_DeleteHashEntry(entry);
entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
Tcl_DeleteHashEntry(entry);
FreeProcessInfo(info);
} else {
/*
* Add to result.
*/
Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
BuildProcessStatusObj(info));
}
}
Tcl_MutexUnlock(&infoTablesMutex);
}
Tcl_SetObjResult(interp, dict);
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ProcessPurgeObjCmd --
*
* This function implements the 'tcl::process purge' Tcl command.
* Refer to the user documentation for details on what it does.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* Frees all ProcessInfo structures with their purge flag set.
*
*----------------------------------------------------------------------
*/
static int
ProcessPurgeObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_HashEntry *entry;
Tcl_HashSearch search;
ProcessInfo *info;
int numPids;
Tcl_Obj **pidObjs;
int result;
int i;
int pid;
if (objc != 1 && objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?pids?");
return TCL_ERROR;
}
/*
* First reap detached procs so that their purge flag is up-to-date.
*/
Tcl_ReapDetachedProcs();
if (objc == 1) {
/*
* Purge all terminated processes.
*/
Tcl_MutexLock(&infoTablesMutex);
for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
entry != NULL; entry = Tcl_NextHashEntry(&search)) {
info = (ProcessInfo *) Tcl_GetHashValue(entry);
if (info->purge) {
Tcl_DeleteHashEntry(entry);
entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
Tcl_DeleteHashEntry(entry);
FreeProcessInfo(info);
}
}
Tcl_MutexUnlock(&infoTablesMutex);
} else {
/*
* Purge only provided processes.
*/
result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
Tcl_MutexLock(&infoTablesMutex);
for (i = 0; i < numPids; i++) {
result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
if (result != TCL_OK) {
Tcl_MutexUnlock(&infoTablesMutex);
return result;
}
entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
if (!entry) {
/*
* Skip unknown process.
*/
continue;
}
info = (ProcessInfo *) Tcl_GetHashValue(entry);
if (info->purge) {
Tcl_DeleteHashEntry(entry);
entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
Tcl_DeleteHashEntry(entry);
FreeProcessInfo(info);
}
}
Tcl_MutexUnlock(&infoTablesMutex);
}
return TCL_OK;
}
/*----------------------------------------------------------------------
*
* ProcessAutopurgeObjCmd --
*
* This function implements the 'tcl::process autopurge' Tcl command.
* Refer to the user documentation for details on what it does.
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* Alters detached process handling by Tcl_ReapDetachedProcs().
*
*----------------------------------------------------------------------
*/
static int
ProcessAutopurgeObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1 && objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?flag?");
return TCL_ERROR;
}
if (objc == 2) {
/*
* Set given value.
*/
int flag;
int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
if (result != TCL_OK) {
return result;
}
autopurge = !!flag;
}
/*
* Return current value.
*/
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclInitProcessCmd --
*
* This procedure creates the "tcl::process" Tcl command. See the user
* documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
Tcl_Command
TclInitProcessCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap processImplMap[] = {
{"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
{"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
{"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{NULL, NULL, NULL, NULL, NULL, 0}
};
Tcl_Command processCmd;
if (infoTablesInitialized == 0) {
Tcl_MutexLock(&infoTablesMutex);
if (infoTablesInitialized == 0) {
Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS);
infoTablesInitialized = 1;
}
Tcl_MutexUnlock(&infoTablesMutex);
}
processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap);
Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
"process", 0);
return processCmd;
}
/*
*----------------------------------------------------------------------
*
* TclProcessCreated --
*
* Called when a child process has been created by Tcl.
*
* Results:
* None.
*
* Side effects:
* Internal structures are updated with a new ProcessInfo.
*
*----------------------------------------------------------------------
*/
void
TclProcessCreated(
Tcl_Pid pid) /* Process id. */
{
int resolvedPid;
Tcl_HashEntry *entry, *entry2;
int isNew;
ProcessInfo *info;
/*
* Get resolved pid first.
*/
resolvedPid = TclpGetPid(pid);
Tcl_MutexLock(&infoTablesMutex);
/*
* Create entry in pid table.
*/
entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew);
if (!isNew) {
/*
* Pid was reused, free old info and reuse structure.
*/
info = (ProcessInfo *) Tcl_GetHashValue(entry);
entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
INT2PTR(resolvedPid));
if (entry2) Tcl_DeleteHashEntry(entry2);
FreeProcessInfo(info);
}
/*
* Allocate and initialize info structure.
*/
info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo));
InitProcessInfo(info, pid, resolvedPid);
/*
* Add entry to tables.
*/
Tcl_SetHashValue(entry, info);
entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid),
&isNew);
Tcl_SetHashValue(entry, info);
Tcl_MutexUnlock(&infoTablesMutex);
}
/*
*----------------------------------------------------------------------
*
* TclProcessWait --
*
* Wait for process status to change.
*
* Results:
* TclProcessWaitStatus enum value.
*
* Side effects:
* Completed process info structures are purged immediately (autopurge on)
* or eventually (autopurge off).
*
*----------------------------------------------------------------------
*/
TclProcessWaitStatus
TclProcessWait(
Tcl_Pid pid, /* Process id. */
int options, /* Options passed to WaitProcessStatus. */
int *codePtr, /* If non-NULL, will receive either:
* - 0 for normal exit.
* - errno in case of error.
* - non-zero exit code for abormal exit.
* - signal number if killed or suspended.
* - Tcl_WaitPid status in all other cases.
*/
Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */
Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */
{
Tcl_HashEntry *entry;
ProcessInfo *info;
TclProcessWaitStatus result;
/*
* First search for pid in table.
*/
Tcl_MutexLock(&infoTablesMutex);
entry = Tcl_FindHashEntry(&infoTablePerPid, pid);
if (!entry) {
/*
* Unknown process, just call WaitProcessStatus and return.
*/
result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
msgObjPtr, errorObjPtr);
if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
Tcl_MutexUnlock(&infoTablesMutex);
return result;
}
info = (ProcessInfo *) Tcl_GetHashValue(entry);
if (info->purge) {
/*
* Process has completed but TclProcessWait has already been called,
* so report no change.
*/
Tcl_MutexUnlock(&infoTablesMutex);
return TCL_PROCESS_UNCHANGED;
}
RefreshProcessInfo(info, options);
if (info->status == TCL_PROCESS_UNCHANGED) {
/*
* No change, stop there.
*/
Tcl_MutexUnlock(&infoTablesMutex);
return TCL_PROCESS_UNCHANGED;
}
/*
* Set return values.
*/
result = info->status;
if (codePtr) *codePtr = info->code;
if (msgObjPtr) *msgObjPtr = info->msg;
if (errorObjPtr) *errorObjPtr = info->error;
if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
if (autopurge) {
/*
* Purge now.
*/
Tcl_DeleteHashEntry(entry);
entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
INT2PTR(info->resolvedPid));
Tcl_DeleteHashEntry(entry);
FreeProcessInfo(info);
} else {
/*
* Eventually purge. Subsequent calls will return
* TCL_PROCESS_UNCHANGED.
*/
info->purge = 1;
}
Tcl_MutexUnlock(&infoTablesMutex);
return result;
}
+41 -15
View File
@@ -10,6 +10,7 @@
*/
#include "tclInt.h"
#include "tommath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -28,7 +29,7 @@
* character set.
*/
typedef struct CharSet {
typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
@@ -415,14 +416,7 @@ ValidateFormat(
case 'x':
case 'X':
case 'b':
break;
case 'u':
if (flags & SCAN_BIG) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"unsigned bignum scans are invalid", -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
goto error;
}
break;
/*
* Bracket terms need special checking
@@ -885,9 +879,17 @@ Tcl_ScanObjCmd(
* Scan a single Unicode character.
*/
string += TclUtfToUniChar(string, &sch);
offset = TclUtfToUniChar(string, &sch);
i = (int)sch;
#if TCL_UTF_MAX == 4
if (!offset) {
offset = TclUtfToUniChar(string, &sch);
i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
}
#endif
string += offset;
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj((int)sch);
objPtr = Tcl_NewIntObj(i);
Tcl_IncrRefCount(objPtr);
CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
@@ -924,9 +926,9 @@ Tcl_ScanObjCmd(
}
if (flags & SCAN_LONGER) {
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */
wideValue = LLONG_MAX;
if (TclGetString(objPtr)[0] == '-') {
wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */
wideValue = LLONG_MIN;
}
}
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
@@ -934,9 +936,33 @@ Tcl_ScanObjCmd(
(Tcl_WideUInt)wideValue);
Tcl_SetStringObj(objPtr, buf, -1);
} else {
Tcl_SetWideIntObj(objPtr, wideValue);
TclSetIntObj(objPtr, wideValue);
}
} else if (!(flags & SCAN_BIG)) {
} else if (flags & SCAN_BIG) {
if (flags & SCAN_UNSIGNED) {
mp_int big;
int code = Tcl_GetBignumFromObj(interp, objPtr, &big);
if (code == TCL_OK) {
if (mp_isneg(&big)) {
code = TCL_ERROR;
}
mp_clear(&big);
}
if (code == TCL_ERROR) {
if (objs != NULL) {
ckfree(objs);
}
Tcl_DecrRefCount(objPtr);
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"unsigned bignum scans are invalid", -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT",
"BADUNSIGNED",NULL);
return TCL_ERROR;
}
}
} else {
if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
@@ -948,7 +974,7 @@ Tcl_ScanObjCmd(
sprintf(buf, "%lu", value); /* INTL: ISO digit */
Tcl_SetStringObj(objPtr, buf, -1);
} else {
Tcl_SetLongObj(objPtr, value);
TclSetIntObj(objPtr, value);
}
}
objs[objIndex++] = objPtr;
Executable → Regular
+15 -44
View File
@@ -1208,32 +1208,18 @@ TclParseNumber(
}
}
if (!octalSignificandOverflow) {
if (octalSignificandWide >
(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
#ifndef TCL_WIDE_INT_IS_LONG
if (octalSignificandWide <= (MOST_BITS + signum)) {
objPtr->typePtr = &tclWideIntType;
if (signum) {
objPtr->internalRep.wideValue =
- (Tcl_WideInt) octalSignificandWide;
} else {
objPtr->internalRep.wideValue =
(Tcl_WideInt) octalSignificandWide;
}
break;
}
#endif
if (octalSignificandWide > (MOST_BITS + signum)) {
TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.longValue =
- (long) octalSignificandWide;
objPtr->internalRep.wideValue =
- (Tcl_WideInt) octalSignificandWide;
} else {
objPtr->internalRep.longValue =
(long) octalSignificandWide;
objPtr->internalRep.wideValue =
(Tcl_WideInt) octalSignificandWide;
}
}
}
@@ -1255,32 +1241,18 @@ TclParseNumber(
}
returnInteger:
if (!significandOverflow) {
if (significandWide >
(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
#ifndef TCL_WIDE_INT_IS_LONG
if (significandWide <= MOST_BITS+signum) {
objPtr->typePtr = &tclWideIntType;
if (signum) {
objPtr->internalRep.wideValue =
- (Tcl_WideInt) significandWide;
} else {
objPtr->internalRep.wideValue =
(Tcl_WideInt) significandWide;
}
break;
}
#endif
if (significandWide > MOST_BITS+signum) {
TclInitBignumFromWideUInt(&significandBig,
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.longValue =
- (long) significandWide;
objPtr->internalRep.wideValue =
- (Tcl_WideInt) significandWide;
} else {
objPtr->internalRep.longValue =
(long) significandWide;
objPtr->internalRep.wideValue =
(Tcl_WideInt) significandWide;
}
}
}
@@ -3996,8 +3968,8 @@ StrictBignumConversion(
* This function is a service routine that produces the string of digits for
* floating-point-to-decimal conversion. It can do a number of things
* according to the 'flags' argument. Valid values for 'flags' include:
* TCL_DD_SHORTEST - This is the default for floating point conversion if
* ::tcl_precision is 0. It constructs the shortest string of
* TCL_DD_SHORTEST - This is the default for floating point conversion.
* It constructs the shortest string of
* digits that will reconvert to the given number when scanned.
* For floating point numbers that are exactly between two
* decimal numbers, it resolves using the 'round to even' rule.
@@ -4012,8 +3984,7 @@ StrictBignumConversion(
* subsequent input conversion is 'round up' or 'round down'
* rather than 'round to nearest', but is surprising otherwise.
* TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format
* conversion (or for default floating->string if tcl_precision
* is not 0). It constructs a string of at most 'ndigits' digits,
* conversion. It constructs a string of at most 'ndigits' digits,
* choosing the one that is closest to the given number (and
* resolving ties with 'round to even'). It is allowed to return
* fewer than 'ndigits' if the number converts exactly; if the
@@ -4662,7 +4633,7 @@ TclCeil(
mp_int b;
mp_init(&b);
if (mp_cmp_d(a, 0) == MP_LT) {
if (mp_isneg(a)) {
mp_neg(a, &b);
r = -TclFloor(&b);
} else {
@@ -4719,7 +4690,7 @@ TclFloor(
mp_int b;
mp_init(&b);
if (mp_cmp_d(a, 0) == MP_LT) {
if (mp_isneg(a)) {
mp_neg(a, &b);
r = -TclCeil(&b);
} else {
+434 -199
View File
File diff suppressed because it is too large Load Diff
+1
View File
@@ -86,6 +86,7 @@ typedef struct {
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \
((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
/*
+101 -264
View File
@@ -31,6 +31,7 @@
#undef Tcl_NewIntObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
#undef Tcl_DbNewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
@@ -42,138 +43,35 @@
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED)
# define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
static int TclSockMinimumBuffersOld(int sock, int size)
{
return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif
#if defined(TCL_NO_DEPRECATED)
# define TclSetStartupScriptPath 0
# define TclGetStartupScriptPath 0
# define TclSetStartupScriptFileName 0
# define TclGetStartupScriptFileName 0
# define TclpInetNtoa 0
# define TclWinGetServByName 0
# define TclWinGetSockOpt 0
# define TclWinSetSockOpt 0
# define TclWinNToHS 0
# define TclBNInitBignumFromWideUInt 0
# define TclBNInitBignumFromWideInt 0
# define TclBNInitBignumFromLong 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath
static Tcl_Obj *TclGetStartupScriptPath(void)
{
return Tcl_GetStartupScript(NULL);
}
#define TclSetStartupScriptFileName setStartupScriptFileName
static void TclSetStartupScriptFileName(
const char *fileName)
{
Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL);
}
#define TclGetStartupScriptFileName getStartupScriptFileName
static const char *TclGetStartupScriptFileName(void)
{
Tcl_Obj *path = Tcl_GetStartupScript(NULL);
if (path == NULL) {
return NULL;
}
return Tcl_GetString(path);
}
#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
return ntohs(ns);
}
#endif
# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
# define TclBNInitBignumFromLong TclInitBignumFromLong
#endif /* TCL_NO_DEPRECATED */
#ifdef _WIN32
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
# define TclUnixOpenTemporaryFile 0
# define TclpReaddir 0
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
# define TclpIsAtty TclPlatIsAtty
# define TclWinSetInterfaces (void (*) (int)) doNothing
static void
doNothing(void)
{
/* dummy implementation, no need to do anything */
}
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
# define TclWinResetInterfaces doNothing
static Tcl_Encoding winTCharEncoding;
static int
TclpIsAtty(int fd)
{
return isatty(fd);
}
#define TclWinGetPlatformId winGetPlatformId
static int
TclWinGetPlatformId()
{
/* Don't bother to determine the real platform on cygwin,
* because VER_PLATFORM_WIN32_NT is the only supported platform */
return 2; /* VER_PLATFORM_WIN32_NT */;
}
void *TclWinGetTclInstance()
{
void *hInstance = NULL;
GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
(const char *)&winTCharEncoding, &hInstance);
(const char *)&TclpIsAtty, &hInstance);
return hInstance;
}
#ifndef TCL_NO_DEPRECATED
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
#define TclWinGetSockOpt winGetSockOpt
static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
#define TclWinGetServByName winGetServByName
static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
#endif /* TCL_NO_DEPRECATED */
#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
@@ -194,23 +92,23 @@ TclpGetPid(Tcl_Pid pid)
return (int) (size_t) pid;
}
static void
doNothing(void)
{
/* dummy implementation, no need to do anything */
}
char *
Tcl_WinUtfToTChar(
const char *string,
int len,
Tcl_DString *dsPtr)
{
if (!winTCharEncoding) {
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
}
return Tcl_UtfToExternalDString(winTCharEncoding,
string, len, dsPtr);
WCHAR *wp;
int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
Tcl_DStringInit(dsPtr);
Tcl_DStringSetLength(dsPtr, 2*size+2);
wp = (WCHAR *)Tcl_DStringValue(dsPtr);
MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
if (len == -1) --size; /* account for 0-byte at string end */
Tcl_DStringSetLength(dsPtr, 2*size);
wp[size] = 0;
return (char *)wp;
}
char *
@@ -219,11 +117,21 @@ Tcl_WinTCharToUtf(
int len,
Tcl_DString *dsPtr)
{
if (!winTCharEncoding) {
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
char *p;
int size;
if (len > 0) {
len /= 2;
}
return Tcl_ExternalToUtfDString(winTCharEncoding,
string, len, dsPtr);
size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
Tcl_DStringInit(dsPtr);
Tcl_DStringSetLength(dsPtr, size+1);
p = (char *)Tcl_DStringValue(dsPtr);
WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
if (len == -1) --size; /* account for 0-byte at string end */
Tcl_DStringSetLength(dsPtr, size);
p[size] = 0;
return p;
}
#if defined(TCL_WIDE_INT_IS_LONG)
@@ -232,28 +140,6 @@ Tcl_WinTCharToUtf(
* signature. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
*/
#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
static Tcl_Obj *dbNewLongObj(
int intValue,
const char *file,
int line
) {
#ifdef TCL_MEM_DEBUG
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.longValue = (long) intValue;
objPtr->typePtr = &tclIntType;
return objPtr;
#else
return Tcl_NewIntObj(intValue);
#endif
}
#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
long longValue;
int result = Tcl_ExprLong(interp, expr, &longValue);
@@ -302,18 +188,12 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
static int formatInt(char *buffer, int n){
return TclFormatInt(buffer, (long)n);
}
#define TclFormatInt (int(*)(char *, long))formatInt
#endif /* TCL_WIDE_INT_IS_LONG */
#endif /* __CYGWIN__ */
#ifdef TCL_NO_DEPRECATED
# define Tcl_SeekOld 0
# define Tcl_TellOld 0
#if defined(TCL_NO_DEPRECATED)
# undef Tcl_SetBooleanObj
# define Tcl_SetBooleanObj 0
# undef Tcl_PkgPresent
@@ -359,49 +239,6 @@ static int formatInt(char *buffer, int n){
# define Tcl_DiscardResult 0
# undef Tcl_SetResult
# define Tcl_SetResult 0
# undef Tcl_EvalObj
# define Tcl_EvalObj 0
# undef Tcl_GlobalEvalObj
# define Tcl_GlobalEvalObj 0
# define TclBackgroundException 0
# undef TclpReaddir
# define TclpReaddir 0
# undef TclpGetDate
# define TclpGetDate 0
# undef TclpLocaltime
# define TclpLocaltime 0
# undef TclpGmtime
# define TclpGmtime 0
# define TclpLocaltime_unix 0
# define TclpGmtime_unix 0
#else /* TCL_NO_DEPRECATED */
# define Tcl_SeekOld seekOld
# define Tcl_TellOld tellOld
# define TclBackgroundException Tcl_BackgroundException
# define TclpLocaltime_unix TclpLocaltime
# define TclpGmtime_unix TclpGmtime
static int
seekOld(
Tcl_Channel chan, /* The channel on which to seek. */
int offset, /* Offset to seek to. */
int mode) /* Relative to which location to seek? */
{
Tcl_WideInt wOffset, wResult;
wOffset = Tcl_LongAsWide((long) offset);
wResult = Tcl_Seek(chan, wOffset, mode);
return (int) Tcl_WideAsLong(wResult);
}
static int
tellOld(
Tcl_Channel chan) /* The channel to return pos for. */
{
Tcl_WideInt wResult = Tcl_Tell(chan);
return (int) Tcl_WideAsLong(wResult);
}
#endif /* !TCL_NO_DEPRECATED */
/*
@@ -426,7 +263,7 @@ static const TclIntStubs tclIntStubs = {
TclCleanupChildren, /* 5 */
TclCleanupCommand, /* 6 */
TclCopyAndCollapse, /* 7 */
TclCopyChannelOld, /* 8 */
0, /* 8 */
TclCreatePipeline, /* 9 */
TclCreateProc, /* 10 */
TclDeleteCompiledLocalVars, /* 11 */
@@ -495,7 +332,7 @@ static const TclIntStubs tclIntStubs = {
TclpFree, /* 74 */
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
TclpGetTime, /* 77 */
0, /* 77 */
0, /* 78 */
0, /* 79 */
0, /* 80 */
@@ -506,7 +343,7 @@ static const TclIntStubs tclIntStubs = {
0, /* 85 */
0, /* 86 */
0, /* 87 */
TclPrecTraceProc, /* 88 */
0, /* 88 */
TclPreventAliasLoop, /* 89 */
0, /* 90 */
TclProcCleanupProc, /* 91 */
@@ -522,7 +359,7 @@ static const TclIntStubs tclIntStubs = {
TclSetPreInitScript, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
TclSockMinimumBuffersOld, /* 104 */
0, /* 104 */
0, /* 105 */
0, /* 106 */
0, /* 107 */
@@ -530,28 +367,28 @@ static const TclIntStubs tclIntStubs = {
TclUpdateReturnInfo, /* 109 */
TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
Tcl_AppendExportList, /* 112 */
Tcl_CreateNamespace, /* 113 */
Tcl_DeleteNamespace, /* 114 */
Tcl_Export, /* 115 */
Tcl_FindCommand, /* 116 */
Tcl_FindNamespace, /* 117 */
0, /* 112 */
0, /* 113 */
0, /* 114 */
0, /* 115 */
0, /* 116 */
0, /* 117 */
Tcl_GetInterpResolvers, /* 118 */
Tcl_GetNamespaceResolvers, /* 119 */
Tcl_FindNamespaceVar, /* 120 */
Tcl_ForgetImport, /* 121 */
Tcl_GetCommandFromObj, /* 122 */
Tcl_GetCommandFullName, /* 123 */
Tcl_GetCurrentNamespace, /* 124 */
Tcl_GetGlobalNamespace, /* 125 */
0, /* 121 */
0, /* 122 */
0, /* 123 */
0, /* 124 */
0, /* 125 */
Tcl_GetVariableFullName, /* 126 */
Tcl_Import, /* 127 */
0, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
Tcl_SetNamespaceResolvers, /* 131 */
TclpHasSockets, /* 132 */
TclpGetDate, /* 133 */
0, /* 133 */
0, /* 134 */
0, /* 135 */
0, /* 136 */
@@ -576,8 +413,8 @@ static const TclIntStubs tclIntStubs = {
0, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
TclSetStartupScriptFileName, /* 158 */
TclGetStartupScriptFileName, /* 159 */
0, /* 158 */
0, /* 159 */
0, /* 160 */
TclChannelTransform, /* 161 */
TclChannelEventScriptInvoker, /* 162 */
@@ -585,8 +422,8 @@ static const TclIntStubs tclIntStubs = {
TclExpandCodeArray, /* 164 */
TclpSetInitialEncodings, /* 165 */
TclListObjSetElement, /* 166 */
TclSetStartupScriptPath, /* 167 */
TclGetStartupScriptPath, /* 168 */
0, /* 167 */
0, /* 168 */
TclpUtfNcmp2, /* 169 */
TclCheckInterpTraces, /* 170 */
TclCheckExecutionTraces, /* 171 */
@@ -596,12 +433,12 @@ static const TclIntStubs tclIntStubs = {
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
Tcl_SetStartupScript, /* 178 */
Tcl_GetStartupScript, /* 179 */
0, /* 178 */
0, /* 179 */
0, /* 180 */
0, /* 181 */
TclpLocaltime, /* 182 */
TclpGmtime, /* 183 */
0, /* 182 */
0, /* 183 */
0, /* 184 */
0, /* 185 */
0, /* 186 */
@@ -654,7 +491,7 @@ static const TclIntStubs tclIntStubs = {
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
TclBackgroundException, /* 236 */
0, /* 236 */
TclResetCancellation, /* 237 */
TclNRInterpProc, /* 238 */
TclNRInterpProcCore, /* 239 */
@@ -691,10 +528,10 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
TclpReaddir, /* 10 */
TclpLocaltime_unix, /* 11 */
TclpGmtime_unix, /* 12 */
TclpInetNtoa, /* 13 */
0, /* 10 */
0, /* 11 */
0, /* 12 */
0, /* 13 */
TclUnixCopyFile, /* 14 */
0, /* 15 */
0, /* 16 */
@@ -715,16 +552,16 @@ static const TclIntPlatStubs tclIntPlatStubs = {
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
TclWinGetSockOpt, /* 3 */
0, /* 1 */
0, /* 2 */
0, /* 3 */
TclWinGetTclInstance, /* 4 */
TclUnixWaitForFile, /* 5 */
TclWinNToHS, /* 6 */
TclWinSetSockOpt, /* 7 */
0, /* 6 */
0, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
TclpReaddir, /* 10 */
0, /* 9 */
0, /* 10 */
TclGetAndDetachPids, /* 11 */
TclpCloseFile, /* 12 */
TclpCreateCommandChannel, /* 13 */
@@ -735,14 +572,14 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
TclpInetNtoa, /* 21 */
0, /* 21 */
TclpCreateTempFile, /* 22 */
0, /* 23 */
TclWinNoBackslash, /* 24 */
0, /* 25 */
TclWinSetInterfaces, /* 26 */
0, /* 26 */
TclWinFlushDirtyChannels, /* 27 */
TclWinResetInterfaces, /* 28 */
0, /* 28 */
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
#endif /* WIN */
@@ -757,10 +594,10 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
TclpReaddir, /* 10 */
TclpLocaltime_unix, /* 11 */
TclpGmtime_unix, /* 12 */
TclpInetNtoa, /* 13 */
0, /* 10 */
0, /* 11 */
0, /* 12 */
0, /* 13 */
TclUnixCopyFile, /* 14 */
TclMacOSXGetFileAttribute, /* 15 */
TclMacOSXSetFileAttribute, /* 16 */
@@ -861,9 +698,9 @@ const TclTomMathStubs tclTomMathStubs = {
TclBN_mp_init_set_int, /* 61 */
TclBN_mp_set_int, /* 62 */
TclBN_mp_cnt_lsb, /* 63 */
TclBNInitBignumFromLong, /* 64 */
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
0, /* 64 */
0, /* 65 */
0, /* 66 */
TclBN_mp_expt_d_ex, /* 67 */
TclBN_mp_set_long_long, /* 68 */
TclBN_mp_get_long_long, /* 69 */
@@ -918,11 +755,11 @@ const TclStubs tclStubs = {
Tcl_DbDecrRefCount, /* 19 */
Tcl_DbIncrRefCount, /* 20 */
Tcl_DbIsShared, /* 21 */
Tcl_DbNewBooleanObj, /* 22 */
0, /* 22 */
Tcl_DbNewByteArrayObj, /* 23 */
Tcl_DbNewDoubleObj, /* 24 */
Tcl_DbNewListObj, /* 25 */
Tcl_DbNewLongObj, /* 26 */
0, /* 26 */
Tcl_DbNewObj, /* 27 */
Tcl_DbNewStringObj, /* 28 */
Tcl_DuplicateObj, /* 29 */
@@ -945,21 +782,21 @@ const TclStubs tclStubs = {
Tcl_ListObjIndex, /* 46 */
Tcl_ListObjLength, /* 47 */
Tcl_ListObjReplace, /* 48 */
Tcl_NewBooleanObj, /* 49 */
0, /* 49 */
Tcl_NewByteArrayObj, /* 50 */
Tcl_NewDoubleObj, /* 51 */
Tcl_NewIntObj, /* 52 */
0, /* 52 */
Tcl_NewListObj, /* 53 */
Tcl_NewLongObj, /* 54 */
0, /* 54 */
Tcl_NewObj, /* 55 */
Tcl_NewStringObj, /* 56 */
Tcl_SetBooleanObj, /* 57 */
0, /* 57 */
Tcl_SetByteArrayLength, /* 58 */
Tcl_SetByteArrayObj, /* 59 */
Tcl_SetDoubleObj, /* 60 */
Tcl_SetIntObj, /* 61 */
0, /* 61 */
Tcl_SetListObj, /* 62 */
Tcl_SetLongObj, /* 63 */
0, /* 63 */
Tcl_SetObjLength, /* 64 */
Tcl_SetStringObj, /* 65 */
Tcl_AddErrorInfo, /* 66 */
@@ -973,7 +810,7 @@ const TclStubs tclStubs = {
Tcl_AsyncMark, /* 74 */
Tcl_AsyncReady, /* 75 */
Tcl_BackgroundError, /* 76 */
Tcl_Backslash, /* 77 */
0, /* 77 */
Tcl_BadChannelOption, /* 78 */
Tcl_CallWhenDeleted, /* 79 */
Tcl_CancelIdleCall, /* 80 */
@@ -991,7 +828,7 @@ const TclStubs tclStubs = {
Tcl_CreateEventSource, /* 92 */
Tcl_CreateExitHandler, /* 93 */
Tcl_CreateInterp, /* 94 */
Tcl_CreateMathFunc, /* 95 */
0, /* 95 */
Tcl_CreateObjCommand, /* 96 */
Tcl_CreateSlave, /* 97 */
Tcl_CreateTimerHandler, /* 98 */
@@ -1027,7 +864,7 @@ const TclStubs tclStubs = {
Tcl_ErrnoMsg, /* 128 */
Tcl_Eval, /* 129 */
Tcl_EvalFile, /* 130 */
Tcl_EvalObj, /* 131 */
0, /* 131 */
Tcl_EventuallyFree, /* 132 */
Tcl_Exit, /* 133 */
Tcl_ExposeCommand, /* 134 */
@@ -1082,7 +919,7 @@ const TclStubs tclStubs = {
Tcl_GetVar, /* 175 */
Tcl_GetVar2, /* 176 */
Tcl_GlobalEval, /* 177 */
Tcl_GlobalEvalObj, /* 178 */
0, /* 178 */
Tcl_HideCommand, /* 179 */
Tcl_Init, /* 180 */
Tcl_InitHashTable, /* 181 */
@@ -1124,7 +961,7 @@ const TclStubs tclStubs = {
Tcl_ResetResult, /* 217 */
Tcl_ScanElement, /* 218 */
Tcl_ScanCountedElement, /* 219 */
Tcl_SeekOld, /* 220 */
0, /* 220 */
Tcl_ServiceAll, /* 221 */
Tcl_ServiceEvent, /* 222 */
Tcl_SetAssocData, /* 223 */
@@ -1150,7 +987,7 @@ const TclStubs tclStubs = {
Tcl_SplitPath, /* 243 */
Tcl_StaticPackage, /* 244 */
Tcl_StringMatch, /* 245 */
Tcl_TellOld, /* 246 */
0, /* 246 */
Tcl_TraceVar, /* 247 */
Tcl_TraceVar2, /* 248 */
Tcl_TranslateFileName, /* 249 */
@@ -1245,8 +1082,8 @@ const TclStubs tclStubs = {
Tcl_WriteChars, /* 338 */
Tcl_WriteObj, /* 339 */
Tcl_GetString, /* 340 */
Tcl_GetDefaultEncodingDir, /* 341 */
Tcl_SetDefaultEncodingDir, /* 342 */
0, /* 341 */
0, /* 342 */
Tcl_AlertNotifier, /* 343 */
Tcl_ServiceModeHook, /* 344 */
Tcl_UniCharIsAlnum, /* 345 */
@@ -1261,7 +1098,7 @@ const TclStubs tclStubs = {
Tcl_UniCharToUtfDString, /* 354 */
Tcl_UtfToUniCharDString, /* 355 */
Tcl_GetRegExpFromObj, /* 356 */
Tcl_EvalTokens, /* 357 */
0, /* 357 */
Tcl_FreeParse, /* 358 */
Tcl_LogCommandInfo, /* 359 */
Tcl_ParseBraces, /* 360 */
@@ -1325,8 +1162,8 @@ const TclStubs tclStubs = {
Tcl_IsChannelExisting, /* 418 */
Tcl_UniCharNcasecmp, /* 419 */
Tcl_UniCharCaseMatch, /* 420 */
Tcl_FindHashEntry, /* 421 */
Tcl_CreateHashEntry, /* 422 */
0, /* 421 */
0, /* 422 */
Tcl_InitCustomHashTable, /* 423 */
Tcl_InitObjHashTable, /* 424 */
Tcl_CommandTraceInfo, /* 425 */
@@ -1339,8 +1176,8 @@ const TclStubs tclStubs = {
Tcl_AttemptSetObjLength, /* 432 */
Tcl_GetChannelThread, /* 433 */
Tcl_GetUnicodeFromObj, /* 434 */
Tcl_GetMathFuncInfo, /* 435 */
Tcl_ListMathFuncs, /* 436 */
0, /* 435 */
0, /* 436 */
Tcl_SubstObj, /* 437 */
Tcl_DetachChannel, /* 438 */
Tcl_IsStandardChannel, /* 439 */
+57 -166
View File
@@ -305,14 +305,6 @@ static int TestlinkCmd(ClientData dummy,
static int TestlocaleCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#ifndef TCL_NO_DEPRECATED
static int TestMathFunc(ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr);
static int TestMathFunc2(ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr);
#endif /* TCL_NO_DEPRECATED */
static int TestmainthreadCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestsetmainloopCmd(ClientData dummy,
@@ -424,6 +416,12 @@ static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
static int TestNumUtfCharsCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestFindFirstCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestFindLastCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestHashSystemHashCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -549,10 +547,6 @@ int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
#ifndef TCL_NO_DEPRECATED
Tcl_ValueType t3ArgTypes[2];
#endif /* TCL_NO_DEPRECATED */
Tcl_Obj *listPtr;
Tcl_Obj **objv;
int objc, index;
@@ -692,6 +686,10 @@ Tcltest_Init(
TestsetobjerrorcodeCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindfirst",
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
@@ -701,10 +699,6 @@ Tcltest_Init(
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
#ifndef TCL_NO_DEPRECATED
Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
#endif /* TCL_NO_DEPRECATED */
Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
@@ -715,13 +709,6 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
(ClientData) 0, NULL);
#endif
#ifndef TCL_NO_DEPRECATED
t3ArgTypes[0] = TCL_EITHER;
t3ArgTypes[1] = TCL_EITHER;
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
NULL);
#endif /* TCL_NO_DEPRECATED */
Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
@@ -3344,146 +3331,6 @@ TestlocaleCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestMathFunc --
*
* This is a user-defined math procedure to test out math procedures
* with no arguments.
*
* Results:
* A normal Tcl completion code.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
#ifndef TCL_NO_DEPRECATED
static int
TestMathFunc(
ClientData clientData, /* Integer value to return. */
Tcl_Interp *interp, /* Not used. */
Tcl_Value *args, /* Not used. */
Tcl_Value *resultPtr) /* Where to store result. */
{
resultPtr->type = TCL_INT;
resultPtr->intValue = PTR2INT(clientData);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestMathFunc2 --
*
* This is a user-defined math procedure to test out math procedures
* that do have arguments, in this case 2.
*
* Results:
* A normal Tcl completion code.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
TestMathFunc2(
ClientData clientData, /* Integer value to return. */
Tcl_Interp *interp, /* Used to report errors. */
Tcl_Value *args, /* Points to an array of two Tcl_Value structs
* for the two arguments. */
Tcl_Value *resultPtr) /* Where to store the result. */
{
int result = TCL_OK;
/*
* Return the maximum of the two arguments with the correct type.
*/
if (args[0].type == TCL_INT) {
int i0 = args[0].intValue;
if (args[1].type == TCL_INT) {
int i1 = args[1].intValue;
resultPtr->type = TCL_INT;
resultPtr->intValue = ((i0 > i1)? i0 : i1);
} else if (args[1].type == TCL_DOUBLE) {
double d0 = i0;
double d1 = args[1].doubleValue;
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
} else if (args[1].type == TCL_WIDE_INT) {
Tcl_WideInt w0 = Tcl_LongAsWide(i0);
Tcl_WideInt w1 = args[1].wideValue;
resultPtr->type = TCL_WIDE_INT;
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
} else {
Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
result = TCL_ERROR;
}
} else if (args[0].type == TCL_DOUBLE) {
double d0 = args[0].doubleValue;
if (args[1].type == TCL_INT) {
double d1 = args[1].intValue;
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
} else if (args[1].type == TCL_DOUBLE) {
double d1 = args[1].doubleValue;
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
} else if (args[1].type == TCL_WIDE_INT) {
double d1 = Tcl_WideAsDouble(args[1].wideValue);
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
} else {
Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
result = TCL_ERROR;
}
} else if (args[0].type == TCL_WIDE_INT) {
Tcl_WideInt w0 = args[0].wideValue;
if (args[1].type == TCL_INT) {
Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);
resultPtr->type = TCL_WIDE_INT;
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
} else if (args[1].type == TCL_DOUBLE) {
double d0 = Tcl_WideAsDouble(w0);
double d1 = args[1].doubleValue;
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
} else if (args[1].type == TCL_WIDE_INT) {
Tcl_WideInt w1 = args[1].wideValue;
resultPtr->type = TCL_WIDE_INT;
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
} else {
Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
result = TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "T3: wrong type for arg 1", NULL);
result = TCL_ERROR;
}
return result;
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
@@ -5356,7 +5203,7 @@ TestmainthreadCmd(
const char **argv) /* Argument strings. */
{
if (argc == 1) {
Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
@@ -5753,8 +5600,8 @@ TestChannelCmd(
return TCL_ERROR;
}
TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
Tcl_AppendResult(interp, buf, NULL);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
return TCL_OK;
}
@@ -6881,6 +6728,50 @@ TestNumUtfCharsCmd(
return TCL_OK;
}
/*
* Used to check correct operation of Tcl_UtfFindFirst
*/
static int
TestFindFirstCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
/*
* Used to check correct operation of Tcl_UtfFindLast
*/
static int
TestFindLastCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------

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