Compare commits

...
Author SHA1 Message Date
dgp e54d9d0c94 merge 8.7 2018-02-23 18:08:36 +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 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
dgp d92edae7e2 merge 8.7 2018-02-15 18:27:05 +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 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 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 3c9a74f58c merge 8.7 2018-02-14 15:00:17 +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 7cdfbbc10c merge 8.7 2018-02-09 20:57:30 +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
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 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 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
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 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
dgp a91a25c071 New bytecode instructions must be appended at the end of the instruction table. 2018-01-25 22:42:02 +00:00
dgp 4a6af27995 merge 8.7 2018-01-25 21:59:17 +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
dgp 7ae57a5517 Dup test names 2018-01-25 19:50:12 +00:00
dgp 554cff1f33 merge 8.7 2018-01-25 19:36:03 +00:00
jan.nijtmans 68214211b7 Document "L" length modifier and (new) %a/%A specifiers. 2018-01-24 12:02:05 +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 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 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 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 ac67b57981 merge core-8-branch 2018-01-18 09:46:29 +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
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
jan.nijtmans f0b9b9fbb6 merge core-8-branch 2018-01-12 16:30:03 +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 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 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 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 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
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
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 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
pooryorick b0e6ac7da9 merge core-8-branch 2017-12-26 17:27:28 +00:00
pooryorick 9a9b619c9f TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. 2017-12-26 12:27:14 +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 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 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 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 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 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
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 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 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 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 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 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 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 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 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 dfeacc8edb Fix [040586323610be22f8617962377324f4ddc9bc02|0405863236]: wrong field checked in struct pollfd in TclUnixWaitForFile 2017-12-10 14:35:02 +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 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 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 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 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 21877b851c Adapt the bytearray accommodation of Tcl_CharLength() for 8.7+. 2017-12-06 13:28:12 +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 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 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 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 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 99798b2202 Fix build of test-suite, after previous commit 2017-11-30 15:24:39 +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 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
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 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 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
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 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 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 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 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
apnadkarni 335305de9c Added back nothreads option. 2017-11-17 15:46:23 +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 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 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 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 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
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 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 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 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
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 cf4d5a8cfe TIP #485 implementation: "Remove Deprecated API". Based on Tcl 8.7 (core-8-branch). 2017-11-08 11:50:55 +00:00
jan.nijtmans ed20823380 merge core-8-branch 2017-11-08 09:38:15 +00:00
jan.nijtmans 12d3a7d307 Change "epoch" field for dicts from "int" to "unsigned int". This doubles the number of available epoch's before overflow. Also make 0 the special value in stead of -1, meaning "dict search done". That also means that epoch counting starts with 1. 2017-11-08 09:37:31 +00:00
dgp e82d7fb753 compiler warning 2017-11-08 03:02:22 +00:00
dgp 5188d1d927 compiler warning 2017-11-08 02:57:58 +00:00
dgp b8bf04f5ec compiler warning 2017-11-08 02:53:57 +00:00
dgp f31af075d0 compiler warning 2017-11-08 02:50:28 +00:00
dgp 3b989eefe0 merge 8.7 2017-11-08 02:48:47 +00:00
dgp a2d6ec1119 merge 8.6 2017-11-08 02:26:07 +00:00
dgp 2ba5fab30e Modify TclCreateProc to handle arbitrary argument names, not just ASCII. 2017-11-08 02:25:40 +00:00
dgp f74bde3e62 [3298012] Stop RebuildTable asking ckalloc for more than it can give. 2017-11-08 02:23:46 +00:00
dgp 98c6b22c10 TclOO object allocation: Set classPtr to NULL if it wasn't otherwise set. 2017-11-08 02:21:49 +00:00
dgp be0c5786a0 [3298012] Stop RebuildTable asking ckalloc for more than it can give. 2017-11-08 02:18:25 +00:00
pooryorick a982dd11fa Modify TclCreateProc to handle arbitrary argument names, not just ASCII. 2017-11-08 00:39:17 +00:00
dgp fd61a8e89e Attempted bug fix. 2017-11-07 21:32:04 +00:00
pooryorick 2c1224dce7 TclOO object allocation: Set classPtr to NULL if it wasn't otherwise set. 2017-11-07 20:54:02 +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 f941597e43 merge 8.7 2017-11-07 14:28:03 +00:00
jan.nijtmans c1e89d73fd merge core-8-branch 2017-11-07 13:30:08 +00:00
jan.nijtmans d0665d7a12 merge core-8-6-branch 2017-11-07 13:29:28 +00:00
jan.nijtmans ac4fb39a73 Don't use Unicode character \udead in test-cases, because it is an invalid Unicode code-point (lower surrogate). This will cause test-failures with TIP #389. Just use \ud0ad in stead. Also fix some other test-cases which fail for TCL_UTF_MAX == 4. 2017-11-07 13:19:37 +00:00
jan.nijtmans 45808db8dc TIP #422 implementation, Tcl 8.7 part. 2017-11-07 09:08:48 +00:00
jan.nijtmans 47b333303e merge-mark 2017-11-06 15:04:23 +00:00
jan.nijtmans 27e8f4db3d More tcl8 -> tcl9 renumbering, for example related to the installation of Tcl packages where tcl9 actually can find them. 2017-11-06 14:50:08 +00:00
jan.nijtmans c06751fdf8 Fix version number of Windows Help file (not sure if it's actually used, but better safe than sorry) 2017-11-06 14:46:49 +00:00
pooryorick 9b30058284 Rewrite documentation in comments for brevity and clarity. 2017-11-06 01:33:57 +00:00
dgp 22719c6596 Test case for Bug 5d65e65036. 2017-11-06 00:10:21 +00:00
jan.nijtmans cf516b0eb8 merge core-8-branch 2017-11-05 14:35:43 +00:00
jan.nijtmans 8c4d8a4f14 Merge core-8-branch. More 8.7 -> 9.0 changes as appropriate 2017-11-05 14:21:21 +00:00
jan.nijtmans ded2a79966 update .project file with branch name. Make clear that optparse doesnt work with 8.4 any more 2017-11-05 14:14:23 +00:00
dkf d52223f024 [0d902eadd6] Ensure that [string first] handles ASCII in Unicode correctly. 2017-11-04 00:45:27 +00:00
dkf 4030616bbf [0d902eadd6] Ensure that [string first] handles ASCII in Unicode correctly. 2017-11-04 00:44:14 +00:00
dkf b55d5cc57e Fix for the weird [string first] behaviour. 2017-11-04 00:34:48 +00:00
dkf e4356f7d64 Detected bug in [string first] with unicode. Pat Thoyts found it. 2017-11-04 00:25:43 +00:00
dgp 88451d16ba TIPs 330 & 336 changes to Tcl 9 Implementation 2017-11-03 18:56:33 +00:00
dgp 3691ae66b6 TIP 278 Implementation 2017-11-03 18:44:39 +00:00
dgp 203cbf2ea0 TIP 114 Implementation 2017-11-03 18:39:47 +00:00
dgp b6c2770a30 Merge package tolerances of Tcl 9. 2017-11-03 17:12:47 +00:00
dgp 1a0c2e24eb Bump to 9.0a0 2017-11-03 17:11:13 +00:00
dgp 0480b5d79b Revise a few stray packages not yet ready to tolerate a Tcl 9 bump. 2017-11-03 17:02:49 +00:00
dgp 10a9305777 TIP 345 Implementation. 2017-11-03 16:48:44 +00:00
jan.nijtmans d8596e5583 merge core-8-6-branch 2017-11-03 12:59:07 +00:00
jan.nijtmans 5528e1c1a2 Fix [6f2f83cc149e9918884faffefebc8dfa695f4ea0|6f2f83cc14]: tclWinload.c robustness. And fix a minor possible memory leak in TclSetupEnv() as well. Thanks to Christian Werner for both suggestions, backported from Androwish. 2017-11-03 12:57:15 +00:00
jan.nijtmans 735d38cd7c merge trunk 2017-11-03 12:24:06 +00:00
jan.nijtmans 785f1059e4 merge core-8-6-branch 2017-11-03 12:15:08 +00:00
jan.nijtmans 274ab123a8 Better versions of TclGetIntFromObj and TclGetIntForIndexM macro's, which give advantage for platforms where longs are not ints (e.g. linux64) 2017-11-03 12:14:01 +00:00
pooryorick d33ee7bc07 Unit test for issue 3c32a3f8bd, Segmentation fault in
TclOO.c/ReleaseClassContents() for a class mixed into one of its instances.
2017-11-01 22:21:50 +00:00
pooryorick 8bb421f959 Fix bug 3c32a3f8bd, segmentation fault in TclOO.c/ReleaseClassContents()
for a class mixed into one of its instances.
2017-11-01 21:05:32 +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 b0a9f6c55b Simplify implementation of Tcl_SaveResult/Tcl_RestoreResult/Tcl_DiscardResult by no longer assuming that Tcl_SavedResult is a struct. Backported from "novem" branch. 2017-10-31 09:48:57 +00:00
jan.nijtmans b8b341fea6 Fix some pointer arthemeric (only visible on big-endian systems) 2017-10-30 16:46:49 +00:00
dgp 9a322ef016 tidy? 2017-10-30 15:35:58 +00:00
dgp 312263821f tidy 2017-10-30 15:25:36 +00:00
dgp 9e80ee005e tidying 2017-10-30 15:15:06 +00:00
dgp 3aa68b1a0b Patch to make changes to Tcl 9 prescribed by TIPs 330 and 336.
This makes the Tcl_Interp struct fully opaque.
No interp->result or interp->errorline
2017-10-30 14:56:57 +00:00
jan.nijtmans ca470c3d4e more progress in code simplifications 2017-10-30 14:32:52 +00:00
dgp 6642181b9d Rebase tip-278 branch to workaround CVS conversion woes. 2017-10-30 12:41:21 +00:00
dgp 2ff3ecb534 merge trunk 2017-10-30 12:02:48 +00:00
dgp a67fec7324 merge trunk 2017-10-30 12:02:28 +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
pooryorick e0578530b0 merge bug-fc1409fc91. 2017-10-30 05:25:19 +00:00
pooryorick a79bc3c8ce Fix for issue 9fd5c629c1, TclOO - aborts when a trace on command deletion
deletes the object's namespace.
2017-10-30 05:19:55 +00:00
dgp 30c40c4540 merge 8.6 2017-10-30 03:23:59 +00:00
dgp c5865fcd24 More test rewrites for robust var resolution. 2017-10-30 03:23:28 +00:00
dgp c8342af338 merge 8.6 2017-10-30 03:01:46 +00:00
dgp 1d0751deb7 Revise tests that relied on deprecated variable resolution rules. 2017-10-30 02:55:30 +00:00
apnadkarni 2318b70929 Minor edits 2017-10-28 17:18:58 +00:00
dgp bed6e18d15 merge trunk 2017-10-27 13:12:09 +00:00
dgp fcc5b3486f merge trunk 2017-10-27 13:07:10 +00:00
dgp c668ed46ec oops 2017-10-27 12:57:45 +00:00
dgp 0a3f9ca6fc oops 2017-10-27 12:57:15 +00:00
dgp 261012ce98 Update tests that were still written on the outdated premise that Tcl's encoding subsystem had to initialize starting in the identity encoding. 2017-10-27 12:51:14 +00:00
dgp 2f8bbbe141 Update tests that were still written on the outdated premise that Tcl's encoding subsystem had to initialize starting in the identity encoding. 2017-10-27 12:50:38 +00:00
dgp 4ab9cb5418 Update tests that were still written on the outdated premise that Tcl's
encoding subsystem had to initialize starting in the identity encoding.
2017-10-27 12:23:28 +00:00
dgp 3888c4fda4 merge mark 2017-10-27 12:04:53 +00:00
jan.nijtmans fa2e7e8949 Fix timeout calculation in epoll-based notifier. Proposed fix for [1a6a36d901dedead248ea96df09d5dc159532652|1a6a36d901]. Patch by Lucio Andrés Illanes Albornoz. Thanks! 2017-10-27 07:26:15 +00:00
apnadkarni c324bb3eff Reworked build command macros (MAKEBINCMD, CCPKGCMD etc.) and purged old comments. 2017-10-26 15:07:16 +00:00
dgp 053a74e0fa Create new testing command [teststringbytes] to probe the things that
otherwise require [encoding convertto identity]. adapt encoding-15.3 to use.
2017-10-26 02:08:27 +00:00
apnadkarni ff1c348970 Updated comments. 2017-10-25 02:59:46 +00:00
dgp 30c6827ee1 Convert remaining tests to use [testbytestring].
encoding-15.3 still needs replacement for [encoding convertto identity].
That is, some testing command to expose objPtr->bytes.
2017-10-25 02:54:24 +00:00
dgp eb2cfa3e6f Repair Tcl_CreateEncoding(); Modernize [testencoding];
Update most tests toying with identity encoding.
2017-10-25 02:23:12 +00:00
dgp 40d9b81e23 Stop using "identity" as an encoding to test basic functionng of the
[encoding] command. "iso8859-1" is another one always available.
2017-10-24 23:30:35 +00:00
dgp 1552384787 Extend Tcl_CreateEncoding() to be able to create an encoding without
registering it when it has no name.  Then use this to create "identity"
encoding without naming it "identity". Then no one can look it up by that name.
2017-10-24 23:16:23 +00:00
dkf 9306fa604c Cherrypick: [fc1409fc91] Method cloning needs to be careful with body representations. 2017-10-24 14:11:16 +00:00
jan.nijtmans 16976013d1 merge trunk 2017-10-24 13:59:40 +00:00
jan.nijtmans d5f679a3f6 Change (internal) refCount field from TclRegexp to type size_t: this allows more references on 64-bit platforms. Remove unused macro "xxx" in regguts.h. Remove superflouous eol-space in oo.test. 2017-10-24 13:56:26 +00:00
Kevin B Kenny e532a0de84 Historical change affecting tests: Detroit did not observe Daylight Saving Time in 1967 2017-10-24 13:32:54 +00:00
Kevin B Kenny 745b43f627 Historical change affecting tests: Detroit did not observe Daylight Saving Time in 1967 2017-10-24 13:30:41 +00:00
Kevin B Kenny f18d453679 Historical change affecting tests: Detroit did not observe Daylight Saving Time in 1967 2017-10-24 13:24:25 +00:00
Kevin B Kenny 2332ac45ca Update to tzdata2017c 2017-10-24 13:18:51 +00:00
dkf 634213a9c8 [fc1409fc91] Method cloning needs to be careful with body representations. 2017-10-24 11:25:29 +00:00
dkf 8e537759cf Added test case. 2017-10-24 11:23:54 +00:00
pooryorick fada619052 [fc1409fc91]: TclOO method with non-literal value for body argument causes segmentation fault 2017-10-24 08:38:17 +00:00
dgp 319b71965b backout initial commit; need more care.
Binary writes internally make use of this encoding.  Need to hide it
instead of destroy it.
2017-10-23 17:58:07 +00:00
José Ignacio Marín 47a0727695 Update TZ info to tzcode2017c. 2017-10-23 17:10:19 +00:00
dgp 45d0977a5c Implementation branch for TIP 345: Kill the "identity" encoding.
This checkin, completely does that.  Bad news is it causes huge failures.
We're still making a lot of use of this encoding, and cannot complete
this TIP until the branch is repaired.
2017-10-23 17:06:57 +00:00
José Ignacio Marín 4407704316 Update TZ info to tzcode2017c. 2017-10-23 16:59:20 +00:00
dgp 172896b15a Implementation branch for TIP 114 - Eliminate Octal Parsing... 2017-10-23 16:20:18 +00:00
apnadkarni fe8915122a Eliminate loimpact and tclalloc options. 2017-10-23 13:53:51 +00:00
jan.nijtmans e9b584f81b merge core-8-6-branch 2017-10-23 12:10:42 +00:00
jan.nijtmans cdb25d8946 Fix [b58e6897034fc5292c9d36ba8099d9a835c98172|b58e689703]: Return value of 'Tcl_Flush' 2017-10-23 12:09:48 +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
dkf 56d6e9480f [1a56550e96] Ensure that method list introspection finds methods from mixins in all cases. 2017-10-19 09:30:16 +00:00
dkf df974e71f9 Oops; put the code in the wrong place. Mixins have priority when deciding method visibility. 2017-10-19 09:28:16 +00:00
dkf 7393032d5e [1a56550e96] Ensure that method list introspection finds methods from mixins in all cases. 2017-10-19 09:24:12 +00:00
dkf 252f75d8c8 Ensure that method list introspection finds methods from mixins in all cases. Use better approach for preventing excessive iteration. 2017-10-19 09:22:05 +00:00
dkf 69030a86c8 [1a56550e96] Mixins aren't being searched correctly by [info class methods -all] 2017-10-18 18:23:38 +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
dgp 8a910c1a53 Plug some memleaks. 2017-10-13 16:15:52 +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
jan.nijtmans e7582d10c6 Eliminate variable which is only used once. And a minor end-of-line space reduction. No functional change. 2017-10-12 15:20:42 +00:00
jan.nijtmans 5064777d16 merge core-8-6-branch 2017-10-09 14:27:31 +00:00
jan.nijtmans 5b74714749 In nmakehlp -v, return non-0 exit code if version is not found. (taken from vc-reform branch) 2017-10-09 14:25:24 +00:00
jan.nijtmans 15a7950c9e In nmakehlp -v, return non-0 exit code if version is not found. (taken from vc-reform branch) 2017-10-09 14:23:39 +00:00
jan.nijtmans c925a86988 Merge core-8-6-branch 2017-10-09 12:54:39 +00:00
jan.nijtmans 75ecb090c6 Add visual-studio related entries to ignore-glob. Taken over from reform-vc branch 2017-10-09 12:53:46 +00:00
jan.nijtmans b8e5e2909e Add visual-studio related entries to ignore-glob. Taken over from reform-vc branch 2017-10-09 12:52:14 +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
andy 7738955f9a Simplify noComp for loops per mailing list suggestion from sebres [https://sourceforge.net/p/tcl/mailman/message/36065252/] 2017-10-06 00:01:21 +00:00
andy a5593081ca Merge trunk 2017-10-05 23:58:27 +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
jan.nijtmans fd6a064ee7 Merge latest 'const'ification changes from libtommath (develop branch, will be in next release). None of those are used in Tcl. 2017-10-03 09:11:05 +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
jan.nijtmans 6881a1a274 'const'ify all libtommath functions, will appear in next libtommath version. See: pull request [https://github.com/libtom/libtommath/pull/88|88] 2017-10-02 15:22:27 +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
andy 0fd41958c6 Simplify implementation of non-bytecoded [string replace] 2017-09-23 16:36:49 +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
andy b9d515abdb Update TIP number 2017-09-22 22:46:25 +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
jan.nijtmans b0fe49c36d Make libtommath's "make" work in Tcl environment (for testing). Eliminate internal s_is_power_of_two(), which can better be done inline. Fix tommath.h for _MSC_VER. 2017-09-22 08:48:23 +00:00
apnadkarni a52f0db3e4 Merged core-8-6-branch to pick up 32/64-bit DLL mismatch error message.
Actually already cherrypicked but redoing because that does not show
up on timeline and a full merge recommended on the chat.
2017-09-22 02:17:02 +00:00
apnadkarni 4bf8f43b3a RFE [566a999189] - better error message for 32/64 bit mismatch on load. 2017-09-21 19:05:11 +00:00
apnadkarni d45863129f RFE [566a999189] - better error message for 32/64 bit mismatch on load. 2017-09-21 18:47:45 +00:00
dgp adead74139 [3ae1251264] Run only the tests that match the assumptions of the test design. 2017-09-21 14:35:53 +00:00
andy 09faa1aab9 Include $noComp flag in string test names 2017-09-20 17:25:39 +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
jan.nijtmans 1b28405773 Move fast return from s_is_power_of_two() to mp_div_d(). This saves a function call in the common case where b is not a power of 2. 2017-09-20 09:21:54 +00:00
jan.nijtmans 65703d1f87 Further astyle formatting of libtommath. No functional changes. 2017-09-20 09:07:35 +00:00
andy 2f50095de1 Alternate, equivalent way of running bytecoded tests 2017-09-20 05:11:37 +00:00
andy 38f00ec3c8 Correct string tests to exercise both bytecoded and non-bytecoded implementations. string-29.6 now fails. 2017-09-20 05:08:10 +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
andy 28b052a00d Improve documentation of [string insert] with respect to end-relative indexing 2017-09-19 06:21:42 +00:00
jan.nijtmans 943b46881e Merge trunk 2017-09-18 15:13:40 +00:00
jan.nijtmans f75f76c9d4 Finish libtommath's constification work. All done (hopefully). And make sure that C preprocessor directives have the '#' as first character on the line. 2017-09-18 14:38:26 +00:00
dgp 94dd110564 merge trunk 2017-09-18 13:19:00 +00:00
jan.nijtmans f5ea63343e Another round of libtommath const'ification. To be submitted to the libtommath folks 2017-09-18 12:53:48 +00:00
jan.nijtmans a708ae2da2 Merge libtommath upstream changes (astyle formatting only). No functional changes. All Tcl-specific modifications are kept. 2017-09-18 08:31:55 +00:00
andy 191ef4be11 Document [string insert] 2017-09-18 03:11:05 +00:00
andy 5945daaae4 Document Tcl_ReplaceObj() 2017-09-18 03:02:12 +00:00
andy 1befabd977 Rename Tcl_StringReplace() to Tcl_ReplaceObj() for consistency with other public string object functions, most notably Tcl_ConcatObj() 2017-09-18 01:38:31 +00:00
andy e497f07f20 Improve comments 2017-09-18 01:29:58 +00:00
andy 8333560e5c Juggle [string insert] bytecode compilation logic 2017-09-18 01:19:12 +00:00
andy 6aceb254f3 Rearrange bytecoded [string replace] logic, reinstate [string replace]/[string insert] result tracing 2017-09-18 01:16:03 +00:00
andy 70ee4f5087 Use Tcl_StringReplace() to implement core of bytecoded [string replace] 2017-09-18 01:11:08 +00:00
andy 11ca91d9e4 Update stringComp.test for new [string insert] command 2017-09-18 00:48:46 +00:00
andy 0d02f56968 stringComp.test and maybe many other tests may need to be reconsidered so that both bytecoded and non-bytecoded code paths are exercised 2017-09-18 00:39:56 +00:00
andy d3499984e0 Correct terminology 2017-09-18 00:32:21 +00:00
andy cdd6d9c901 Implement bytecoded [string insert] 2017-09-18 00:32:06 +00:00
andy 98eac1c578 Correct bytecode index comments 2017-09-17 21:09:54 +00:00
andy fbbfbdeff8 Improve comment to describe return value 2017-09-17 21:09:11 +00:00
andy 94e0ec332e Merge trunk 2017-09-16 19:50:12 +00:00
jan.nijtmans d4e73bcab5 re-format everything through astyle. Taken from libtom/libtommath (pull request [https://github.com/libtom/libtommath/pull/85|85]) 2017-09-15 14:44:00 +00:00
jan.nijtmans 8f339500a2 'const'ify more libtommath functions. All functions in generic/tclTomMath.decls (used by Tcl) are done now. 2017-09-15 13:08:31 +00:00
dgp bf01a303da Move new declarations to more conventional place for tidier merging. 2017-09-14 14:02:12 +00:00
jan.nijtmans 99d940211c Remove some unnecessary #if 0 sections. Fix comments and panic messages. No functional changes. 2017-09-14 08:05:32 +00:00
jan.nijtmans 7b8b406719 Fix [f5da3d30e096a1c3486fbc480a6ece01fcb277a6|f5da3d30e0]: clerical error in comments 2017-09-14 07:42:38 +00:00
jan.nijtmans db3273f346 Fix [f5da3d30e096a1c3486fbc480a6ece01fcb277a6|f5da3d30e0]: clerical error in comments 2017-09-14 07:41:09 +00:00
jan.nijtmans c659b044b1 Make mp_get_long and mp_set_long available to tommath-enabled Tcl extensions. Deprecate the internal TclBNInitBignumFrom* functions, in favor of the official tommath functions with the same purpose. 2017-09-13 10:14:31 +00:00
jan.nijtmans 3e55dbb18c Many 'const' addtions in libtommath where it makes sense. To be submitted back to the libtommath guys. 2017-09-11 10:38:07 +00:00
jan.nijtmans b2446d8d41 Add some more functions from libtommath for availability within Tcl (mainly the 'long long' variants). Add more 'const' keywords there too. 2017-09-08 14:15:13 +00:00
gahr e86e8a501d Be consistent about how I am referred to. 2017-09-08 13:30:29 +00:00
dgp d03a4dcc88 Bump to 8.7a2 to distinguish trunk from 8.7a1 release. 2017-09-08 13:13:15 +00:00
dgp 4ce5b276eb merge release 2017-09-08 12:50:06 +00:00
jan.nijtmans 757012c289 Rebase to trunk 2017-09-08 12:48:35 +00:00
dgp 877e9d6b11 merge trunk; rc1 2017-09-07 12:59:14 +00:00
jan.nijtmans 413fe66650 Fix use of "long long" (manually) in MSVC 2017-09-06 15:02:24 +00:00
dgp ca70072a99 update changes 2017-09-05 15:38:02 +00:00
dgp d9f2bf1d17 merge trunk 2017-09-05 12:41:10 +00:00
jan.nijtmans c2846c0f5c Merge core-8-6-branch to trunk, especially the 1.6.0 -> 1.6.1 renumbering from msgcat 2017-09-04 14:01:45 +00:00
jan.nijtmans a15279ffd1 Make pkgIndex.tcl from msgcat work for Tcl 9.0 (not really necessary, but for consistancy) 2017-09-04 13:59:04 +00:00
jan.nijtmans b74f59a5b4 merge core-8-6-branch 2017-09-04 12:38:14 +00:00
jan.nijtmans e08c86934d Typo's (Thanks to Gustaf Neumann), nothing functional. 2017-09-04 12:37:04 +00:00
dgp a3dfc55957 [0e4d88b650] Allow command overwrite when deletion callback deletes namespace. 2017-09-02 22:10:59 +00:00
dgp e3f7bc2783 [0e4d88b650] Allow command overwrite when deletion callback deletes namespace. 2017-09-02 22:03:03 +00:00
dgp 564b991088 [0e4d88b650] Allow command overwrite when deletion callback deletes namespace. 2017-09-02 21:48:05 +00:00
dgp 0ff317501d merge 8.5 2017-09-02 21:36:57 +00:00
dgp f42f0060be Add test 2017-09-02 21:14:55 +00:00
dgp 3ec5b35deb Similar fix to Tcl_CreateCommand(). 2017-09-02 20:40:44 +00:00
dgp 7afc6b1c17 Tidy up. 2017-09-02 20:17:26 +00:00
dgp ce58cdff9f [Bug 0e4d88b650] First draft fix. Re-resolve namespace after cmd deletion. 2017-09-02 19:35:22 +00:00
jan.nijtmans 4b9e6d92be Merge core-8-6-branch 2017-09-01 13:49:55 +00:00
jan.nijtmans e28f1eece4 Handle Unicode surrogates correctly in Tcl_AppendFormatToObj() and BuildCharSet(). Only makes a difference for TCL_UTF_MAX=4, when surrogates are used in the format string ... highly unlikely corner-case. 2017-09-01 13:48:56 +00:00
dgp 4ce83fdb43 merge trunk 2017-09-01 01:44:09 +00:00
jan.nijtmans ce32fdecb2 Ignore libtommath/doc directory. Add some VS-related makefiles, useful for testing 2017-08-31 15:07:57 +00:00
jan.nijtmans 105a61c09b Merge core-8-6-branch. Remove all git tag information for libtommath, so we don't have useless file differences with every libtommath release. 2017-08-31 13:56:30 +00:00
jan.nijtmans 25b97a7df9 Adapt .fossil-settings/crlf-glob, for 5 libtommath-related files which have crlf ending 2017-08-31 13:43:17 +00:00
jan.nijtmans 432e75210f Undo tag removal (just get libtommath directly from GitHUB), so we don't have useless file changes with every new release 2017-08-31 13:32:52 +00:00
jan.nijtmans 595e613479 (merge-mark core-8-6-branch).
Give state to UtfToUtfProc() and UnicodeToUtfProc() in which the last (intermediate) Tcl_UniChar can be remembered: This way those functions can produce 4-byte UTF-8 sequences built from surrogate pairs if Tcl is compiled with TCL_UTF_MAX=4. For TCL_UTF_MAX=3 and TCL_UTF_MAX=6 this has no effect.
2017-08-31 12:21:43 +00:00
oehhar c0e413055e http state 100 continue handling broken [2a94652ee1] 2017-08-31 09:35:52 +00:00
oehhar 11719ccf59 http state 100 continue handling broken [2a94652ee1] 2017-08-31 09:32:05 +00:00
oehhar 7c7a396fc5 http state 100 continue handling broken [2a94652ee1] 2017-08-31 06:31:05 +00:00
andy 7aafa756ac Cherrypick string.test [de104ef5ab] 2017-08-30 15:29:16 +00:00
andy bb3b280cf3 Merge trunk 2017-08-30 15:22:10 +00:00
andy 535909bc9f Rename TclStringReplace() to Tcl_StringReplace() and add to the stubs table. Documentation not yet started. 2017-08-30 15:20:17 +00:00
jan.nijtmans 6d8b0c705f Tweak libtommath building, such that it doesn't depend on uint64_t any more. (handle mp_word in the same way as mp_digit) 2017-08-30 12:37:50 +00:00
jan.nijtmans faaf0a0fe6 Adapt libtommath's "changes.txt", and other text-files. Adapt bn_mp_read_radix.c to latest libtommaths 'tcl-fixes' commit (harmless for Tcl). 2017-08-30 11:46:33 +00:00
jan.nijtmans 07bcf919d6 Cherry-pick [https://github.com/libtom/libtommath/commit/a0a86c696a7182f8be4b10bb79a1c5c971dc9561]: Merge branch 'tcl-fixes' into develop
Remove many files, which are not used in Tcl.
Modify "changelog.txt", with real release-date of 1.0.1 version
2017-08-30 11:20:19 +00:00
jan.nijtmans f70c0ac860 a few missing bits after previous commit 2017-08-29 21:27:56 +00:00
jan.nijtmans 97d25d7902 Forgot a few files from libtommath 1.0.1 2017-08-29 21:16:54 +00:00
jan.nijtmans c3d5808cdd upgrade to libtommath 1.0.1 (With all Tcl-specific changes - as far as needed - intact) 2017-08-29 20:45:34 +00:00
jan.nijtmans 187a67149b Merge libtommath 1.0.1 final 2017-08-29 20:43:48 +00:00
jan.nijtmans 2d65cb7514 libtommath 1.0.1 2017-08-29 20:39:15 +00:00
jan.nijtmans 92a05930af libtommath 1.0.1 rc2, for test purposes only 2017-08-29 20:25:53 +00:00
jan.nijtmans 1ef0babc38 Fix eol-style (fossil warning: mixed line endings) 2017-08-29 19:55:52 +00:00
jan.nijtmans 92265d56a3 libtommath 1.0.1 rc 2 2017-08-29 19:52:35 +00:00
jan.nijtmans 4264a4f6ab merge-mark 2017-08-29 09:25:17 +00:00
jan.nijtmans a95a7dd265 (cherry-pick): Fix [b50fb21410dababca95baa122964b2e312cb9d8a|b50fb214] : exec redirection to append stdout and stderr to the same file 2017-08-29 09:24:29 +00:00
ferrieux 2e9194366a Fix [b50fb214] : add to 2>> the same O_APPEND that was added to >> back in 2005. 2017-08-24 16:56:51 +00:00
jan.nijtmans ce72664606 merge core-8-6-branch 2017-08-22 12:41:18 +00:00
jan.nijtmans 5210283d10 Fix [d2612a2fa193196787aab33bb57f69b1eef9e30c|d2612a2fa1]: Build breaks because of gcc error. Only use "#pragma GCC diagnostic" if the compiler supports this.
Also re-format tclUnixSock.c without further functional changes.
2017-08-22 12:12:11 +00:00
andy 4423757d23 Add test cleanup 2017-08-20 20:11:43 +00:00
andy 1e913ed0ab Add tests to exercise almost every line of TclStringReplace(). The one line not being exercised is the "return NULL" on TclStringCatObjv() failure. Coverage checked in an ad-hoc way by putting a breakpoint at the start of every basic block, then confirming each breakpoint is hit at least once when running string.test. 2017-08-20 19:57:43 +00:00
andy f9d45ca66e Tweak string index boundary conditionals for tiny performance improvement and to make existing tests cover more code paths 2017-08-20 19:55:28 +00:00
andy 935e4615a9 Add non-bytecoded [string replace] tests to exercise new TclStringReplace() function 2017-08-20 18:13:33 +00:00
andy c8c14244d4 Add string-14.18 to test that [string replace] with last<first does not insert a string, even though we might wish that it did, to be in compliance with the documented behavior. Correct non-bytecoded [string replace] accordingly. 2017-08-20 03:45:19 +00:00
andy 31dec40c9b Reimplement NON-BYTECODED [string replace] in terms of new TclStringReplace() function 2017-08-20 03:21:27 +00:00
andy 4fcd0cb3c2 Correct NULL dereference, and optimize short-circuit logical operation 2017-08-20 03:20:45 +00:00
andy c1f053321e Work toward dgp's suggestion that the underlying engine handle both [string insert] and [string replace]. Ref: [https://sourceforge.net/p/tcl/mailman/message/36002472/] 2017-08-20 02:44:56 +00:00
jan.nijtmans 0eb18d8f91 merge core-8-6-branch 2017-08-18 22:06:54 +00:00
jan.nijtmans 29be40bf89 RFE [http://core.tcl.tk/tk/info/6c0d7aec67|6c0d7aec67]: Better surrogate handling for TCL_UTF_MAX==4. No change when TCL_UTF_MAX==3. (This commit is actually meant for androwish, in order to improve surrogate handling for TCL_UTF_MAX==4) 2017-08-18 21:39:16 +00:00
jan.nijtmans e6336bb806 Merge core-8-6-branch. Update outdated comment (cherry-pick [d5dec2b0514639f44929cbbba9c4130798a8a54a|d5dec2b051]) 2017-08-17 22:50:16 +00:00
jan.nijtmans a04094e9a5 Adopt some harmless changes from the 'irontcl' branch. Left 2 changes behind which I'm not so sure about (but I could be convinced ...). Ticket with explanation would be appreciated! 2017-08-17 22:26:48 +00:00
jan.nijtmans 922d8a71a5 merge core-8-6-branch 2017-08-17 21:56:51 +00:00
jan.nijtmans 13d9910fd6 '#if' -> '#ifdef' in tclUnixPort.h. Suggested by Gustaf Neumann. Reduces the number of gcc warnings, when compiling Tcl with -Wundef. Harmless. 2017-08-17 21:52:42 +00:00
andy 657e43aaa9 Correct bug in getting second Unicode character sequence 2017-08-17 18:32:12 +00:00
andy 166fce6267 Clip (don't reject) out-of-bounds indexes, per sebres's suggestion and to match [linsert] 2017-08-17 18:15:32 +00:00
andy 9614235c9d Work around [3397978fff] 2017-08-17 18:14:24 +00:00
andy 499a6f4da8 Backout [b163c4f423]: Command ensembles indeed do affect argument reference counts, see [3397978fff] 2017-08-17 17:29:19 +00:00
andy 72490b5f39 Test code to investigate command ensemble argument reference counts 2017-08-16 15:14:36 +00:00
andy 651a35fc69 Fix typo 2017-08-16 15:14:09 +00:00
andy 576adc0559 Write some test cases 2017-08-15 08:25:52 +00:00
andy 602dbc490d Correct bug in shared pure byte array case 2017-08-15 08:23:40 +00:00
andy ad835ed885 Remove repeated code 2017-08-15 08:04:36 +00:00
andy af2cc1bccb Update existing tests to accommodate new [string insert] command 2017-08-15 08:04:19 +00:00
andy c6308250b1 Begin implementation of [string insert] 2017-08-15 07:50:27 +00:00
dgp 277f101d7f [f2336c116b] Move pragmas to make gcc happy; it is pickier than clang. 2017-08-14 15:33:03 +00:00
Joe Mistachkin a50a381b04 The 'clean' target should delete the generated 'nmhlp-out.txt' file as well. 2017-08-13 22:31:19 +00:00
Joe Mistachkin e513ec3916 Always define '_USING_V110_SDK71_', in case targeting the pre-Windows 8.x SDKs. 2017-08-13 22:15:30 +00:00
Joe Mistachkin 89fcfadbbf Support cross-compiling Tcl for 'Win32 on ARM' using Visual Studio. 2017-08-13 22:05:25 +00:00
andy 89ce4defb5 Correct longstanding typo in continue man page 2017-08-12 19:45:04 +00:00
dgp ad9bc7297d Add 8.7 -only changes to the changes file. 2017-08-10 19:14:15 +00:00
dgp 0079285837 Update outdated comment. 2017-08-10 17:34:31 +00:00
dgp 8ccd8d10ef Backport [array names -regexp] should support backrefs 2017-08-10 17:03:53 +00:00
dgp aedd652645 Bring changes up to the 8.6.7 release. 2017-08-10 14:56:23 +00:00
dgp 4056a4dc4b Release candidate branch for Tcl 8.7a1. 2017-08-10 14:29:11 +00:00
dgp ffaeeeddaa merge 8.6 2017-08-10 14:17:01 +00:00
dgp c2982f8f62 Silence compiler warning in --disable-threads build 2017-08-10 13:28:48 +00:00
dgp 587206a660 merge mark 2017-08-09 16:38:35 +00:00
dgp 545f5e64be merge mark 2017-08-09 16:29:45 +00:00
dgp 385b618c74 merge release 2017-08-09 16:28:33 +00:00
dgp 3a07a6d26f bump release date 2017-08-09 14:41:19 +00:00
andy df9ea61fbf Cherrypick [527d354828] 2017-08-08 16:45:47 +00:00
andy 5f7ca471e4 Merge core-8-6-branch 2017-08-08 16:42:24 +00:00
andy ac8ddf5d4a Cherrypick [527d354828] 2017-08-08 16:42:05 +00:00
andy 664774bec4 [5bfe3de008]: Modify [source] to set input EOF character but not output EOF character. This avoids having ^Z being appended to the sourced file when it is an always-writable [tcl::chan::variable] in a custom VFS. Tested by adding this same change as a patch to Tcl 8.6.6 in KitCreator because that seems to be the easiest way to get custom VFS capability exposed as script commands. Original problem introduced by [03cdfc3a86] 2000-05-11 00:16:52. 2017-08-07 01:16:39 +00:00
dgp 3cf11a1ce9 merge 8.6 2017-08-04 13:18:37 +00:00
dgp 6da97c627b merge 8.6 2017-08-03 14:40:48 +00:00
dgp 735ca3d3a8 Improved test http-4.16. 2017-08-03 14:39:59 +00:00
dkf 72396a1929 Fix weird hangs in macOS Sierra on some networks. Name resolution timeouts not what we want to test in the http package. 2017-08-02 23:38:20 +00:00
dgp 816674cdb7 update changes 2017-08-01 16:05:13 +00:00
dgp 6bcfd54d3a merge 8.6 2017-07-18 12:58:27 +00:00
jan.nijtmans bb331bf1d8 merge core-8-6-branch 2017-07-17 08:04:57 +00:00
jan.nijtmans b095f046e6 Fix [fb2208172c671f29d60e9ac928d9ded45d01d8b8|fb2208172c]: tclIndex varies across builds from auto_mkindex 2017-07-17 08:04:15 +00:00
jan.nijtmans cee94b0658 Fix [fb2208172c671f29d60e9ac928d9ded45d01d8b8|fb2208172c]: tclIndex varies across builds from auto_mkindex 2017-07-17 08:01:11 +00:00
jan.nijtmans f94f5914a8 merge core-8-6-branch 2017-07-14 14:48:17 +00:00
jan.nijtmans 9dd9b629b3 merge core-8-6-branch 2017-07-13 15:07:39 +00:00
jan.nijtmans 440dbbf620 Fix [293344d4f3]: Regression in SQLite test-suite. Long-standing bug in implementation of TclUtfToUniChar() macro. 2017-07-13 15:06:07 +00:00
jan.nijtmans b1243f2603 Fix [293344d4f3]: Regression in SQLite test-suite. Long-standing bug in implementation of TclUtfToUniChar() macro. 2017-07-13 15:03:27 +00:00
dgp f553fe3b01 merge 8.6 2017-07-06 16:47:21 +00:00
dgp 457f43e25b merge 8.6 2017-07-06 16:40:38 +00:00
dgp 578eeb06bc [adb198c256] Switch to an alternative fix for file join memleaks. 2017-07-06 16:34:56 +00:00
dgp 515f0f32c0 Pull out of the loop a block of code that can only run in first iteration. 2017-07-06 16:00:46 +00:00
dgp bcb9c34521 Alternative fix for memleaks in fs path join machinery. 2017-07-06 15:46:58 +00:00
jan.nijtmans af0816e0ca merge core-8-6-branch 2017-07-03 12:45:44 +00:00
jan.nijtmans ac0fdb5bf8 merge core-8-6-branch 2017-07-03 12:32:38 +00:00
sebres 2ee7180448 resolve 8.6-fork 2017-07-03 09:23:17 +00:00
sebres 5541cc57f7 tclPathObj: fixed TclJoinPath - usage of released object and object leakage.
closes [adb198c256df8c4192838cc3c1112fb2821314e9]
2017-07-03 09:19:41 +00:00
sebres 692ea37c40 tclPathObj: fixed TclJoinPath (backported from 8.6) - usage of released object and object leakage.
closes [adb198c256df8c4192838cc3c1112fb2821314e9]
2017-07-03 09:15:23 +00:00
jan.nijtmans 58dd15c51d merge core-8-6-branch 2017-07-03 08:30:43 +00:00
jan.nijtmans d0996f3402 'inline static' -> 'static inline' and 'INLINE' -> 'inline', for consistancy. 2017-07-03 08:27:42 +00:00
jan.nijtmans ca0b2a012e merge trunk 2017-06-29 13:18:33 +00:00
dgp 39356c4079 merge 8.6 2017-06-29 11:19:39 +00:00
jan.nijtmans a646f081bc merge core-8-6-branch 2017-06-28 13:44:23 +00:00
jan.nijtmans 89f6884455 Eliminate use of (expensive) Tcl_UtfToUpper() from "format": Just generate the expected uppercase characters right away from the start. No change in functionality, just code optimization. 2017-06-28 13:32:16 +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
dgp 45cf14ed03 Merge 8.6; Bump to TclOO 1.2.0. 2017-06-26 20:00:35 +00:00
dgp 5314bbe0ef update changes 2017-06-26 19:56:37 +00:00
dgp 5b2c81a0f3 merge 8.6 2017-06-26 19:51:48 +00:00
dgp f242dd36bd Bump to TclOO 1.1.0 2017-06-26 19:37:34 +00:00
dgp fb2aa596ab merge 8.6 2017-06-26 19:22:29 +00:00
dgp 5621809b18 [46f801ea5a] Make autoloader less fragile when it cannot manufacture a
known consistent stack trace. Value inconsistency over failure.
2017-06-26 19:18:42 +00:00
dgp 7a8a4b15c4 Try to make good stack trace. Fallback to making not-so-good stack trace.
Stop failing altogether. Test in test suite, not program fragility.
2017-06-26 19:17:12 +00:00
dgp f4615ea166 Test demonstrating autoloader fragility. 2017-06-26 17:30:15 +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 2bd7095b87 No longer split tests for longIs32bit/longIs64bit, since the results should be identical 2017-06-23 15:04:44 +00:00
dgp 400f9d27f5 typo fix 2017-06-23 13:11:37 +00:00
dgp 5d68b7ef56 Rewrite the documentation of [regsub -command] so it's not quite such a mess. 2017-06-23 13:09:23 +00:00
dgp ba387de8cd repair broken tests 2017-06-23 12:39:13 +00:00
dgp 70d12096d5 Repair compiler warning about uninitialized value. 2017-06-23 12:28:57 +00:00
jan.nijtmans 3dedad17ed TIP #472 implementation: Add Support for 0d Radix Prefix to Integer Literals 2017-06-23 08:11:42 +00:00
dkf a9c238476a Add [regsub -command] case that wasn't actively tested for. 2017-06-22 22:54:32 +00:00
dkf cfafc391f2 Implement TIP #473: Allow a Defined Target Namespace in oo::copy 2017-06-22 22:03:06 +00:00
dkf 0fbade1cf8 Implement TIP #473: Allow a Defined Target Namespace in oo::copy 2017-06-22 22:02:14 +00:00
dkf dd54301fb6 Documentation correction; issue pointed out by DGP. 2017-06-22 22:00:39 +00:00
dkf 6352a07912 Rebase for final implementation work 2017-06-22 21:55:45 +00:00
dkf 440f85800c Implement TIP #470: Reliable Access to OO Definition Context Object 2017-06-22 21:50:08 +00:00
jan.nijtmans 6454bee19b Merge core-8-6-branch 2017-06-22 08:16:41 +00:00
dgp 9983a05a80 merge 8.6 2017-06-19 17:31:17 +00:00
dgp 952acc3754 Merge 8.6; update changes. 2017-06-16 20:17:33 +00:00
jan.nijtmans 94754be1d7 merge core-8-6-branch 2017-06-16 14:31:47 +00:00
jan.nijtmans 56ea73145f Merge core-8-6-branch.
Fix gcc warning: tclStrToD.c:1180:2: warning: enumeration value ‘ZERO_D’ not handled in switch [-Wswitch]
  switch (acceptState) {
2017-06-15 11:01:58 +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 e8d9fe8ebe Rebase to core-8-6-branch (who told that fossil doesn't know how to rebase ....) 2017-06-14 07:54:51 +00:00
jan.nijtmans 6168d91b0e merge core-8-6-branch 2017-06-13 12:18:16 +00:00
griffin 2712a556fb Add support of 0d in the format %# conversion flag. Add tests for same. 2017-06-12 14:04:29 +00:00
jan.nijtmans 8c62a9c228 merge trunk 2017-06-12 13:29:40 +00:00
jan.nijtmans 16f3f234e8 Better UTF-8 surrogate handling, only functional when TCL_UTF_MAX>3 2017-06-08 08:26:58 +00:00
dgp f8bc248cc3 merge 8.6 2017-06-06 13:03:31 +00:00
dgp f165025992 Merge 8.6; update changes. 2017-06-05 17:22:31 +00:00
griffin 919fc57599 0d in LinkVar 2017-05-28 16:06:29 +00:00
griffin 5badb6535f Implement proposed 0d decimal radix prefix to compliment 0x,0b,0o. 2017-05-27 22:17:21 +00:00
dgp 8a90be9a10 merge 8.6 2017-05-23 13:25:07 +00:00
dgp 2f9e40fef1 merge 8.6 2017-05-19 12:53:52 +00:00
dgp 0d218fca03 Merge 8.6; update changes. 2017-05-09 12:12:26 +00:00
dgp f9d42ebf8c Merge 8.6; update changes. 2017-05-08 16:07:58 +00:00
dgp 0177abb172 merge 8.6 2017-05-04 20:40:15 +00:00
dgp 77822d9462 merge 8.6; update changes 2017-04-28 18:09:46 +00:00
dgp 78a7a5b561 merge 8.6 2017-04-27 12:06:47 +00:00
dgp 7fde7fcf7b merge 8.6 2017-04-21 12:19:07 +00:00
dgp cdccb19d1c merge 8.6 2017-04-19 15:22:22 +00:00
jan.nijtmans 3bde30215b merge-mark 2017-04-18 06:15:48 +00:00
dgp a3fdca376e merge 8.6 2017-04-17 12:10:42 +00:00
jan.nijtmans 46db6e4a00 merge trunk 2017-04-14 10:04:33 +00:00
dgp d2595ccfea Bump TclOO 1.0.6; finish changes. 2017-04-13 16:39:15 +00:00
dgp 5b059dfd6b Bump msgcat and tcl tests and continue updates to changes. 2017-04-12 20:23:56 +00:00
dgp 1a3c0d9be9 merge 8.6 2017-04-12 19:19:05 +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
dgp 1e22d92c69 More changes work 2017-04-11 19:11:27 +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
dgp f3a4ae987d merge 8.6 2017-04-03 16:53:26 +00:00
dgp 5e45fd7662 merge 8.6 2017-03-31 12:30:27 +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
dgp d7802b428a New(ish) test interp-14.11 was missing its -cleanup. 2017-03-22 19:45:41 +00:00
dgp b8d35358ad merge 8.6 2017-03-17 12:51:53 +00:00
dgp daac4e5d34 Different solution to silencing the non-useful valgrind alerts. 2017-03-13 17:03:50 +00:00
dgp 57ceb807ca merge 8.6 2017-03-10 17:22:26 +00:00
dgp 91d32c4556 Silence valgrind complaints from [representation]. 2017-03-10 16:41:32 +00:00
dgp e9e0f57d92 Dup test name 2017-03-10 15:28:46 +00:00
dgp f090fee89b Start RC branch for Tcl 8.6.7 2017-03-10 15:22:08 +00:00
370 changed files with 31815 additions and 25451 deletions
+5
View File
@@ -3,12 +3,17 @@ compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
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
+5
View File
@@ -3,12 +3,17 @@ compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
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
+6 -3
View File
@@ -18,6 +18,7 @@
*/tclsh*
*/tcltest*
*/versions.vc
*/version.vc
html
libtommath/bn.ilg
libtommath/bn.ind
@@ -40,7 +41,9 @@ unix/dltest.marker
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/Debug_VC*
win/Release_VC*
win/Debug*
win/Release*
win/pkgs/*
win/tcl.hpj
win/coffbase.txt
win/tcl.hpj
win/nmhlp-out.txt
+1 -1
View File
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
<name>tcl8.7</name>
<name>tcl8</name>
<comment></comment>
<projects>
</projects>
+1 -1
View File
@@ -1,5 +1,5 @@
README: Tcl
This is the Tcl 8.7a0 source distribution.
This is the Tcl 8.7a2 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
+255
View File
@@ -8624,3 +8624,258 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans)
--- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tcl/ for details
2016-03-01 (bug)[803042] mem leak due to reference cycle (porter)
2016-03-08 (bug)[bbc304] reflected watch race condition (porter)
2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter)
2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter)
2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows)
2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans)
2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans)
2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans)
2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows)
*** POTENTIAL INCOMPATIBILITY ***
2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans)
2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin)
2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti)
2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny)
2016-05-13 (bug) registry package support any Unicode env (nijtmans)
=> registry 1.3.2
2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)
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)
2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric)
2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter)
2016-06-21 (update) Update Unicode data to 9.0 (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter)
2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows)
2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect)
2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter)
*** POTENTIAL INCOMPATIBILITY ***
2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)
2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
*** POTENTIAL INCOMPATIBILITY ***
2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)
2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
*** POTENTIAL INCOMPATIBILITY ***
2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)
2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
*** POTENTIAL INCOMPATIBILITY ***
2016-07-10 (bug)[da340d] integer division in clock math (nadkarni)
2016-07-20 tzdata updated to Olson's tzdata2016f (venkat)
--- Released 8.6.6, July 27, 2016 --- http://core.tcl.tk/tcl/ for details
2016-09-07 (bug)[c09edf] Bad caching with custom resolver (neumann,nijtmans)
2016-09-07 (bug)[4dbdd9] Memleak in test var-8.3 (mr_calvin,porter)
2016-10-03 (bug)[2bf561] Allow empty command as alias target (yorick,nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2016-10-04 (bug)[4d5ae7] Crash in async connects host no address (gahr,fellows)
2016-10-08 (bug)[838e99] treat application/xml as text (gahr,fellows)
=> http 2.8.10
2016-10-11 (bug)[3cc1d9] Thread finalization crash in zippy (neumann)
2016-10-12 (bug)[be003d] Fix [scan 0x1 %b], [scan 0x1 %o] (porter)
2016-10-14 (bug)[eb6b68] Fix stringComp-14.5 (porter)
2016-10-30 (bug)[b26e38] Fix zlib-7.8 (fellows)
2016-10-30 (bug)[1ae129] Fix memleak in [history] destruction (fellows)
2016-11-04 (feature) Provisional Tcl 9 support in msgcat and tcltest (nijtmans)
=> msgcat 1.6.1
=> tcltest 2.4.1
2016-11-04 (bug)[824752] Crash in Tcl_ListObjReplace() (gahr,porter)
2016-11-11 (bug)[79614f] invalidate VFS mounts on sytem encoding change (yorick)
2016-11-14 OSX: End panic() as legacy support macro; system conflicts (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2016-11-15 (bug) TclOO fix stops crash mixing Itcl and snit (fellows)
2016-11-17 (update) Reconcile libtommath updates; purge unused files (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2017-01-09 (bug)[b87ad7] Repair drifts in timer clock (sebres)
2017-01-17 (update) => zlib 1.2.11 (nijtmans)
2017-01-31 (bug)[39f630] Revise Tcl_LinkVar to tolerate some prefixes (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2017-02-01 (bug)[d0f7ba] Improper NAN optimization. expr-22.1[01] (aspect)
2017-02-26 (bug)[25842c] zlib stream finalization (aspect)
2017-03-07 (deprecate) Remove unmaintained makefile.bc file (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2017-03-14 (enhancement) [clock] and [encoding] are now ensembles (kenny)
2017-03-15 (enhancement) several [clock] subcommands bytecoded (kenny)
2017-03-23 tzdata updated to Olson's tzdata2017b (jima)
2017-03-29 (bug)[900cb0] Fix OO unexport introspection (napier)
2017-04-12 (bug)[42202b] Nesting imbalance in coro injection (nadkarni,sebres)
2017-04-18 (bug)[bc4322] http package support for safe interps (nash,nijtmans)
2017-04-28 (bug)[f34cf8] [file join a //b] => /b (neumann,porter)
2017-05-01 (bug)[8bd13f] Windows threads and pipes (sebres,nijtmans)
2017-05-01 (bug)[f9fe90] [file join //a b] EIAS violation (aspect,porter)
2017-05-04 (bug) Make test filesystem-1.52 pass on Windows (nijtmans)
2017-05-05 (bug)[601522] [binary] field spec overflow -> segfault (porter)
2017-05-08 (bug)[6ca52a] http memleak handling keep-alive (aspect,nijtmans)
=> http 2.8.11
2017-05-29 (bug)[a3fb33] crash in [lsort] on long lists (sebres)
2017-06-05 (bug)[67aa9a] Tcl_UtfToUniChar() revised handling invalid UTF-8 (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2017-06-08 (bug)[2738427] Tcl_NumUtfChars() corner case utf-4.9 (nijtmans)
2017-06-22 (update) Update Unicode data to 10.0 (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2017-06-22 (TIP 473) Let [oo::copy] specify target namespace (fellows)
2017-06-26 (bug)[46f801] Repair autoloader fragility (porter)
2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter)
2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans)
--- 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 ***
2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter)
2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans)
2016-07-19 (bug)[0363f0] Partial array search ID reform (porter)
2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter)
*** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") ***
2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max)
2016-11-25 [array named -regexp] supports backrefs (goth)
2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy)
2017-01-04 (TIP 459) New subcommand [package files] (nijtmans)
2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans)
2017-01-30 Add to Win shell builtins: assoc ftype move (ashok)
2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans)
2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans)
2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz)
2017-05-31 Purge build support for SunOS-4.* (stu)
2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows)
2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows)
=> TclOO 1.2.0
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)
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
-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.
*/
-4
View File
@@ -260,10 +260,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
+4 -4
View File
@@ -176,10 +176,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
+5 -2
View File
@@ -57,6 +57,9 @@ after the optional white space and sign are
.QW \fB0x\fR
then \fIsrc\fR is expected to be in hexadecimal form; otherwise,
if the first such characters are
.QW \fB0d\fR
then \fIsrc\fR is expected to be in decimal form; otherwise,
if the first such characters are
.QW \fB0o\fR
then \fIsrc\fR is expected to be in octal form; otherwise,
if the first such characters are
@@ -65,8 +68,8 @@ then \fIsrc\fR is expected to be in binary form; otherwise,
if the first such character is
.QW \fB0\fR
then \fIsrc\fR
is expected to be in octal form; otherwise, \fIsrc\fR is
expected to be in decimal form.
is expected to be in octal form; otherwise, \fIsrc\fR
is expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is: white space; a sign; a sequence of digits; a
+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
@@ -101,7 +101,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.
+2 -2
View File
@@ -54,9 +54,9 @@ is called, Tcl will take care of memory management.
.PP
The second triplet stores the snapshot of only the interpreter
result (not its complete state) in memory allocated by the caller.
These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
These routines are passed a pointer to \fBTcl_SavedResult\fR
that is used to store enough information to restore the interpreter result.
This structure can be allocated on the stack of the calling
\fBTcl_SavedResult\fR can be allocated on the stack of the calling
procedure. These routines do not save the state of any error
information in the interpreter (e.g. the \fB\-errorcode\fR or
\fB\-errorinfo\fR return options, when an error is in progress).
+43 -1
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj, Tcl_ReplaceObj \- manipulate Tcl values as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -84,8 +84,13 @@ int
.sp
Tcl_Obj *
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.sp
Tcl_Obj *
\fBTcl_ReplaceObj\fR(\fIinterp, objPtr, startIndex, removeCount, insertObjPtr\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP Tcl_Interp *interp in
If non-NULL, interpreter in which error result messages are stored.
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
@@ -143,6 +148,12 @@ The array of values to format or concatenate.
.AP int newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.AP int startIndex in
The index of the first character to insert, replace, or remove.
.AP int removeCount in
The number of characters to replace or remove.
.AP Tcl_Obj *insertObjPtr in/out
The value to insert or replace. If NULL, interpreted as empty string.
.BE
.SH DESCRIPTION
.PP
@@ -380,6 +391,37 @@ white space, then that value is ignored entirely. This white-space
removal was added to make the output of the \fBconcat\fR command
cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
newly-created value whose ref count is zero.
.PP
\fBTcl_ReplaceObj\fR inserts, replaces, or removes a substring in \fIobjPtr\fR
and returns a pointer to the new or updated string object.
If \fIobjPtr\fR or \fIinsertObjPtr\fR are unshared, one of them will be modified
in place, and its address will be returned.
If this optimization is unavailable, a new string object will be allocated to
store the result, its address will be returned, and neither \fIobjPtr\fR nor
\fIinsertObjPtr\fR will be modified.
Should a memory allocation error occur, \fBTcl_ReplaceObj\fR returns NULL and
(if \fIinterp\fR is non-NULL) places error information in the result value of
\fIinterp\fR.
.PP
The choice of operation performed by \fBTcl_ReplaceObj\fR is determined by
\fIremoveCount\fR and the length of \fIinsertObjPtr\fR.
To insert, \fIremoveCount\fR is zero, and \fIinsertObjPtr\fR is the insertion
substring.
To replace, \fIremoveCount\fR is the number of characters to replace, and
\fIinsertObjPtr\fR is the replacement substring.
To remove, \fIremoveCount\fR is the number of characters to remove, and
\fIinsertObjPtr\fR is NULL or empty string.
.PP
\fIstartIndex\fR is the index of the first character in \fIobjPtr\fR to insert,
replace, or remove.
Negative \fIstartIndex\fR is taken to be zero, and large \fIstartIndex\fR is
automatically limited to be no greater than the length of \fIobjPtr\fR.
In a similar manner, negative \fIremoveCount\fR is taken to be zero, and large
\fIremoveCount\fR is automatically limited such that the sum of \fIstartIndex\fR
and \fIremoveCount\fR is no greater than the length of \fIobjPtr\fR.
Consequently, if \fIstartIndex\fR is at the end of \fIobjPtr\fR,
\fIinsertObjPtr\fR will be appended to \fIobjPtr\fR, and \fIremoveCount\fR will
be ignored.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3)
.SH KEYWORDS
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -23,7 +23,7 @@ exception to occur.
The exception causes the current script to be aborted
out to the innermost containing loop command, which then
continues with the next iteration of the loop.
Catch exceptions are also handled in a few other situations, such
Continue exceptions are also handled in a few other situations, such
as the \fBcatch\fR command and the outermost scripts of procedure
bodies.
.SH EXAMPLE
+16 -6
View File
@@ -14,7 +14,7 @@ oo::copy \- create copies of objects and classes
.nf
package require TclOO
\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR?
\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? ?\fItargetNamespace\fR?
.fi
.BE
.SH DESCRIPTION
@@ -22,11 +22,21 @@ package require TclOO
The \fBoo::copy\fR command creates a copy of an object or class. It takes the
name of the object or class to be copied, \fIsourceObject\fR, and optionally
the name of the object or class to create, \fItargetObject\fR, which will be
resolved relative to the current namespace if not an absolute qualified name.
If \fItargetObject\fR is omitted, a new name is chosen. The copied object will
be of the same class as the source object, and will have all its per-object
methods copied. If it is a class, it will also have all the class methods in
the class copied, but it will not have any of its instances copied.
resolved relative to the current namespace if not an absolute qualified name
and
.VS TIP473
\fItargetNamespace\fR which is the name of the namespace that will hold the
internal state of the object (\fBmy\fR command, etc.); it \fImust not\fR
refer to an existing namespace.
If either \fItargetObject\fR or \fItargetNamespace\fR is omitted or is given
as the empty string, a new name is chosen. Names, unless specified, are
chosen with the same algorithm used by the \fBnew\fR method of
\fBoo::class\fR.
.VE TIP473
The copied object will be of the same class as the source object, and will have
all its per-object methods copied. If it is a class, it will also have all the
class methods in the class copied, but it will not have any of its instances
copied.
.PP
.VS
After the \fItargetObject\fR has been created and all definitions of its
+2 -1
View File
@@ -46,7 +46,8 @@ value is the form produced by the \fB%g\fR format specifier of Tcl's
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
An integer operand may be specified in decimal, binary
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form. For
+23 -8
View File
@@ -83,12 +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 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.
@@ -130,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
@@ -138,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
@@ -169,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.
@@ -198,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
@@ -208,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
+12 -10
View File
@@ -70,18 +70,20 @@ from the corresponding match.
.TP
\fB\-command\fR
.VS 8.7
Changes the handling of the substitution string so that it no longer treats
Changes the handling of \fIsubSpec\fR so that it is not treated
as a template for a substitution string and the substrings
.QW &
and
.QW \e
as special characters, but instead uses them as a non-empty list of words.
Each time a substitution is processed, another complete Tcl word is appended
to that list for each substitution value (the first such argument represents
the overall matched substring, the subsequent arguments will be one per
capturing sub-RE, much as are returned from \fBregexp\fR \fB\-inline\fR) and
the overall list is then evaluated as a Tcl command call. If the command
finishes successfully, the result of command call is substituted into the
resulting string.
.QW \e\fIn\fR
no longer have special meaning. Instead \fIsubSpec\fR must be a
command prefix, that is, a non-empty list. The substring of \fIstring\fR
that matches \fIexp\fR, and then each substring that matches each
capturing sub-RE within \fIexp\fR are appended as additional elements
to that list. (The items appended to the list are much like what
\fBregexp\fR \fB-inline\fR would return). The completed list is then
evaluated as a Tcl command, and the result of that command is the
substitution string. Any error or exception from command evaluation
becomes an error or exception from the \fBregsub\fR command.
.RS
.PP
If \fB\-all\fR is not also given, the command callback will be invoked at most
+17
View File
@@ -89,6 +89,23 @@ If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE
.TP
\fBstring insert \fIstring index insertString\fR
.
Returns a copy of \fIstring\fR with \fIinsertString\fR inserted at the
\fIindex\fR'th character. \fIindex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIindex\fR is start-relative, the first character inserted in the returned
string will be at the specified index. If \fIindex\fR is end-relative, the last
character inserted in the returned string will be at the specified index.
.PP
If \fIindex\fR is at or before the start of \fIstring\fR (e.g., \fIindex\fR is
\fB0\fR), \fIinsertString\fR is prepended to \fIstring\fR. If \fIindex\fR is at
or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR),
\fIinsertString\fR is appended to \fIstring\fR.
.RE
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
.
Returns 1 if \fIstring\fR is a valid member of the specified character
-1
View File
@@ -70,7 +70,6 @@
*/
#define NOTREACHED 0
#define xxx 1
#define DUPMAX _POSIX2_RE_DUP_MAX
#define DUPINF (DUPMAX+1)
+60 -59
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)
}
@@ -154,7 +154,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)
@@ -285,7 +285,7 @@ declare 75 {
declare 76 {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
declare 77 {
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
char Tcl_Backslash(const char *src, int *readPtr)
}
declare 78 {
@@ -306,7 +306,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 +318,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,7 +352,7 @@ declare 93 {
declare 94 {
Tcl_Interp *Tcl_CreateInterp(void)
}
declare 95 {
declare 95 {deprecated {}} {
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
int numArgs, Tcl_ValueType *argTypes,
Tcl_MathProc *proc, ClientData clientData)
@@ -461,15 +461,14 @@ 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)
}
@@ -529,12 +528,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,7 +558,7 @@ 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,
@@ -573,14 +572,14 @@ declare 159 {
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,14 +622,14 @@ 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 {
@@ -663,7 +662,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 +685,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 +703,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 +729,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 +765,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,8 +779,7 @@ declare 218 {
declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 {
declare 220 {deprecated {}} {
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 {
@@ -837,29 +835,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,8 +866,7 @@ declare 244 {
declare 245 {
int Tcl_StringMatch(const char *str, const char *pattern)
}
# Obsolete
declare 246 {
declare 246 {deprecated {}} {
int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 {
@@ -945,25 +942,25 @@ declare 265 {
declare 266 {
void Tcl_ValidateAllMemory(const char *file, int line)
}
declare 267 {
declare 267 {deprecated {see TIP #422}} {
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
declare 268 {
declare 268 {deprecated {see TIP #422}} {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
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)
}
@@ -973,19 +970,19 @@ 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)
}
declare 275 {
declare 275 {deprecated {see TIP #422}} {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
declare 276 {
declare 276 {deprecated {see TIP #422}} {
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {
declare 278 {deprecated {see TIP #422}} {
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
@@ -1087,7 +1084,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)
@@ -1163,7 +1160,7 @@ 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)
@@ -1172,16 +1169,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,
@@ -1214,10 +1211,10 @@ declare 339 {
declare 340 {
char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 {
CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
const char *Tcl_GetDefaultEncodingDir(void)
}
declare 342 {
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
void Tcl_SetDefaultEncodingDir(const char *path)
}
declare 343 {
@@ -1266,7 +1263,7 @@ declare 356 {
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
int flags)
}
declare 357 {
declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
@@ -1279,7 +1276,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,
@@ -1292,7 +1289,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,
@@ -1408,7 +1405,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(
@@ -1548,12 +1545,12 @@ declare 434 {
}
# TIP#15 (math function introspection) dkf
declare 435 {
declare 435 {deprecated {}} {
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 {
declare 436 {deprecated {}} {
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}
@@ -2335,7 +2332,11 @@ declare 631 {
# ----- BASELINE -- FOR -- 8.7.0 ----- #
# TIP #475
declare 632 {
Tcl_Obj *Tcl_ReplaceObj(Tcl_Interp *interp, Tcl_Obj *strObj, int startIndex,
int removeCount, Tcl_Obj *insObj)
}
##############################################################################
+72 -85
View File
@@ -55,10 +55,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 7
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL 0
#define TCL_RELEASE_SERIAL 2
#define TCL_VERSION "8.7"
#define TCL_PATCH_LEVEL "8.7a0"
#define TCL_PATCH_LEVEL "8.7a2"
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
@@ -137,7 +137,7 @@ extern "C" {
*/
#include <stdarg.h>
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# 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)
@@ -254,10 +254,9 @@ extern "C" {
* New code should use prototypes.
*/
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# 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
@@ -267,34 +266,16 @@ extern "C" {
#ifndef INLINE
# define INLINE
#endif
#ifdef NO_CONST
# ifndef const
# define const
# endif
#endif
#ifndef CONST
# define CONST const
#endif
#define CONST84 const
#define CONST84_RETURN const
#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
#endif /* !TCL_NO_DEPRECATED */
#ifndef CONST86
# define CONST86 CONST84
# define CONST86 const
#endif
/*
@@ -318,6 +299,7 @@ extern "C" {
* VOID. This block is skipped under Cygwin and Mingw.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
@@ -333,23 +315,16 @@ typedef long LONG;
*/
#ifndef __VXWORKS__
# ifndef NO_VOID
# define VOID void
# else
# define VOID char
# endif
# define VOID void
#endif
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
/*
* Miscellaneous declarations.
*/
#ifndef _CLIENTDATA
# ifndef NO_VOID
typedef void *ClientData;
# else
typedef int *ClientData;
# endif
typedef void *ClientData;
# define _CLIENTDATA
#endif
@@ -396,44 +371,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)))
@@ -493,7 +464,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
*/
typedef struct Tcl_Interp
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{
/* TIP #330: Strongly discourage extensions from using the string
* result. */
@@ -673,7 +644,9 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_BREAK 3
#define TCL_CONTINUE 4
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_RESULT_SIZE 200
#endif
/*
*----------------------------------------------------------------------------
@@ -689,6 +662,7 @@ typedef struct stat *Tcl_OldStat_;
* Argument descriptors for math function callbacks in expressions:
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
typedef enum {
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;
@@ -700,6 +674,10 @@ typedef struct Tcl_Value {
double doubleValue; /* Double-precision floating value. */
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
} Tcl_Value;
#else
#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
#endif
/*
* Forward declaration of Tcl_Obj to prevent an error when the forward
@@ -720,10 +698,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);
@@ -760,7 +738,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,
@@ -871,7 +849,7 @@ typedef struct Tcl_SavedResult {
char *appendResult;
int appendAvl;
int appendUsed;
char resultSpace[TCL_RESULT_SIZE+1];
char resultSpace[200+1];
} Tcl_SavedResult;
/*
@@ -997,7 +975,7 @@ typedef struct Tcl_DString {
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define Tcl_DStringTrunc Tcl_DStringSetLength
#endif /* !TCL_NO_DEPRECATED */
@@ -1125,7 +1103,7 @@ typedef struct Tcl_DString {
* give the flag)
*/
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define TCL_PARSE_PART1 0x400
#endif /* !TCL_NO_DEPRECATED */
@@ -1344,8 +1322,8 @@ typedef struct Tcl_HashSearch {
typedef struct {
void *next; /* Search position for underlying hash
* table. */
int epoch; /* Epoch marker for dictionary being searched,
* or -1 if search has terminated. */
unsigned int epoch; /* Epoch marker for dictionary being searched,
* or 0 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
} Tcl_DictSearch;
@@ -1478,14 +1456,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,
@@ -1978,7 +1956,7 @@ typedef struct Tcl_Token {
* TCL_TOKEN_OPERATOR - The token describes one expression operator.
* An operator might be the name of a math
* function such as "abs". A TCL_TOKEN_OPERATOR
* token is always preceeded by one
* token is always preceded by one
* TCL_TOKEN_SUB_EXPR token for the operator's
* subexpression, and is followed by zero or more
* TCL_TOKEN_SUB_EXPR tokens for the operator's
@@ -2263,6 +2241,8 @@ typedef struct mp_int mp_int;
#define MP_INT_DECLARED
typedef unsigned int mp_digit;
#define MP_DIGIT_DECLARED
typedef unsigned TCL_WIDE_INT_TYPE mp_word;
#define MP_WORD_DECLARED
/*
*----------------------------------------------------------------------------
@@ -2407,14 +2387,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
/*
@@ -2542,15 +2535,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__)
@@ -2613,10 +2600,10 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
* Deprecated Tcl functions:
*/
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* These function have been renamed. The old names are deprecated, but we
* define these macros for backwards compatibilty.
* define these macros for backwards compatibility.
*/
# define Tcl_Ckalloc Tcl_Alloc
+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);
}
+6 -5
View File
@@ -477,6 +477,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
{"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
{"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1},
{"strinsert", ASSEM_1BYTE, INST_STR_INSERT, 3, 1},
{"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
{"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
{"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
@@ -524,10 +525,10 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_NS_CURRENT, /* 151 */
INST_INFO_LEVEL_NUM, /* 152 */
INST_RESOLVE_COMMAND, /* 154 */
INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
INST_CONCAT_STK, /* 169 */
INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */
INST_NUM_TYPE /* 180 */
INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 170-172 */
INST_CONCAT_STK, /* 173 */
INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 174-176 */
INST_NUM_TYPE /* 183 */
};
/*
@@ -4266,7 +4267,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");
+256 -130
View File
@@ -118,6 +118,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 +132,10 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
#endif /* !defined(TCL_NO_DEPRECATED) */
static void ProcessUnexpectedResult(Tcl_Interp *interp,
int returnCode);
static int RewindCoroutine(CoroutineData *corPtr, int result);
@@ -203,7 +207,7 @@ 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
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
@@ -234,7 +238,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 +325,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 },
@@ -950,9 +956,11 @@ 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);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
#ifdef TCL_THREADS
@@ -2053,11 +2061,11 @@ Tcl_CreateCommand(
{
Interp *iPtr = (Interp *) interp;
ImportRef *oldRefPtr = NULL;
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Namespace *nsPtr;
Command *cmdPtr;
Tcl_HashEntry *hPtr;
const char *tail;
int isNew;
int isNew = 0, deleted = 0;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -2070,32 +2078,52 @@ Tcl_CreateCommand(
}
/*
* 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 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.
*/
if (strstr(cmdName, "::") != NULL) {
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
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.
*/
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) {
/*
* isNew - No conflict with existing command.
* deleted - We've already deleted a conflicting command
*/
break;
}
} else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
}
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* Command already exists. Delete the old one. Be careful to preserve
* Be careful to preserve
* any existing import links so we can restore them down below. That
* way, you can redefine a command and its import status will remain
* intact.
*/
cmdPtr = Tcl_GetHashValue(hPtr);
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
@@ -2108,18 +2136,21 @@ Tcl_CreateCommand(
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
}
if (!deleted) {
ckfree(Tcl_GetHashValue(hPtr));
}
} else {
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2167,7 +2198,7 @@ Tcl_CreateCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2222,37 +2253,34 @@ 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, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
Namespace *nsPtr;
const char *tail;
int isNew;
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.
* 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);
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
@@ -2261,12 +2289,49 @@ Tcl_CreateObjCommand(
tail = cmdName;
}
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
TclInvalidateNsPath(nsPtr);
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
proc, clientData, deleteProc);
}
/* Command already exists. */
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) {
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
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);
/*
* [***] This is wrong. See Tcl Bug a16752c252.
@@ -2297,25 +2362,32 @@ 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;
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
deleted = 1;
}
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
}
ckfree(Tcl_GetHashValue(hPtr));
}
} else {
if (!deleted) {
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2326,7 +2398,7 @@ Tcl_CreateObjCommand(
* commands.
*/
TclInvalidateCmdLiteral(interp, tail, nsPtr);
TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
/*
* The list of command exported from the namespace might have changed.
@@ -2335,6 +2407,7 @@ Tcl_CreateObjCommand(
*/
TclInvalidateNsCmdLookup(nsPtr);
TclInvalidateNsPath(nsPtr);
}
cmdPtr = ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2362,7 +2435,7 @@ Tcl_CreateObjCommand(
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
refCmdPtr = oldRefPtr->importedCmdPtr;
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2555,10 +2628,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
@@ -2567,10 +2636,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
@@ -3070,7 +3143,7 @@ Tcl_DeleteCommandFromToken(
/*
* We must delete this command, even though both traces and delete procs
* may try to avoid this (renaming the command etc). Also traces and
* delete procs may try to delete the command themsevles. This flag
* delete procs may try to delete the command themselves. This flag
* declares that a delete is in progress and that recursive deletes should
* be ignored.
*/
@@ -3082,6 +3155,8 @@ Tcl_DeleteCommandFromToken(
* traces.
*/
cmdPtr->nsPtr->refCount++;
if (cmdPtr->tracePtr != NULL) {
CommandTrace *tracePtr;
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
@@ -3109,6 +3184,7 @@ Tcl_DeleteCommandFromToken(
*/
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
/*
* If the command being deleted has a compile function, increment the
@@ -3446,6 +3522,7 @@ TclCleanupCommand(
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED)
void
Tcl_CreateMathFunc(
Tcl_Interp *interp, /* Interpreter in which function is to be
@@ -3496,7 +3573,7 @@ Tcl_CreateMathFunc(
static int
OldMathFuncProc(
ClientData clientData, /* Ponter to OldMathFuncData describing the
ClientData clientData, /* Pointer to OldMathFuncData describing the
* function being called */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Actual parameter count */
@@ -3609,7 +3686,7 @@ OldMathFuncProc(
*/
if (funcResult.type == TCL_INT) {
TclNewLongObj(valuePtr, funcResult.intValue);
TclNewIntObj(valuePtr, funcResult.intValue);
} else if (funcResult.type == TCL_WIDE_INT) {
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
} else {
@@ -3777,6 +3854,7 @@ Tcl_ListMathFuncs(
return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
/*
*----------------------------------------------------------------------
@@ -4402,6 +4480,8 @@ TclNRRunCallbacks(
(void) Tcl_GetObjResult(interp);
}
/* This is the trampoline. */
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
procPtr = callbackPtr->procPtr;
@@ -4535,7 +4615,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;
}
@@ -4716,7 +4796,7 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
int length, traceCode = TCL_OK;
const char *command = TclGetStringFromObj(commandPtr, &length);
@@ -4859,6 +4939,7 @@ Tcl_EvalTokensStandard(
NULL, NULL);
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
*----------------------------------------------------------------------
*
@@ -4906,6 +4987,7 @@ Tcl_EvalTokens(
Tcl_ResetResult(interp);
return resPtr;
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6424,7 +6506,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);
@@ -7400,12 +7481,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') {
@@ -7417,11 +7498,11 @@ ExprAbsFunc(
}
}
goto unChanged;
} else if (l == LONG_MIN) {
TclBNInitBignumFromLong(&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;
}
@@ -7445,22 +7526,6 @@ 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) {
TclBNInitBignumFromWideInt(&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) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
@@ -7657,6 +7722,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. */
@@ -7680,8 +7810,8 @@ ExprRandFunc(
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
* Take into consideration the thread this interp is running in order
* to insure 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.
*/
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
@@ -8145,6 +8275,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
@@ -8930,9 +9076,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) {
@@ -8940,34 +9086,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;
}
@@ -8979,16 +9112,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++;
@@ -9049,7 +9175,7 @@ TclNRCoroutineObjCmd(
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
/* insure that the command is looked up in the correct namespace */
/* ensure that the command is looked up in the correct namespace */
iPtr->lookupNsPtr = lookupNsPtr;
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
iPtr->numLevels--;
+5 -5
View File
@@ -536,7 +536,7 @@ SetByteArrayFromAny(
const char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
if (objPtr->typePtr == &properByteArrayType) {
return TCL_OK;
@@ -1017,7 +1017,7 @@ BinaryFormatCmd(
}
/*
* Prepare the result object by preallocating the caclulated number of
* Prepare the result object by preallocating the calculated number of
* bytes and filling with nulls.
*/
@@ -1300,7 +1300,7 @@ BinaryFormatCmd(
badField:
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
char buf[TCL_UTF_MAX + 1];
TclUtfToUniChar(errorString, &ch);
@@ -1670,7 +1670,7 @@ BinaryScanCmd(
badField:
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
char buf[TCL_UTF_MAX + 1];
TclUtfToUniChar(errorString, &ch);
@@ -2284,7 +2284,7 @@ ScanNumber(
Tcl_Obj *bigObj = NULL;
mp_int big;
TclBNInitBignumFromWideUInt(&big, uwvalue);
TclInitBignumFromWideUInt(&big, uwvalue);
bigObj = Tcl_NewBignumObj(&big);
return bigObj;
}
+14 -14
View File
@@ -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
@@ -164,7 +164,7 @@ Tcl_BreakObjCmd(
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/* ARGSUSED */
int
Tcl_CaseObjCmd(
+7 -7
View File
@@ -2160,7 +2160,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 +2191,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;
@@ -2945,7 +2945,7 @@ Tcl_LsearchObjCmd(
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",
@@ -4263,7 +4263,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,
@@ -4370,7 +4370,7 @@ static int
DictionaryCompare(
const char *left, const char *right) /* The strings to compare. */
{
Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
Tcl_UniChar uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower;
int diff, zeros;
int secondaryDiff = 0;
+127 -96
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;
@@ -487,11 +487,10 @@ Tcl_RegsubObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
int start, end, subStart, subEnd, match, command, numParts, numArgs;
int start, end, subStart, subEnd, match, command, numParts;
Tcl_RegExp regExpr;
Tcl_RegExpInfo info;
Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
Tcl_Obj **args = NULL, **parts;
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
static const char *const options[] = {
@@ -773,12 +772,13 @@ Tcl_RegsubObjCmd(
*/
if (command) {
if (args == NULL) {
Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
numArgs = numParts + info.nsubs + 1;
args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
}
Tcl_Obj **args = NULL, **parts;
int numArgs;
Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
numArgs = numParts + info.nsubs + 1;
args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
for (idx = 0 ; idx <= info.nsubs ; idx++) {
subStart = info.matches[idx].start;
@@ -800,13 +800,14 @@ Tcl_RegsubObjCmd(
* because Tcl_EvalObjv is "hairy monster" in terms of refcount
* handling, being able to optionally add references to any of its
* argument words. We'll drop the local refs immediately
* afterwarsds; subPtr is handled in the main exit stanza.
* afterwards; subPtr is handled in the main exit stanza.
*/
result = Tcl_EvalObjv(interp, numArgs, args, 0);
for (idx = 0 ; idx <= info.nsubs ; idx++) {
TclDecrRefCount(args[idx + numParts]);
}
ckfree(args);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
@@ -975,9 +976,6 @@ Tcl_RegsubObjCmd(
if (subPtr && (objv[2] == objv[0])) {
Tcl_DecrRefCount(subPtr);
}
if (args) {
ckfree(args);
}
if (resultPtr) {
Tcl_DecrRefCount(resultPtr);
}
@@ -1175,7 +1173,7 @@ Tcl_SplitObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
int len;
const char *splitChars;
const char *stringPtr;
@@ -1218,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);
@@ -1260,7 +1267,7 @@ Tcl_SplitObjCmd(
} else {
const char *element, *p, *splitEnd;
int splitLen;
Tcl_UniChar splitChar;
Tcl_UniChar splitChar = 0;
/*
* Normal case: split on any of a given set of characters. Discard
@@ -1328,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;
}
@@ -1381,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)));
@@ -1458,6 +1449,53 @@ StringIndexCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringInsertCmd --
*
* This procedure is invoked to process the "string insert" Tcl command.
* See the user documentation for details on what it does. Note that this
* command only functions correctly on properly formed Tcl UTF strings.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
StringInsertCmd(
ClientData dummy, /* Not used */
Tcl_Interp *interp, /* Current interpreter */
int objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument objects */
{
int length; /* String length */
int index; /* Insert index */
Tcl_Obj *outObj; /* Output object */
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
return TCL_ERROR;
}
length = Tcl_GetCharLength(objv[1]);
if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
return TCL_ERROR;
}
if (!(outObj = Tcl_ReplaceObj(interp, objv[1], index, 0, objv[3]))) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, outObj);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -1484,7 +1522,7 @@ StringIsCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *end, *stop;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
int (*chcomp)(int) = NULL; /* The UniChar comparison function. */
int i, failat = 0, result = 1, strict = 0, index, length1, length2;
Tcl_Obj *objPtr, *failVarObj = NULL;
@@ -1581,11 +1619,11 @@ 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)) {
result = 0;
} else if (index != STR_IS_BOOL) {
TclGetBooleanFromObj(NULL, objPtr, &i);
if ((index == STR_IS_TRUE) ^ i) {
result = 0;
}
}
break;
case STR_IS_CONTROL:
@@ -1598,9 +1636,6 @@ StringIsCmd(
/* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
#ifndef TCL_WIDE_INT_IS_LONG
(objPtr->typePtr == &tclWideIntType) ||
#endif
(objPtr->typePtr == &tclBignumType)) {
break;
}
@@ -1635,9 +1670,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;
}
@@ -1816,8 +1848,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;
}
@@ -2279,11 +2319,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;
}
/*
@@ -2311,44 +2352,43 @@ StringRplcCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *ustring;
int first, last, length;
int first, last, length; /* Replacement indexes and string length */
Tcl_Obj *strObj; /* String being modified */
Tcl_Obj *insObj; /* Substring to insert, may be NULL */
Tcl_Obj *outObj; /* Output object */
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
return TCL_ERROR;
}
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
length--;
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
strObj = objv[1];
length = Tcl_GetCharLength(strObj) - 1;
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK
|| TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
return TCL_ERROR;
}
if ((last < first) || (last < 0) || (first > length)) {
Tcl_SetObjResult(interp, objv[1]);
} else {
Tcl_Obj *resultPtr;
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
length--;
if (first < 0) {
first = 0;
}
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);
if (first < 0) {
first = 0;
}
if (last >= first) {
if (objc == 5) {
insObj = objv[4];
} else {
insObj = NULL;
}
if (!(outObj = Tcl_ReplaceObj(interp, strObj, first,
last - first + 1, insObj))) {
return TCL_ERROR;
}
} else {
outObj = strObj;
}
Tcl_SetObjResult(interp, outObj);
return TCL_OK;
}
@@ -2382,7 +2422,7 @@ StringRevCmd(
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
return TCL_OK;
}
@@ -2412,7 +2452,7 @@ StringStartCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
const char *p, *string;
int cur, index, length, numChars;
@@ -2473,7 +2513,7 @@ StringEndCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
const char *p, *end, *string;
int cur, index, length, numChars;
@@ -2831,7 +2871,6 @@ StringCatCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int code;
Tcl_Obj *objResultPtr;
if (objc < 2) {
@@ -2841,23 +2880,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;
}
/*
@@ -2878,7 +2909,6 @@ StringCatCmd(
*
*----------------------------------------------------------------------
*/
static int
StringBytesCmd(
ClientData dummy, /* Not used. */
@@ -3360,6 +3390,7 @@ TclInitStringCmd(
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"insert", StringInsertCmd,TclCompileStringInsertCmd, NULL, NULL, 0},
{"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
{"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
@@ -3532,7 +3563,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;
@@ -4295,7 +4326,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]);
}
+49
View File
@@ -500,6 +500,55 @@ TclCompileStringIndexCmd(
return TCL_OK;
}
int
TclCompileStringInsertCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *valueTokenPtr, *indexTokenPtr, *insertionTokenPtr;
DefineLineInformation; /* TIP #280 */
int idx;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
}
valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
indexTokenPtr = TokenAfter(valueTokenPtr);
insertionTokenPtr = TokenAfter(indexTokenPtr);
if (GetIndexFromToken(indexTokenPtr, &idx) != TCL_OK
|| (idx && idx != INDEX_END)) {
/*
* General case: handle non-constant and interior indices at runtime.
*/
CompileWord(envPtr, valueTokenPtr, interp, 1);
CompileWord(envPtr, indexTokenPtr, interp, 2);
CompileWord(envPtr, insertionTokenPtr, interp, 3);
OP(STR_INSERT);
} else {
/*
* Special case: prepending and appending.
*/
if (!idx) {
CompileWord(envPtr, insertionTokenPtr, interp, 3);
CompileWord(envPtr, valueTokenPtr, interp, 1);
} else {
CompileWord(envPtr, valueTokenPtr, interp, 1);
CompileWord(envPtr, insertionTokenPtr, interp, 3);
}
OP1(STR_CONCAT1, 2);
}
return TCL_OK;
}
int
TclCompileStringIsCmd(
Tcl_Interp *interp, /* Used for error reporting. */
+1 -1
View File
@@ -1885,7 +1885,7 @@ ParseLexeme(
{
const char *end;
int scanned;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
Tcl_Obj *literal = NULL;
unsigned char byte;
+4
View File
@@ -659,6 +659,10 @@ InstructionDesc const tclInstructionTable[] = {
* 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
* Stack: ... => ... time */
{"strinsert", 1, -2, 0, {OPERAND_NONE}},
/* [string insert] core: inserts a string into another.
* Stack: ... string index insertString => ... newString */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
+5 -3
View File
@@ -425,11 +425,11 @@ typedef struct ByteCode {
* compiled. If the code is executed if a
* different namespace, it must be
* recompiled. */
size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this
unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this
* 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
unsigned int 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. */
@@ -823,8 +823,10 @@ typedef struct ByteCode {
#define INST_CLOCK_READ 189
#define INST_STR_INSERT 190
/* The last opcode */
#define LAST_INST_OPCODE 189
#define LAST_INST_OPCODE 190
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
+154 -126
View File
@@ -23,6 +23,15 @@
# endif
#endif
#if !defined(BUILD_tcl)
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
#elif defined(TCL_NO_DEPRECATED)
# define TCL_DEPRECATED(msg) MODULE_SCOPE
#else
# define TCL_DEPRECATED(msg) EXTERN
#endif
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
@@ -44,7 +53,7 @@ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp,
const char *name, const char *version,
const void *clientData);
/* 1 */
EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 2 */
@@ -150,8 +159,7 @@ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, double *doublePtr);
/* 36 */
EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST84 char *const *tablePtr,
Tcl_Obj *objPtr, const char *const *tablePtr,
const char *msg, int flags, int *indexPtr);
/* 37 */
EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src,
@@ -254,7 +262,8 @@ EXTERN int Tcl_AsyncReady(void);
/* 76 */
EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
EXTERN char Tcl_Backslash(const char *src, int *readPtr);
TCL_DEPRECATED("Use Tcl_UtfBackslash")
char Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
const char *optionName,
@@ -271,7 +280,7 @@ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
EXTERN int Tcl_CommandComplete(const char *cmd);
/* 83 */
EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv);
EXTERN char * Tcl_Concat(int argc, const char *const *argv);
/* 84 */
EXTERN int Tcl_ConvertElement(const char *src, char *dst,
int flags);
@@ -282,7 +291,7 @@ EXTERN int Tcl_ConvertCountedElement(const char *src,
EXTERN 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);
/* 87 */
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
@@ -313,7 +322,8 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
/* 94 */
EXTERN Tcl_Interp * Tcl_CreateInterp(void);
/* 95 */
EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp,
TCL_DEPRECATED("")
void Tcl_CreateMathFunc(Tcl_Interp *interp,
const char *name, int numArgs,
Tcl_ValueType *argTypes, Tcl_MathProc *proc,
ClientData clientData);
@@ -403,9 +413,9 @@ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
EXTERN int Tcl_Eof(Tcl_Channel chan);
/* 127 */
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
EXTERN const char * Tcl_ErrnoId(void);
/* 128 */
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
EXTERN const char * Tcl_ErrnoMsg(int err);
/* 129 */
EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
@@ -460,13 +470,13 @@ EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
const char *slaveCmd,
Tcl_Interp **targetInterpPtr,
CONST84 char **targetCmdPtr, int *argcPtr,
CONST84 char ***argvPtr);
const char **targetCmdPtr, int *argcPtr,
const char ***argvPtr);
/* 149 */
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
const char *slaveCmd,
Tcl_Interp **targetInterpPtr,
CONST84 char **targetCmdPtr, int *objcPtr,
const char **targetCmdPtr, int *objcPtr,
Tcl_Obj ***objv);
/* 150 */
EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp,
@@ -485,7 +495,7 @@ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
EXTERN int Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
Tcl_Channel chan, const char *optionName,
@@ -496,12 +506,12 @@ EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command);
/* 161 */
EXTERN int Tcl_GetErrno(void);
/* 162 */
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
EXTERN const char * Tcl_GetHostName(void);
/* 163 */
EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp,
Tcl_Interp *slaveInterp);
@@ -537,14 +547,13 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp);
/* 175 */
EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
const char *varName, int flags);
/* 176 */
EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
const char *part1, const char *part2,
EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
int flags);
/* 176 */
EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
/* 177 */
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
const char *command);
@@ -569,7 +578,7 @@ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp);
/* 185 */
EXTERN int Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv,
EXTERN char * Tcl_JoinPath(int argc, const char *const *argv,
Tcl_DString *resultPtr);
/* 187 */
EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
@@ -582,7 +591,7 @@ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv);
EXTERN char * Tcl_Merge(int argc, const char *const *argv);
/* 193 */
EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
@@ -596,7 +605,7 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
int flags);
/* 197 */
EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
CONST84 char **argv, int flags);
const char **argv, int flags);
/* 198 */
EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp,
const char *fileName, const char *modeString,
@@ -618,7 +627,7 @@ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value,
/* 203 */
EXTERN int Tcl_PutEnv(const char *assignment);
/* 204 */
EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
EXTERN const char * Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr,
Tcl_QueuePosition position);
@@ -648,8 +657,7 @@ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
const char *pattern);
/* 215 */
EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
CONST84 char **startPtr,
CONST84 char **endPtr);
const char **startPtr, const char **endPtr);
/* 216 */
EXTERN void Tcl_Release(ClientData clientData);
/* 217 */
@@ -660,7 +668,8 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
int *flagPtr);
/* 220 */
EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
TCL_DEPRECATED("")
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* 221 */
EXTERN int Tcl_ServiceAll(void);
/* 222 */
@@ -704,26 +713,25 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp,
/* 236 */
EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* 237 */
EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
const char *varName, const char *newValue,
int flags);
/* 238 */
EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
const char *part1, const char *part2,
EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
const char *newValue, int flags);
/* 238 */
EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue,
int flags);
/* 239 */
EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
EXTERN const char * Tcl_SignalId(int sig);
/* 240 */
EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
EXTERN const char * Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int Tcl_SplitList(Tcl_Interp *interp,
const char *listStr, int *argcPtr,
CONST84 char ***argvPtr);
const char ***argvPtr);
/* 243 */
EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
CONST84 char ***argvPtr);
const char ***argvPtr);
/* 244 */
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
const char *pkgName,
@@ -732,7 +740,8 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
/* 245 */
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
EXTERN int Tcl_TellOld(Tcl_Channel chan);
TCL_DEPRECATED("")
int Tcl_TellOld(Tcl_Channel chan);
/* 247 */
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
int flags, Tcl_VarTraceProc *proc,
@@ -803,40 +812,43 @@ EXTERN int Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp,
TCL_DEPRECATED("see TIP #422")
void Tcl_AppendResultVA(Tcl_Interp *interp,
va_list argList);
/* 268 */
EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
TCL_DEPRECATED("see TIP #422")
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
va_list argList);
/* 269 */
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
const char *start, CONST84 char **termPtr);
EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr);
/* 271 */
EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
const char *name, const char *version,
int exact);
EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
const char *version, int exact);
/* 272 */
EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 273 */
EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
const char *version);
/* 274 */
EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
const char *name, const char *version,
int exact);
EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact);
/* 275 */
EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
TCL_DEPRECATED("see TIP #422")
void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
va_list argList);
/* 276 */
EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
TCL_DEPRECATED("see TIP #422")
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
TCL_DEPRECATED("see TIP #422")
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
@@ -901,7 +913,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void);
/* 301 */
EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
@@ -960,20 +972,20 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN int Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
EXTERN const char * Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
EXTERN int Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr,
char *dst);
/* 328 */
EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
EXTERN const char * Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
EXTERN const char * Tcl_UtfNext(const char *src);
/* 331 */
EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp,
Tcl_Encoding encoding, const char *src,
@@ -1001,9 +1013,11 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
const char * Tcl_GetDefaultEncodingDir(void);
/* 342 */
EXTERN void Tcl_SetDefaultEncodingDir(const char *path);
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
void Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
EXTERN void Tcl_AlertNotifier(ClientData clientData);
/* 344 */
@@ -1038,7 +1052,8 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
Tcl_Obj *patObj, int flags);
/* 357 */
EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count);
/* 358 */
EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
@@ -1050,7 +1065,7 @@ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp,
EXTERN int Tcl_ParseBraces(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append,
CONST84 char **termPtr);
const char **termPtr);
/* 361 */
EXTERN int Tcl_ParseCommand(Tcl_Interp *interp,
const char *start, int numBytes, int nested,
@@ -1062,7 +1077,7 @@ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append,
CONST84 char **termPtr);
const char **termPtr);
/* 364 */
EXTERN int Tcl_ParseVarName(Tcl_Interp *interp,
const char *start, int numBytes,
@@ -1152,8 +1167,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
EXTERN CONST84_RETURN char * Tcl_ChannelName(
const Tcl_ChannelType *chanTypePtr);
EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
const Tcl_ChannelType *chanTypePtr);
@@ -1259,13 +1273,15 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
/* 435 */
EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
TCL_DEPRECATED("")
int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
const char *name, int *numArgsPtr,
Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr,
ClientData *clientDataPtr);
/* 436 */
EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
TCL_DEPRECATED("")
Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
const char *pattern);
/* 437 */
EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -1822,6 +1838,10 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp,
unsigned int flags,
Tcl_TcpAcceptProc *acceptProc,
ClientData callbackData);
/* 632 */
EXTERN Tcl_Obj * Tcl_ReplaceObj(Tcl_Interp *interp, Tcl_Obj *strObj,
int startIndex, int removeCount,
Tcl_Obj *insObj);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -1834,7 +1854,7 @@ typedef struct TclStubs {
const TclStubHooks *hooks;
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
char * (*tcl_Alloc) (unsigned int size); /* 3 */
void (*tcl_Free) (char *ptr); /* 4 */
@@ -1885,7 +1905,7 @@ typedef struct TclStubs {
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
@@ -1926,16 +1946,16 @@ typedef struct TclStubs {
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
int (*tcl_AsyncReady) (void); /* 75 */
void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
@@ -1944,7 +1964,7 @@ typedef struct TclStubs {
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
@@ -1976,8 +1996,8 @@ typedef struct TclStubs {
void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
const char * (*tcl_ErrnoId) (void); /* 127 */
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
@@ -1997,21 +2017,21 @@ typedef struct TclStubs {
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
const char * (*tcl_GetHostName) (void); /* 162 */
int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
@@ -2031,9 +2051,9 @@ typedef struct TclStubs {
int (*tcl_GetServiceMode) (void); /* 171 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
@@ -2043,25 +2063,25 @@ typedef struct TclStubs {
int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */
char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
void (*reserved188)(void);
Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */
char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
void (*tcl_Preserve) (ClientData data); /* 201 */
void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
int (*tcl_PutEnv) (const char *assignment); /* 203 */
CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
void (*tcl_ReapDetachedProcs) (void); /* 207 */
@@ -2072,12 +2092,12 @@ typedef struct TclStubs {
Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
void (*tcl_Release) (ClientData clientData); /* 216 */
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
@@ -2094,16 +2114,16 @@ typedef struct TclStubs {
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
const char * (*tcl_SignalId) (int sig); /* 239 */
const char * (*tcl_SignalMsg) (int sig); /* 240 */
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
@@ -2124,18 +2144,18 @@ typedef struct TclStubs {
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
@@ -2159,7 +2179,7 @@ typedef struct TclStubs {
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
@@ -2182,13 +2202,13 @@ typedef struct TclStubs {
Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */
CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
const char * (*tcl_UtfNext) (const char *src); /* 330 */
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
int (*tcl_UtfToLower) (char *src); /* 334 */
@@ -2198,8 +2218,8 @@ typedef struct TclStubs {
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
void (*tcl_ServiceModeHook) (int mode); /* 344 */
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
@@ -2214,13 +2234,13 @@ typedef struct TclStubs {
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
int (*tcl_Chdir) (const char *dirName); /* 366 */
@@ -2255,7 +2275,7 @@ typedef struct TclStubs {
int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
@@ -2292,8 +2312,8 @@ typedef struct TclStubs {
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
@@ -2489,6 +2509,7 @@ typedef struct TclStubs {
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
Tcl_Obj * (*tcl_ReplaceObj) (Tcl_Interp *interp, Tcl_Obj *strObj, int startIndex, int removeCount, Tcl_Obj *insObj); /* 632 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3783,6 +3804,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_OpenTcpServerEx \
(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
#define Tcl_ReplaceObj \
(tclStubsPtr->tcl_ReplaceObj) /* 632 */
#endif /* defined(USE_TCL_STUBS) */
@@ -3918,20 +3941,14 @@ extern const TclStubs *tclStubsPtr;
* possible. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
*/
# undef Tcl_DbNewLongObj
# undef Tcl_GetLongFromObj
# undef Tcl_NewLongObj
# undef Tcl_SetLongObj
# undef Tcl_ExprLong
# undef Tcl_ExprLongObj
# undef Tcl_UniCharNcmp
# undef Tcl_UtfNcmp
# undef Tcl_UtfNcasecmp
# undef Tcl_UniCharNcasecmp
# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
# define Tcl_ExprLong TclExprLong
static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
int intValue;
@@ -3957,6 +3974,17 @@ extern const TclStubs *tclStubsPtr;
# endif
#endif
#undef Tcl_NewLongObj
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value))
/*
* Deprecated Tcl procedures:
*/
+20 -18
View File
@@ -141,7 +141,7 @@ typedef struct Dict {
* the dictionary. Used for doing traversal of
* the entries in the order that they are
* created. */
int epoch; /* Epoch counter */
unsigned int epoch; /* Epoch counter */
size_t refCount; /* Reference counter (see above) */
Tcl_Obj *chain; /* Linked list used for invalidating the
* string representations of updated nested
@@ -390,7 +390,7 @@ DupDictInternalRep(
* Initialise other fields.
*/
newDict->epoch = 0;
newDict->epoch = 1;
newDict->chain = NULL;
newDict->refCount = 1;
@@ -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) {
/*
@@ -710,7 +707,7 @@ SetDictFromAny(
*/
TclFreeIntRep(objPtr);
dict->epoch = 0;
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DICT(objPtr) = dict;
@@ -1109,7 +1106,7 @@ Tcl_DictObjFirst(
dict = DICT(dictPtr);
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = -1;
searchPtr->epoch = 0;
*donePtr = 1;
} else {
*donePtr = 0;
@@ -1170,7 +1167,7 @@ Tcl_DictObjNext(
* If the searh is done; we do no work.
*/
if (searchPtr->epoch == -1) {
if (!searchPtr->epoch) {
*donePtr = 1;
return;
}
@@ -1227,8 +1224,8 @@ Tcl_DictObjDone(
{
Dict *dict;
if (searchPtr->epoch != -1) {
searchPtr->epoch = -1;
if (searchPtr->epoch) {
searchPtr->epoch = 0;
dict = (Dict *) searchPtr->dictionaryPtr;
if (dict->refCount-- <= 1) {
DeleteDict(dict);
@@ -1380,7 +1377,7 @@ Tcl_NewDictObj(void)
TclInvalidateStringRep(dictPtr);
dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DICT(dictPtr) = dict;
@@ -1430,7 +1427,7 @@ Tcl_DbNewDictObj(
TclInvalidateStringRep(dictPtr);
dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DICT(dictPtr) = dict;
@@ -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;
}
}
}
@@ -2331,7 +2331,9 @@ DictAppendCmd(
valuePtr = Tcl_DuplicateObj(valuePtr);
}
Tcl_IncrRefCount(appendObjPtr);
Tcl_AppendObjToObj(valuePtr, appendObjPtr);
Tcl_DecrRefCount(appendObjPtr);
}
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
+9 -9
View File
@@ -254,7 +254,7 @@ DisassembleByteCodeObj(
Tcl_Obj *bufferObj, *fileObj;
TclNewObj(bufferObj);
if (codePtr->refCount <= 0) {
if (!codePtr->refCount) {
return bufferObj; /* Already freed. */
}
@@ -312,7 +312,7 @@ DisassembleByteCodeObj(
int numCompiledLocals = procPtr->numCompiledLocals;
Tcl_AppendPrintfToObj(bufferObj,
" Proc %p, refCt %d, args %d, compiled locals %d\n",
" Proc %p, refCt %u, args %d, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
@@ -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;
+77 -62
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. */
@@ -563,7 +563,7 @@ TclInitEncodingSubsystem(void)
* formed UTF-8 into a properly formed stream.
*/
type.encodingName = "identity";
type.encodingName = NULL;
type.toUtfProc = BinaryProc;
type.fromUtfProc = BinaryProc;
type.freeProc = NULL;
@@ -693,6 +693,7 @@ TclFinalizeEncodingSubsystem(void)
*-------------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
const char *
Tcl_GetDefaultEncodingDir(void)
{
@@ -736,6 +737,7 @@ Tcl_SetDefaultEncodingDir(
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
Tcl_SetEncodingSearchPath(searchPath);
}
#endif
/*
*-------------------------------------------------------------------------
@@ -851,7 +853,9 @@ FreeEncoding(
if (encodingPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(encodingPtr->hPtr);
}
ckfree(encodingPtr->name);
if (encodingPtr->name) {
ckfree(encodingPtr->name);
}
ckfree(encodingPtr);
}
}
@@ -1040,27 +1044,8 @@ Tcl_CreateEncoding(
const Tcl_EncodingType *typePtr)
/* The encoding type. */
{
Tcl_HashEntry *hPtr;
int isNew;
Encoding *encodingPtr;
char *name;
Tcl_MutexLock(&encodingMutex);
hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
if (isNew == 0) {
/*
* Remove old encoding from hash table, but don't delete it until last
* reference goes away.
*/
encodingPtr = Tcl_GetHashValue(hPtr);
encodingPtr->hPtr = NULL;
}
name = ckalloc(strlen(typePtr->encodingName) + 1);
encodingPtr = ckalloc(sizeof(Encoding));
encodingPtr->name = strcpy(name, typePtr->encodingName);
Encoding *encodingPtr = ckalloc(sizeof(Encoding));
encodingPtr->name = NULL;
encodingPtr->toUtfProc = typePtr->toUtfProc;
encodingPtr->fromUtfProc = typePtr->fromUtfProc;
encodingPtr->freeProc = typePtr->freeProc;
@@ -1072,11 +1057,32 @@ Tcl_CreateEncoding(
encodingPtr->lengthProc = (LengthProc *) unilen;
}
encodingPtr->refCount = 1;
encodingPtr->hPtr = NULL;
if (typePtr->encodingName) {
Tcl_HashEntry *hPtr;
int isNew;
char *name;
Tcl_MutexLock(&encodingMutex);
hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
if (isNew == 0) {
/*
* Remove old encoding from hash table, but don't delete it until last
* reference goes away.
*/
Encoding *replaceMe = Tcl_GetHashValue(hPtr);
replaceMe->hPtr = NULL;
}
name = ckalloc(strlen(typePtr->encodingName) + 1);
encodingPtr->name = strcpy(name, typePtr->encodingName);
encodingPtr->hPtr = hPtr;
Tcl_SetHashValue(hPtr, encodingPtr);
Tcl_MutexUnlock(&encodingMutex);
}
return (Tcl_Encoding) encodingPtr;
}
@@ -2293,8 +2299,11 @@ UtfToUtfProc(
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
int result, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
if (flags & TCL_ENCODING_START) {
*statePtr = 0;
}
result = TCL_OK;
srcStart = src;
@@ -2326,7 +2335,7 @@ UtfToUtfProc(
}
if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
/*
* Copy 7bit chatacters, but skip null-bytes when we are in input
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xc080.
*/
@@ -2342,16 +2351,16 @@ UtfToUtfProc(
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Always check before using TclUtfToUniChar. Not doing can so
* cause it run beyond the endof the buffer! If we happen such an
* incomplete char its byts are made to represent themselves.
* cause it run beyond the end of the buffer! If we happen such an
* incomplete char its bytes are made to represent themselves.
*/
ch = (unsigned char) *src;
*chPtr = (unsigned char) *src;
src += 1;
dst += Tcl_UniCharToUtf(ch, dst);
dst += Tcl_UniCharToUtf(*chPtr, dst);
} else {
src += TclUtfToUniChar(src, &ch);
dst += Tcl_UniCharToUtf(ch, dst);
src += TclUtfToUniChar(src, chPtr);
dst += Tcl_UniCharToUtf(*chPtr, dst);
}
}
@@ -2407,8 +2416,11 @@ UnicodeToUtfProc(
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
if (flags & TCL_ENCODING_START) {
*statePtr = 0;
}
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
@@ -2436,11 +2448,11 @@ UnicodeToUtfProc(
* Tcl_UniChar-size data.
*/
ch = *(Tcl_UniChar *)src;
if (ch && ch < 0x80) {
*dst++ = (ch & 0xFF);
*chPtr = *(Tcl_UniChar *)src;
if (*chPtr && *chPtr < 0x80) {
*dst++ = (*chPtr & 0xFF);
} else {
dst += Tcl_UniCharToUtf(ch, dst);
dst += Tcl_UniCharToUtf(*chPtr, dst);
}
src += sizeof(Tcl_UniChar);
}
@@ -2497,8 +2509,11 @@ UtfToUnicodeProc(
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
Tcl_UniChar ch;
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
if (flags & TCL_ENCODING_START) {
*statePtr = 0;
}
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2524,7 +2539,7 @@ UtfToUnicodeProc(
result = TCL_CONVERT_NOSPACE;
break;
}
src += TclUtfToUniChar(src, &ch);
src += TclUtfToUniChar(src, chPtr);
/*
* Need to handle this in a way that won't cause misalignment by
@@ -2533,23 +2548,23 @@ UtfToUnicodeProc(
#ifdef WORDS_BIGENDIAN
#if TCL_UTF_MAX > 4
*dst++ = (ch >> 24);
*dst++ = ((ch >> 16) & 0xFF);
*dst++ = ((ch >> 8) & 0xFF);
*dst++ = (ch & 0xFF);
*dst++ = (*chPtr >> 24);
*dst++ = ((*chPtr >> 16) & 0xFF);
*dst++ = ((*chPtr >> 8) & 0xFF);
*dst++ = (*chPtr & 0xFF);
#else
*dst++ = (ch >> 8);
*dst++ = (ch & 0xFF);
*dst++ = (*chPtr >> 8);
*dst++ = (*chPtr & 0xFF);
#endif
#else
#if TCL_UTF_MAX > 4
*dst++ = (ch & 0xFF);
*dst++ = ((ch >> 8) & 0xFF);
*dst++ = ((ch >> 16) & 0xFF);
*dst++ = (ch >> 24);
*dst++ = (*chPtr & 0xFF);
*dst++ = ((*chPtr >> 8) & 0xFF);
*dst++ = ((*chPtr >> 16) & 0xFF);
*dst++ = (*chPtr >> 24);
#else
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
*dst++ = (*chPtr & 0xFF);
*dst++ = (*chPtr >> 8);
#endif
#endif
}
@@ -2607,7 +2622,7 @@ TableToUtfProc(
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart, *prefixBytes;
int result, byte, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
const unsigned short *const *toUnicode;
const unsigned short *pageZero;
TableEncodingData *dataPtr = clientData;
@@ -2719,7 +2734,7 @@ TableFromUtfProc(
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd, *prefixBytes;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
int result, len, word, numChars;
TableEncodingData *dataPtr = clientData;
const unsigned short *const *fromUnicode;
@@ -2853,7 +2868,7 @@ Iso88591ToUtfProc(
result = TCL_OK;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
@@ -2939,7 +2954,7 @@ Iso88591FromUtfProc(
dstEnd = dst + dstLen - 1;
for (numChars = 0; src < srcEnd; numChars++) {
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
int len;
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
@@ -3326,7 +3341,7 @@ EscapeFromUtfProc(
for (numChars = 0; src < srcEnd; numChars++) {
unsigned len;
int word;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
@@ -3371,7 +3386,7 @@ EscapeFromUtfProc(
/*
* The state variable has the value of oldState when word is 0.
* In this case, the escape sequense should not be copied to dst
* In this case, the escape sequence should not be copied to dst
* because the current character set is not changed.
*/
@@ -3596,7 +3611,7 @@ unilen(
static void
InitializeEncodingSearchPath(
char **valuePtr,
size_t *lengthPtr,
unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *bytes;
+188 -150
View File
@@ -92,7 +92,7 @@ static const Tcl_ObjType ensembleCmdType = {
*/
typedef struct {
size_t epoch; /* Used to confirm when the data in this
unsigned int epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
Command *token; /* Reference to the command for which this
@@ -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
@@ -130,6 +130,7 @@ TclSetupEnv(
* '='; ignore the entry.
*/
Tcl_DStringFree(&envString);
continue;
}
p2++;
-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;
}
+230 -647
View File
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -1904,7 +1904,7 @@ TclGlob(
}
/*
* To process a [glob] invokation, this function may be called multiple
* To process a [glob] invocation, this function may be called multiple
* times. Each time, the previously discovered filenames are in the
* interpreter result. We stash that away here so the result is free for
* error messsages.
+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;
TclGetBooleanFromObj(NULL, &obj, boolPtr);
}
return code;
}
+8 -18
View File
@@ -45,19 +45,6 @@ static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static TCL_HASH_TYPE HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the one word hash key methods. Not actually declared because
* this is a critical path that is implemented in the core hash table access
* function.
*/
#if 0
static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr,
void *keyPtr);
static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
#endif
/*
* Prototypes for the string hash key methods.
*/
@@ -998,12 +985,18 @@ static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
int oldSize, count, index;
Tcl_HashEntry **oldBuckets;
int count, index, oldSize = tablePtr->numBuckets;
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
/* Avoid outgrowing capability of the memory allocators */
if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
tablePtr->rebuildSize = INT_MAX;
return;
}
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
@@ -1015,9 +1008,6 @@ RebuildTable(
typePtr = &tclArrayHashKeyType;
}
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
/*
* Allocate and initialize the new bucket array, and set up hashing
* constants for new array size.
+3 -1
View File
@@ -6708,7 +6708,7 @@ Tcl_Flush(
chanPtr = statePtr->topChanPtr;
if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
return TCL_ERROR;
}
result = FlushChannel(NULL, chanPtr, 0);
@@ -9032,6 +9032,7 @@ ZeroTransferTimerProc(
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED)
int
TclCopyChannelOld(
Tcl_Interp *interp, /* Current interpreter. */
@@ -9043,6 +9044,7 @@ TclCopyChannelOld(
return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
cmdPtr);
}
#endif
int
TclCopyChannel(
+3 -3
View File
@@ -137,7 +137,7 @@ Tcl_PutsObjCmd(
chanObjPtr = objv[2];
string = objv[3];
break;
#if TCL_MAJOR_VERSION < 9
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
/*
* The code below provides backwards compatibility with an old
@@ -439,7 +439,7 @@ Tcl_ReadObjCmd(
if (i < objc) {
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
#if TCL_MAJOR_VERSION < 9
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
@@ -454,7 +454,7 @@ Tcl_ReadObjCmd(
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
#if TCL_MAJOR_VERSION < 9
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
}
newline = 1;
#endif
+4
View File
@@ -41,6 +41,8 @@ static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
#ifdef TCL_THREADS
static void ReflectThread(ClientData clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
Tcl_WideInt offset, int mode, int *errorCodePtr);
@@ -748,6 +750,7 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
#ifdef TCL_THREADS
typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
@@ -791,6 +794,7 @@ ReflectEventDelete(
}
return 1;
}
#endif
int
TclChanPostEventObjCmd(
+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 */
+3 -13
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
}
/*
@@ -1764,7 +1754,7 @@ Tcl_FSEvalFileEx(
* this cross-platform to allow for scripted documents. [Bug: 2040]
*/
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");
/*
* If the encoding is specified, set it for the channel. Else don't touch
@@ -1899,7 +1889,7 @@ TclNREvalFile(
* this cross-platform to allow for scripted documents. [Bug: 2040]
*/
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");
/*
* If the encoding is specified, set it for the channel. Else don't touch
+2 -1
View File
@@ -876,7 +876,8 @@ Tcl_WrongNumArgs(
* NULL. */
{
Tcl_Obj *objPtr;
int i, len, elemLen, flags;
int i, len, elemLen;
char flags;
Interp *iPtr = (Interp *) interp;
const char *elementStr;
+42 -56
View File
@@ -50,7 +50,7 @@ declare 6 {
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
declare 8 {
declare 8 {deprecated {}} {
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}
@@ -73,7 +73,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 +88,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 +114,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 +123,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 +147,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 +160,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)
#}
@@ -185,9 +185,9 @@ declare 41 {
declare 42 {
CONST86 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 +220,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 +273,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)
@@ -313,9 +313,7 @@ declare 75 {
declare 76 {
unsigned long TclpGetSeconds(void)
}
# deprecated
declare 77 {
declare 77 {deprecated {}} {
void TclpGetTime(Tcl_Time *time)
}
# Removed in 8.6:
@@ -357,7 +355,7 @@ declare 81 {
# declare 87 {
# void TclPlatformInit(Tcl_Interp *interp)
# }
declare 88 {
declare 88 {deprecated {}} {
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags)
}
@@ -380,7 +378,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)
@@ -419,7 +417,7 @@ declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
declare 104 {
declare 104 {deprecated {}} {
int TclSockMinimumBuffersOld(int sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
@@ -455,26 +453,26 @@ declare 111 {
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 112 {
int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
declare 113 {
Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 114 {
void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
void TclDeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 115 {
int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst)
}
declare 116 {
Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
Tcl_Command TclFindCommand(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 *TclFindNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 118 {
@@ -490,28 +488,28 @@ declare 120 {
Tcl_Namespace *contextNsPtr, int flags)
}
declare 121 {
int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern)
}
declare 122 {
Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 123 {
void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
declare 124 {
Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
}
declare 125 {
Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
Tcl_Namespace *TclGetGlobalNamespace_(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,
int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite)
}
declare 128 {
@@ -532,7 +530,7 @@ declare 131 {
declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
declare 133 {
declare 133 {deprecated {}} {
struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 8.5
@@ -550,7 +548,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 +560,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,12 +623,10 @@ declare 156 {
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
declare 158 {
declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptFileName(const char *filename)
}
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
declare 159 {
declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
const char *TclGetStartupScriptFileName(void)
}
#declare 160 {
@@ -676,13 +672,10 @@ declare 166 {
int index, Tcl_Obj *valuePtr)
}
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
declare 167 {
declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
declare 168 {
declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
Tcl_Obj *TclGetStartupScriptPath(void)
}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
@@ -730,12 +723,11 @@ 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)
void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
declare 179 {
Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
}
# REMOVED
@@ -748,12 +740,10 @@ declare 179 {
# const char *file, int line)
#}
# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
declare 182 {
declare 182 {deprecated {}} {
struct tm *TclpLocaltime(const time_t *clock)
}
declare 183 {
declare 183 {deprecated {}} {
struct tm *TclpGmtime(const time_t *clock)
}
@@ -937,10 +927,7 @@ declare 234 {
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
# TIP 337 made this one public
declare 236 {
declare 236 {deprecated {use Tcl_BackgroundException}} {
void TclBackgroundException(Tcl_Interp *interp, int code)
}
@@ -1090,7 +1077,7 @@ declare 9 win {
declare 10 win {
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Removed in 8.3.1 (for Win32s only)
# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}
@@ -1140,7 +1127,6 @@ 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)
}
+134 -100
View File
@@ -160,13 +160,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 {
@@ -265,7 +265,7 @@ typedef struct Namespace {
* strings; values have type (Namespace *). If
* NULL, there are no children. */
#endif
size_t nsId; /* Unique id for the namespace. */
unsigned long nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
int flags; /* OR-ed combination of the namespace status
@@ -274,7 +274,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
unsigned int 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
@@ -299,12 +299,12 @@ typedef struct Namespace {
* registered using "namespace export". */
int maxExportPatterns; /* Mumber of export patterns for which space
* is currently allocated. */
size_t cmdRefEpoch; /* Incremented if a newly added command
unsigned int cmdRefEpoch; /* Incremented if a newly added command
* shadows a command for which this namespace
* has already cached a Command* pointer; this
* causes all its cached Command* pointers to
* be invalidated. */
size_t resolverEpoch; /* Incremented whenever (a) the name
unsigned int resolverEpoch; /* Incremented whenever (a) the name
* resolution rules change for this namespace
* or (b) a newly added command shadows a
* command that is compiled to bytecodes. This
@@ -331,7 +331,7 @@ typedef struct Namespace {
* LookupCompiledLocal to resolve variable
* references within the namespace at compile
* time. */
size_t exportLookupEpoch; /* Incremented whenever a command is added to
unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
* a namespace, removed from a namespace or
* the exports of a namespace are changed.
* Allows TIP#112-driven command lists to be
@@ -426,13 +426,13 @@ 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
* existed; the global namespace never has an
* ensemble command.) */
size_t epoch; /* The epoch at which this ensemble's table of
unsigned int epoch; /* The epoch at which this ensemble's table of
* exported commands is valid. */
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
* consistent points, this will have the same
@@ -545,7 +545,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. */
@@ -618,7 +618,7 @@ typedef struct Var {
typedef struct VarInHash {
Var var;
int refCount; /* Counts number of active uses of this
unsigned int 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
@@ -950,7 +950,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
unsigned int 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
@@ -1067,7 +1067,7 @@ typedef struct AssocData {
*/
typedef struct LocalCache {
int refCount;
unsigned int refCount;
int numVars;
Tcl_Obj *varName0;
} LocalCache;
@@ -1229,7 +1229,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
unsigned int refCount; /* Number of times the word is on the
* stack. */
} CFWord;
@@ -1492,11 +1492,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
@@ -1516,7 +1516,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;
/*
@@ -1634,12 +1634,12 @@ typedef struct Command {
* recreated). */
Namespace *nsPtr; /* Points to the namespace containing this
* command. */
int refCount; /* 1 if in command hashtable plus 1 for each
unsigned int 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
* freed when refCount becomes zero. */
size_t cmdEpoch; /* Incremented to invalidate any references
unsigned int cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
@@ -1826,7 +1826,7 @@ typedef struct Interp {
* unused space in interp was repurposed for
* pluggable bytecode optimizers. The core
* contains one optimizer, which can be
* selectively overriden by extensions. */
* selectively overridden by extensions. */
} extra;
/*
@@ -1862,7 +1862,7 @@ typedef struct Interp {
* See Tcl_AppendResult code for details.
*/
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
char *appendResult; /* Storage space for results generated by
* Tcl_AppendResult. Ckalloc-ed. NULL means
* not yet allocated. */
@@ -1936,11 +1936,13 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
#ifndef TCL_NO_DEPRECATED
char resultSpace[TCL_RESULT_SIZE+1];
#if TCL_MAJOR_VERSION < 9
# if !defined(TCL_NO_DEPRECATED)
char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
/* Static space holding small results. */
#else
char resultSpaceDontUse[TCL_RESULT_SIZE+1];
# else
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
# endif
#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
@@ -2251,7 +2253,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.
@@ -2384,7 +2386,7 @@ typedef enum TclEolTranslation {
*/
typedef struct List {
int refCount;
unsigned int refCount;
int maxElemCount; /* Total number of element array slots. */
int elemCount; /* Current number of list elements. */
int canonicalFlag; /* Set if the string representation was
@@ -2392,7 +2394,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 \
@@ -2445,32 +2447,46 @@ typedef struct List {
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
/*
* Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
* Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
* 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) \
? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: ((objPtr)->typePtr == &tclBooleanType) \
? (*(boolPtr) = ((objPtr)->internalRep.longValue!=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)))
#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
#if (LONG_MAX == INT_MAX)
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
(((objPtr)->typePtr == &tclIntType \
&& (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) \
? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= INT_MIN \
&& (objPtr)->internalRep.wideValue <= INT_MAX) \
? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#else
#define TclGetIntFromObj(interp, objPtr, intPtr) \
Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \
TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
#endif
/*
* Macro used to save a function call for common uses of
@@ -2480,21 +2496,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().
@@ -2506,13 +2512,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
@@ -2618,7 +2624,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -2630,9 +2636,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
*/
typedef struct ProcessGlobalValue {
size_t epoch; /* Epoch counter to detect changes in the
unsigned int epoch; /* Epoch counter to detect changes in the
* master value. */
size_t numBytes; /* Length of the master string. */
unsigned int numBytes; /* Length of the master string. */
char *value; /* The master string value. */
Tcl_Encoding encoding; /* system encoding when master string was
* initialized. */
@@ -2720,9 +2726,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;
@@ -2772,6 +2775,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;
@@ -2900,6 +2904,8 @@ 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,
@@ -2909,12 +2915,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);
@@ -2937,6 +2956,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);
@@ -2963,6 +2984,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);
@@ -3007,6 +3037,9 @@ MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void TclInitAlloc(void);
MODULE_SCOPE void TclInitBignumFromLong(mp_int *, long);
MODULE_SCOPE void TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void TclInitDbCkalloc(void);
MODULE_SCOPE void TclInitDoubleConversion(void);
MODULE_SCOPE void TclInitEmbeddedConfigurationInformation(
@@ -3086,7 +3119,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
int stackSize, int flags);
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
size_t *lengthPtr, Tcl_Encoding *encodingPtr);
unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
@@ -3120,7 +3153,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,
@@ -3134,7 +3166,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,
@@ -3151,20 +3183,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);
@@ -3180,6 +3202,7 @@ 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);
@@ -3229,7 +3252,7 @@ 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
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3716,6 +3739,9 @@ MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringInsertCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringIsCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3968,6 +3994,26 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
/*
* 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 * 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
* by the bytecode compiler and engine. Some of these could later be placed in
@@ -4407,8 +4453,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclUtfToUniChar(str, chPtr) \
((((unsigned char) *(str)) < 0xC0) ? \
((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
((((unsigned char) *(str)) < 0x80) ? \
((*(chPtr) = (unsigned char) *(str)), 1) \
: Tcl_UtfToUniChar(str, chPtr))
/*
@@ -4472,7 +4518,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to increment a namespace's export export epoch
* Macro used by the Tcl core to increment a namespace's export epoch
* counter. The ANSI C "prototype" for this macro is:
*
* MODULE_SCOPE void TclInvalidateNsCmdLookup(Namespace *nsPtr);
@@ -4532,30 +4578,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); \
@@ -4570,8 +4605,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);
@@ -4580,13 +4614,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)
@@ -4613,8 +4647,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)
+137 -157
View File
@@ -28,21 +28,21 @@
# 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
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
/* Those macro's are especially for Itcl 3.4 compatibility */
# define tclCreateNamespace tcl_CreateNamespace
# define tclDeleteNamespace tcl_DeleteNamespace
# define tclAppendExportList tcl_AppendExportList
# define tclExport tcl_Export
# define tclImport tcl_Import
# define tclForgetImport tcl_ForgetImport
# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
# define tclFindNamespace tcl_FindNamespace
# define tclFindCommand tcl_FindCommand
# define tclGetCommandFromObj tcl_GetCommandFromObj
# define tclGetCommandFullName tcl_GetCommandFullName
#endif /* !defined(TCL_NO_DEPRECATED) */
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
@@ -75,7 +75,8 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
EXTERN int TclCopyAndCollapse(int count, const char *src,
char *dst);
/* 8 */
EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
TCL_DEPRECATED("")
int TclCopyChannelOld(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
int toRead, Tcl_Obj *cmdPtr);
/* 9 */
@@ -113,7 +114,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 */
@@ -173,7 +174,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,
@@ -218,7 +219,8 @@ EXTERN unsigned long TclpGetClicks(void);
/* 76 */
EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
EXTERN void TclpGetTime(Tcl_Time *time);
TCL_DEPRECATED("")
void TclpGetTime(Tcl_Time *time);
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -231,7 +233,8 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size);
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
EXTERN char * TclPrecTraceProc(ClientData clientData,
TCL_DEPRECATED("")
char * TclPrecTraceProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
/* 89 */
@@ -267,7 +270,8 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp);
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
EXTERN int TclSockMinimumBuffersOld(int sock, int size);
TCL_DEPRECATED("")
int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -284,22 +288,22 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
EXTERN int Tcl_AppendExportList(Tcl_Interp *interp,
EXTERN int TclAppendExportList(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp,
const char *name, ClientData clientData,
Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst);
/* 116 */
EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 118 */
@@ -314,23 +318,23 @@ EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
EXTERN int Tcl_ForgetImport(Tcl_Interp *interp,
EXTERN int TclForgetImport(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 123 */
EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
EXTERN void TclGetCommandFullName(Tcl_Interp *interp,
Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp);
/* 125 */
EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp);
/* 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,
EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite);
/* 128 */
EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
@@ -350,19 +354,18 @@ EXTERN void Tcl_SetNamespaceResolvers(
/* 132 */
EXTERN int TclpHasSockets(Tcl_Interp *interp);
/* 133 */
EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
TCL_DEPRECATED("")
struct tm * TclpGetDate(const time_t *time, int useGMT);
/* 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,
@@ -401,9 +404,11 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
const char *varName);
/* 158 */
EXTERN void TclSetStartupScriptFileName(const char *filename);
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
void TclSetStartupScriptFileName(const char *filename);
/* 159 */
EXTERN const char * TclGetStartupScriptFileName(void);
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
const char * TclGetStartupScriptFileName(void);
/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform(Tcl_Interp *interp,
@@ -422,9 +427,11 @@ EXTERN int TclListObjSetElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj *valuePtr);
/* 167 */
EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
EXTERN Tcl_Obj * TclGetStartupScriptPath(void);
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
Tcl_Obj * TclGetStartupScriptPath(void);
/* 169 */
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
unsigned long n);
@@ -457,16 +464,18 @@ 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,
EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr,
const char *encodingName);
/* 179 */
EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
EXTERN struct tm * TclpLocaltime(const time_t *clock);
TCL_DEPRECATED("")
struct tm * TclpLocaltime(const time_t *clock);
/* 183 */
EXTERN struct tm * TclpGmtime(const time_t *clock);
TCL_DEPRECATED("")
struct tm * TclpGmtime(const time_t *clock);
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -570,7 +579,8 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
/* 236 */
EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
TCL_DEPRECATED("use Tcl_BackgroundException")
void TclBackgroundException(Tcl_Interp *interp, int code);
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -652,7 +662,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 */
TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
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 +678,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);
@@ -697,7 +707,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 +731,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 */
TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
@@ -732,7 +742,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 */
TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
void (*reserved90)(void);
void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
@@ -748,7 +758,7 @@ typedef struct TclIntStubs {
CONST86 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 */
TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
@@ -756,36 +766,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 */
int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
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 */
int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
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 */
int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
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 */
TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
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 +812,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 */
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
void (*reserved160)(void);
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
@@ -811,8 +821,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 */
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
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 +832,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 (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
void (*reserved180)(void);
void (*reserved181)(void);
struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
void (*reserved184)(void);
void (*reserved185)(void);
void (*reserved186)(void);
@@ -880,7 +890,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 */
TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
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 */
@@ -1088,38 +1098,38 @@ 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 */
#define TclAppendExportList \
(tclIntStubsPtr->tclAppendExportList) /* 112 */
#define TclCreateNamespace \
(tclIntStubsPtr->tclCreateNamespace) /* 113 */
#define TclDeleteNamespace \
(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
#define TclExport \
(tclIntStubsPtr->tclExport) /* 115 */
#define TclFindCommand \
(tclIntStubsPtr->tclFindCommand) /* 116 */
#define TclFindNamespace \
(tclIntStubsPtr->tclFindNamespace) /* 117 */
#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 */
#define TclForgetImport \
(tclIntStubsPtr->tclForgetImport) /* 121 */
#define TclGetCommandFromObj \
(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
#define TclGetCommandFullName \
(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
#define TclGetCurrentNamespace_ \
(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
#define TclGetGlobalNamespace_ \
(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
#define Tcl_GetVariableFullName \
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#define Tcl_Import \
(tclIntStubsPtr->tcl_Import) /* 127 */
#define TclImport \
(tclIntStubsPtr->tclImport) /* 127 */
#define Tcl_PopCallFrame \
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
@@ -1210,10 +1220,10 @@ 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 */
#define TclSetStartupScript \
(tclIntStubsPtr->tclSetStartupScript) /* 178 */
#define TclGetStartupScript \
(tclIntStubsPtr->tclGetStartupScript) /* 179 */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
@@ -1350,58 +1360,28 @@ 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 */
#if defined(USE_TCL_STUBS)
# undef TclGetStartupScriptFileName
# undef TclSetStartupScriptFileName
# undef TclGetStartupScriptPath
# undef TclSetStartupScriptPath
# undef TclBackgroundException
# undef TclSetStartupScript
# undef TclGetStartupScript
# undef TclCreateNamespace
# undef TclDeleteNamespace
# undef TclAppendExportList
# undef TclExport
# undef TclImport
# undef TclForgetImport
# undef TclGetCurrentNamespace_
# undef TclGetGlobalNamespace_
# undef TclFindNamespace
# undef TclFindCommand
# undef TclGetCommandFromObj
# undef TclGetCommandFullName
# undef TclCopyChannelOld
# undef TclSockMinimumBuffersOld
#endif
#undef TclCopyChannelOld
#undef TclSockMinimumBuffersOld
#endif /* _TCLINTDECLS */
+12 -4
View File
@@ -555,10 +555,18 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
# undef TclWinGetServByName
# undef TclWinGetSockOpt
# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
# define TclWinGetServByName getservbyname
# define TclWinGetSockOpt getsockopt
# define TclWinSetSockOpt setsockopt
# undef TclWinGetPlatformId
# undef TclWinResetInterfaces
# undef TclWinSetInterfaces
# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define TclWinNToHS ntohs
# define TclWinGetServByName getservbyname
# define TclWinGetSockOpt getsockopt
# define TclWinSetSockOpt setsockopt
# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
# define TclWinResetInterfaces() /* nop */
# define TclWinSetInterfaces(dummy) /* nop */
# endif /* TCL_NO_DEPRECATED */
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
-4
View File
@@ -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;
+3 -3
View File
@@ -654,7 +654,7 @@ static Tcl_ObjType invalidRealType = {
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
SetInvalidRealFromAny /* setFromAnyProc */
NULL /* setFromAnyProc */
};
static int
@@ -692,7 +692,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
* contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
* contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
* (upperand lowercase). See bug [39f6304c2e].
*/
int
@@ -701,7 +701,7 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
const char *str = TclGetString(objPtr);
if ((objPtr->length == 0) ||
((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
*intPtr = 0;
return TCL_OK;
} else if ((objPtr->length == 1) && strchr("+-", str[0])) {
+3 -3
View File
@@ -1957,8 +1957,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;
@@ -1995,7 +1995,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
@@ -130,7 +130,7 @@ Tcl_LoadObjCmd(
Tcl_PackageInitProc *initProc;
const char *p, *fullFileName, *packageName;
Tcl_LoadHandle loadHandle;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
unsigned len;
int index, flags = 0;
Tcl_Obj *const *savedobjv = objv;
+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
@@ -32,7 +32,7 @@
*/
typedef struct {
size_t numNsCreated; /* Count of the number of namespaces created
unsigned long numNsCreated; /* Count of the number of namespaces created
* within the thread. This value is used as a
* unique id for each namespace. Cannot be
* per-interp because the nsId is used to
@@ -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);
/*
+549 -603
View File
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -24,7 +24,7 @@
* win/tclooConfig.sh
*/
#define TCLOO_VERSION "1.0.4"
#define TCLOO_VERSION "1.2.0"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
#include "tcl.h"
+26 -17
View File
@@ -1183,8 +1183,9 @@ TclOOCopyObjectCmd(
{
Tcl_Object oPtr, o2Ptr;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName?");
if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"sourceName ?targetName? ?targetNamespace?");
return TCL_ERROR;
}
@@ -1204,24 +1205,32 @@ TclOOCopyObjectCmd(
if (objc == 2) {
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
} else {
const char *name;
Tcl_DString buffer;
const char *name, *namespaceName;
name = TclGetString(objv[2]);
Tcl_DStringInit(&buffer);
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);
if (name[0] == '\0') {
name = NULL;
}
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
Tcl_DStringFree(&buffer);
/*
* Choose a unique namespace name if the user didn't supply one.
*/
namespaceName = NULL;
if (objc == 4) {
namespaceName = TclGetString(objv[3]);
if (namespaceName[0] == '\0') {
namespaceName = NULL;
} else if (Tcl_FindNamespace(interp, namespaceName, NULL,
0) != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s refers to an existing namespace", namespaceName));
return TCL_ERROR;
}
}
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
}
if (o2Ptr == NULL) {
+72 -24
View File
@@ -53,7 +53,8 @@ static void AddClassFiltersToCallContext(Object *const oPtr,
Class *clsPtr, struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags);
static void AddClassMethodNames(Class *clsPtr, const int flags,
Tcl_HashTable *const namesPtr);
Tcl_HashTable *const namesPtr,
Tcl_HashTable *const examinedClassesPtr);
static inline void AddMethodToCallChain(Method *const mPtr,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
@@ -109,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);
}
}
@@ -232,7 +238,7 @@ FreeMethodNameRep(
* TclOOInvokeContext --
*
* Invokes a single step along a method call-chain context. Note that the
* invokation of a step along the chain can cause further steps along the
* invocation of a step along the chain can cause further steps along the
* chain to be invoked. Note that this function is written to be as light
* in stack usage as possible.
*
@@ -367,6 +373,10 @@ TclOOGetSortedMethodList(
{
Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
* mapping. */
Tcl_HashTable examinedClasses;
/* Used to track what classes have been looked
* at. Is set-like in nature and keyed by
* pointer to class. */
FOREACH_HASH_DECLS;
int i;
Class *mixinPtr;
@@ -376,6 +386,7 @@ TclOOGetSortedMethodList(
void *isWanted;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
/*
* Name the bits used in the names table values.
@@ -436,11 +447,14 @@ TclOOGetSortedMethodList(
* hierarchy.
*/
AddClassMethodNames(oPtr->selfCls, flags, &names);
AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
FOREACH(mixinPtr, oPtr->mixins) {
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names);
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
&examinedClasses);
}
Tcl_DeleteHashTable(&examinedClasses);
/*
* See how many (visible) method names there are. If none, we do not (and
* should not) try to sort the list of them.
@@ -495,18 +509,24 @@ TclOOGetSortedClassMethodList(
{
Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
* mapping. */
Tcl_HashTable examinedClasses;
/* Used to track what classes have been looked
* at. Is set-like in nature and keyed by
* pointer to class. */
FOREACH_HASH_DECLS;
int i;
Tcl_Obj *namePtr;
void *isWanted;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
/*
* Process method names from the class hierarchy and the mixin hierarchy.
*/
AddClassMethodNames(clsPtr, flags, &names);
AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
Tcl_DeleteHashTable(&examinedClasses);
/*
* See how many (visible) method names there are. If none, we do not (and
@@ -581,14 +601,28 @@ AddClassMethodNames(
Class *clsPtr, /* Class to get method names from. */
const int flags, /* Whether we are interested in just the
* public method names. */
Tcl_HashTable *const namesPtr)
Tcl_HashTable *const namesPtr,
/* Reference to the hash table to put the
* information in. The hash table maps the
* Tcl_Obj * method name to an integral value
* describing whether the method is wanted.
* This ensures that public/private override
* semantics are handled correctly.*/
* semantics are handled correctly. */
Tcl_HashTable *const examinedClassesPtr)
/* Hash table that tracks what classes have
* already been looked at. The keys are the
* pointers to the classes, and the values are
* immaterial. */
{
/*
* If we've already started looking at this class, stop working on it now
* to prevent repeated work.
*/
if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
return;
}
/*
* Scope all declarations so that the compiler can stand a good chance of
* making the recursive step highly efficient. We also hand-implement the
@@ -596,24 +630,31 @@ AddClassMethodNames(
* tail-recursion optimization usefully.
*/
if (clsPtr->mixins.num != 0) {
Class *mixinPtr;
int i;
/* TODO: Beware of infinite loops! */
FOREACH(mixinPtr, clsPtr->mixins) {
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr);
}
}
while (1) {
FOREACH_HASH_DECLS;
Tcl_Obj *namePtr;
Method *mPtr;
int isNew;
(void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
&isNew);
if (!isNew) {
break;
}
if (clsPtr->mixins.num != 0) {
Class *mixinPtr;
int i;
FOREACH(mixinPtr, clsPtr->mixins) {
if (mixinPtr != clsPtr) {
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
namesPtr, examinedClassesPtr);
}
}
}
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
int isNew;
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
if (isNew) {
int isWanted = (!(flags & PUBLIC_METHOD)
@@ -640,7 +681,8 @@ AddClassMethodNames(
int i;
FOREACH(superPtr, clsPtr->superclasses) {
AddClassMethodNames(superPtr, flags, namesPtr);
AddClassMethodNames(superPtr, flags, namesPtr,
examinedClassesPtr);
}
}
}
@@ -793,7 +835,7 @@ AddMethodToCallChain(
* Call chain semantics states that methods come as *late* in the
* call chain as possible. This is done by copying down the
* following methods. Note that this does not change the number of
* method invokations in the call chain; it just rearranges them.
* method invocations in the call chain; it just rearranges them.
*/
Class *declCls = callPtr->chain[i].filterDeclarer;
@@ -863,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:
@@ -898,7 +941,7 @@ IsStillValid(
* TclOOGetCallContext --
*
* Responsible for constructing the call context, an ordered list of all
* method implementations to be called as part of a method invokation.
* method implementations to be called as part of a method invocation.
* This method is central to the whole operation of the OO system.
*
* ----------------------------------------------------------------------
@@ -1134,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;
@@ -1480,7 +1528,7 @@ TclOORenderCallChain(
/*
* Do the actual construction of the descriptions. They consist of a list
* of triples that describe the details of how a method is understood. For
* each triple, the first word is the type of invokation ("method" is
* each triple, the first word is the type of invocation ("method" is
* normal, "unknown" is special because it adds the method name as an
* extra argument when handled by some method types, and "filter" is
* special because it's a filter method). The second word is the name of
+121 -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,7 @@ TclOOObjectSetMixins(
if (numMixins == 0) {
if (oPtr->mixins.num != 0) {
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr) {
TclOORemoveFromInstances(oPtr, mixinPtr);
}
TclOORemoveFromInstances(oPtr, mixinPtr);
}
ckfree(oPtr->mixins.list);
oPtr->mixins.num = 0;
@@ -352,6 +355,13 @@ TclOOObjectSetMixins(
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr != oPtr->selfCls) {
TclOOAddToInstances(oPtr, mixinPtr);
/*
* Corresponding TclOODecrRefCount() is in the caller of this
* function.
*/
TclOODecrRefCount(mixinPtr->thisPtr);
}
}
}
@@ -362,6 +372,7 @@ TclOOObjectSetMixins(
* ----------------------------------------------------------------------
*
* TclOOClassSetMixins --
*
* Install a list of mixin classes into a class.
*
* ----------------------------------------------------------------------
@@ -399,6 +410,13 @@ TclOOClassSetMixins(
memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
FOREACH(mixinPtr, classPtr->mixins) {
TclOOAddToMixinSubs(classPtr, mixinPtr);
/*
* Corresponding TclOODecrRefCount() is in the caller of this
* function.
*/
TclOODecrRefCount(mixinPtr->thisPtr);
}
}
BumpGlobalEpoch(interp, classPtr);
@@ -408,6 +426,7 @@ TclOOClassSetMixins(
* ----------------------------------------------------------------------
*
* RenameDeleteMethod --
*
* Core of the code to rename and delete methods.
*
* ----------------------------------------------------------------------
@@ -497,6 +516,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 +595,7 @@ TclOOUnknownDefinition(
* ----------------------------------------------------------------------
*
* FindCommand --
*
* Specialized version of Tcl_FindCommand that handles command prefixes
* and disallows namespace magic.
*
@@ -635,6 +656,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 +682,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 +699,7 @@ InitDefineContext(
* ----------------------------------------------------------------------
*
* TclOOGetDefineCmdContext --
*
* Extracts the magic token from the current stack frame, or returns NULL
* (and leaves an error message) otherwise.
*
@@ -711,6 +736,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 +779,7 @@ GetClassInOuterContext(
* ----------------------------------------------------------------------
*
* GenerateErrorInfo --
*
* Factored out code to generate part of the error trace messages.
*
* ----------------------------------------------------------------------
@@ -791,6 +818,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 +882,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 +943,7 @@ TclOODefineObjCmd(
} else {
result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
}
DelRef(oPtr);
TclOODecrRefCount(oPtr);
/*
* Restore the previous "current" namespace.
@@ -928,6 +957,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 +1011,7 @@ TclOOObjDefObjCmd(
} else {
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
}
DelRef(oPtr);
TclOODecrRefCount(oPtr);
/*
* Restore the previous "current" namespace.
@@ -995,6 +1025,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 +1079,7 @@ TclOODefineSelfObjCmd(
} else {
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
}
DelRef(oPtr);
TclOODecrRefCount(oPtr);
/*
* Restore the previous "current" namespace.
@@ -1062,6 +1093,7 @@ TclOODefineSelfObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineObjSelfObjCmd --
*
* Implementation of the "self" subcommand of the "oo::objdefine"
* command.
*
@@ -1095,6 +1127,7 @@ TclOODefineObjSelfObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineClassObjCmd --
*
* Implementation of the "class" subcommand of the "oo::objdefine"
* command.
*
@@ -1110,7 +1143,6 @@ TclOODefineClassObjCmd(
{
Object *oPtr;
Class *clsPtr;
Foundation *fPtr = TclOOGetFoundation(interp);
/*
* Parse the context to get the object to operate on.
@@ -1147,20 +1179,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 +1186,14 @@ TclOODefineClassObjCmd(
if (oPtr->selfCls != clsPtr) {
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
/*
* Reference count already incremented a few lines up.
*/
oPtr->selfCls = clsPtr;
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 +1207,7 @@ TclOODefineClassObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineConstructorObjCmd --
*
* Implementation of the "constructor" subcommand of the "oo::define"
* command.
*
@@ -1254,6 +1276,7 @@ TclOODefineConstructorObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineDeleteMethodObjCmd --
*
* Implementation of the "deletemethod" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
@@ -1310,6 +1333,7 @@ TclOODefineDeleteMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineDestructorObjCmd --
*
* Implementation of the "destructor" subcommand of the "oo::define"
* command.
*
@@ -1374,6 +1398,7 @@ TclOODefineDestructorObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineExportObjCmd --
*
* Implementation of the "export" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1468,6 +1493,7 @@ TclOODefineExportObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineForwardObjCmd --
*
* Implementation of the "forward" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1528,6 +1554,7 @@ TclOODefineForwardObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineMethodObjCmd --
*
* Implementation of the "method" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1585,6 +1612,7 @@ TclOODefineMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineMixinObjCmd --
*
* Implementation of the "mixin" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1628,6 +1656,13 @@ TclOODefineMixinObjCmd(
goto freeAndError;
}
mixins[i-1] = clsPtr;
/*
* Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins,
* TclOOClassSetMixinsk, or just below if this function fails.
*/
AddRef(mixins[i-1]->thisPtr);
}
if (isInstanceMixin) {
@@ -1640,6 +1675,9 @@ TclOODefineMixinObjCmd(
return TCL_OK;
freeAndError:
while (--i > 0) {
TclOODecrRefCount(mixins[i]->thisPtr);
}
TclStackFree(interp, mixins);
return TCL_ERROR;
}
@@ -1648,6 +1686,7 @@ TclOODefineMixinObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineRenameMethodObjCmd --
*
* Implementation of the "renamemethod" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
@@ -1704,6 +1743,7 @@ TclOODefineRenameMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineUnexportObjCmd --
*
* Implementation of the "unexport" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1798,6 +1838,7 @@ TclOODefineUnexportObjCmd(
* ----------------------------------------------------------------------
*
* Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
*
* How to install a constructor or destructor into a class; API to call
* from C.
*
@@ -1852,6 +1893,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 +1937,7 @@ TclOODefineSlots(
* ----------------------------------------------------------------------
*
* ClassFilterGet, ClassFilterSet --
*
* Implementation of the "filter" slot accessors of the "oo::define"
* command.
*
@@ -1974,6 +2017,7 @@ ClassFilterSet(
* ----------------------------------------------------------------------
*
* ClassMixinGet, ClassMixinSet --
*
* Implementation of the "mixin" slot accessors of the "oo::define"
* command.
*
@@ -2055,6 +2099,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])) {
@@ -2063,6 +2108,13 @@ ClassMixinSet(
Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
goto freeAndError;
}
/*
* Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or
* just below if this function fails.
*/
AddRef(mixins[i]->thisPtr);
}
TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
@@ -2070,6 +2122,9 @@ ClassMixinSet(
return TCL_OK;
freeAndError:
while (i-- > 0) {
TclOODecrRefCount(mixins[i]->thisPtr);
}
TclStackFree(interp, mixins);
return TCL_ERROR;
}
@@ -2078,6 +2133,7 @@ ClassMixinSet(
* ----------------------------------------------------------------------
*
* ClassSuperGet, ClassSuperSet --
*
* Implementation of the "superclass" slot accessors of the "oo::define"
* command.
*
@@ -2172,16 +2228,24 @@ 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;
/*
* Corresponding TclOODecrRefCount is near the end of this function.
*/
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 +2262,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);
}
}
@@ -2221,6 +2295,12 @@ ClassSuperSet(
oPtr->classPtr->superclasses.num = superc;
FOREACH(superPtr, oPtr->classPtr->superclasses) {
TclOOAddToSubclasses(oPtr->classPtr, superPtr);
/*
* To account for the AddRef() earlier in this function.
*/
TclOODecrRefCount(superPtr->thisPtr);
}
BumpGlobalEpoch(interp, oPtr->classPtr);
@@ -2231,6 +2311,7 @@ ClassSuperSet(
* ----------------------------------------------------------------------
*
* ClassVarsGet, ClassVarsSet --
*
* Implementation of the "variable" slot accessors of the "oo::define"
* command.
*
@@ -2373,6 +2454,7 @@ ClassVarsSet(
* ----------------------------------------------------------------------
*
* ObjectFilterGet, ObjectFilterSet --
*
* Implementation of the "filter" slot accessors of the "oo::objdefine"
* command.
*
@@ -2440,6 +2522,7 @@ ObjFilterSet(
* ----------------------------------------------------------------------
*
* ObjectMixinGet, ObjectMixinSet --
*
* Implementation of the "mixin" slot accessors of the "oo::objdefine"
* command.
*
@@ -2511,9 +2594,19 @@ ObjMixinSet(
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
while (i-- > 0) {
TclOODecrRefCount(mixins[i]->thisPtr);
}
TclStackFree(interp, mixins);
return TCL_ERROR;
}
/*
* Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or
* just above if this function fails.
*/
AddRef(mixins[i]->thisPtr);
}
TclOOObjectSetMixins(oPtr, mixinc, mixins);
@@ -2525,6 +2618,7 @@ ObjMixinSet(
* ----------------------------------------------------------------------
*
* ObjectVarsGet, ObjectVarsSet --
*
* Implementation of the "variable" slot accessors of the "oo::objdefine"
* command.
*
+30 -36
View File
@@ -149,8 +149,8 @@ typedef struct Object {
struct Foundation *fPtr; /* The basis for the object system. Putting
* this here allows the avoidance of quite a
* lot of hash lookups on the critical path
* for object invokation and creation. */
Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
* for object invocation and creation. */
Tcl_Namespace *namespacePtr;/* This object's namespace. */
Tcl_Command command; /* Reference to this object's public
* command. */
Tcl_Command myCommand; /* Reference to this object's internal
@@ -162,12 +162,12 @@ typedef struct Object {
/* Classes mixed into this object. */
LIST_STATIC(Tcl_Obj *) filters;
/* List of filter names. */
struct Class *classPtr; /* All classes have this non-NULL; it points
* to the class structure. Everything else has
* this NULL. */
struct Class *classPtr; /* This is non-NULL for all classes, and NULL
* for everything else. It points to the class
* structure. */
int refCount; /* Number of strong references to this object.
* Note that there may be many more weak
* references; this mechanism is there to
* references; this mechanism exists to
* avoid Tcl_Preserve. */
int flags;
int creationEpoch; /* Unique value to make comparisons of objects
@@ -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
@@ -323,7 +320,7 @@ typedef struct Foundation {
} Foundation;
/*
* A call context structure is built when a method is called. They contain the
* A call context structure is built when a method is called. It contains the
* chain of method implementations that are to be invoked by a particular
* call, and the process of calling walks the chain, with the [next] command
* proceeding to the next entry in the chain.
@@ -334,7 +331,7 @@ typedef struct Foundation {
struct MInvoke {
Method *mPtr; /* Reference to the method implementation
* record. */
int isFilter; /* Whether this is a filter invokation. */
int isFilter; /* Whether this is a filter invocation. */
Class *filterDeclarer; /* What class decided to add the filter; if
* NULL, it was added by the object. */
};
@@ -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 */
/*
+1
View File
@@ -1314,6 +1314,7 @@ CloneProcedureMethod(
*/
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
Tcl_GetString(bodyObj);
TclFreeIntRep(bodyObj);
/*
+76 -193
View File
@@ -210,9 +210,8 @@ 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);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void UpdateStringOfOldInt(Tcl_Obj *objPtr);
#endif
static void FreeBignum(Tcl_Obj *objPtr);
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
@@ -242,6 +241,7 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
static const Tcl_ObjType oldBooleanType = {
"boolean", /* name */
NULL, /* freeIntRepProc */
@@ -249,6 +249,7 @@ static const Tcl_ObjType oldBooleanType = {
NULL, /* updateStringProc */
TclSetBooleanFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBooleanType = {
"booleanString", /* name */
NULL, /* freeIntRepProc */
@@ -264,19 +265,23 @@ const Tcl_ObjType tclDoubleType = {
SetDoubleFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
"int", /* name */
#else
"wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
#endif
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
#ifndef TCL_WIDE_INT_IS_LONG
const Tcl_ObjType tclWideIntType = {
"wideInt", /* name */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static const Tcl_ObjType oldIntType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfWideInt, /* updateStringProc */
SetWideIntFromAny /* setFromAnyProc */
UpdateStringOfOldInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
@@ -344,17 +349,17 @@ typedef struct ResolvedCmdName {
* reference (not the namespace that contains
* the referenced command). NULL if the name
* is fully qualified.*/
size_t refNsId; /* refNsPtr's unique namespace id. Used to
unsigned long refNsId; /* refNsPtr's unique namespace id. Used to
* verify that refNsPtr is still valid (e.g.,
* it's possible that the cmd's containing
* namespace was deleted and a new one created
* at the same address). */
size_t refNsCmdEpoch; /* Value of the referencing namespace's
unsigned int refNsCmdEpoch; /* Value of the referencing namespace's
* cmdRefEpoch when the pointer was cached.
* Before using the cached pointer, we check
* if the namespace's epoch was incremented;
* if so, this cached pointer is invalid. */
size_t cmdEpoch; /* Value of the command's cmdEpoch when this
unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this
* pointer was cached. Before using the cached
* pointer, we check if the cmd's epoch was
* incremented; if so, the cmd was renamed,
@@ -395,8 +400,6 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
@@ -406,9 +409,12 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
Tcl_RegisterObjType(&oldIntType);
#endif
Tcl_RegisterObjType(&oldBooleanType);
#ifndef TCL_WIDE_INT_IS_LONG
Tcl_RegisterObjType(&tclWideIntType);
#endif
#ifdef TCL_COMPILE_STATS
@@ -1762,7 +1768,7 @@ Tcl_NewBooleanObj(
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, boolValue!=0);
TclNewIntObj(objPtr, boolValue!=0);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -1810,7 +1816,7 @@ Tcl_DbNewBooleanObj(
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.longValue = (boolValue != 0);
objPtr->internalRep.wideValue = (boolValue != 0);
objPtr->typePtr = &tclIntType;
return objPtr;
}
@@ -1857,7 +1863,7 @@ Tcl_SetBooleanObj(
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
TclSetLongObj(objPtr, boolValue!=0);
TclSetIntObj(objPtr, boolValue!=0);
}
#endif /* TCL_NO_DEPRECATED */
@@ -1888,11 +1894,11 @@ Tcl_GetBooleanFromObj(
{
do {
if (objPtr->typePtr == &tclIntType) {
*boolPtr = (objPtr->internalRep.longValue != 0);
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBooleanType) {
*boolPtr = (int) objPtr->internalRep.longValue;
*boolPtr = objPtr->internalRep.longValue != 0;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
@@ -1916,12 +1922,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 +1942,12 @@ 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/wideInt.
*
* Warning: If the returned type is "wideInt" (32-bit platforms) and your
* platform is bigendian, you cannot use internalRep.longValue to distinguish
* between false and true. On Windows and most other platforms this still will
* work fine, but basically it is non-portable.
*
*----------------------------------------------------------------------
*/
@@ -1960,8 +1965,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 +1975,6 @@ TclSetBooleanFromAny(
goto badBoolean;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
goto badBoolean;
}
#endif
if (objPtr->typePtr == &tclDoubleType) {
goto badBoolean;
}
@@ -2113,7 +2111,7 @@ ParseBoolean(
numericBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = newBool;
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType;
return TCL_OK;
}
@@ -2294,7 +2292,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 +2302,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;
}
@@ -2427,7 +2419,7 @@ Tcl_NewIntObj(
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, intValue);
TclNewIntObj(objPtr, intValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2460,7 +2452,7 @@ Tcl_SetIntObj(
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
TclSetLongObj(objPtr, intValue);
TclSetIntObj(objPtr, intValue);
}
/*
@@ -2538,9 +2530,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);
}
/*
@@ -2569,12 +2560,28 @@ UpdateStringOfInt(
char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.wideValue);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void
UpdateStringOfOldInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
#endif
/*
*----------------------------------------------------------------------
@@ -2606,8 +2613,8 @@ UpdateStringOfInt(
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewLongObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewLongObj(
@@ -2626,7 +2633,7 @@ Tcl_NewLongObj(
{
register Tcl_Obj *objPtr;
TclNewLongObj(objPtr, longValue);
TclNewIntObj(objPtr, longValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2663,6 +2670,7 @@ Tcl_NewLongObj(
*----------------------------------------------------------------------
*/
#undef Tcl_DbNewLongObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
@@ -2679,7 +2687,7 @@ Tcl_DbNewLongObj(
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.longValue = longValue;
objPtr->internalRep.wideValue = longValue;
objPtr->typePtr = &tclIntType;
return objPtr;
}
@@ -2717,6 +2725,7 @@ Tcl_DbNewLongObj(
*----------------------------------------------------------------------
*/
#undef Tcl_SetLongObj
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
@@ -2727,7 +2736,7 @@ Tcl_SetLongObj(
Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
}
TclSetLongObj(objPtr, longValue);
TclSetIntObj(objPtr, longValue);
}
/*
@@ -2758,12 +2767,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
@@ -2836,49 +2846,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 */
/*
*----------------------------------------------------------------------
@@ -2928,7 +2895,7 @@ Tcl_NewWideIntObj(
register Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetWideIntObj(objPtr, wideValue);
TclSetIntObj(objPtr, wideValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2980,7 +2947,7 @@ Tcl_DbNewWideIntObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetWideIntObj(objPtr, wideValue);
TclSetIntObj(objPtr, wideValue);
return objPtr;
}
@@ -3029,19 +2996,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;
TclBNInitBignumFromWideInt(&big, wideValue);
Tcl_SetBignumObj(objPtr, &big);
#endif
}
TclSetIntObj(objPtr, wideValue);
}
/*
@@ -3073,14 +3028,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) {
@@ -3133,33 +3082,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 */
/*
*----------------------------------------------------------------------
@@ -3402,16 +3324,10 @@ GetBignumFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
return TCL_OK;
}
#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
TclBNInitBignumFromWideInt(bignumValue,
TclInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
return TCL_OK;
}
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3521,36 +3437,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;
@@ -3562,15 +3453,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);
@@ -3652,17 +3542,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,
+1 -1
View File
@@ -111,7 +111,7 @@ Tcl_PanicVA(
__builtin_trap();
# elif defined(_WIN64)
__debugbreak();
# elif defined(_MSC_VER)
# elif defined(_MSC_VER) && defined (_M_IX86)
_asm {int 3}
# else
DebugBreak();
+1 -1
View File
@@ -829,7 +829,7 @@ TclParseBackslash(
* written there. */
{
register const char *p = src+1;
Tcl_UniChar unichar;
Tcl_UniChar unichar = 0;
int result;
int count;
char buf[TCL_UTF_MAX];
+33 -36
View File
@@ -13,6 +13,7 @@
#include "tclInt.h"
#include "tclFileSystem.h"
#include <assert.h>
/*
* Prototypes for functions defined later in this file.
@@ -849,18 +850,20 @@ TclJoinPath(
int elements,
Tcl_Obj * const objv[])
{
Tcl_Obj *res;
Tcl_Obj *res = NULL;
int i;
const Tcl_Filesystem *fsPtr = NULL;
res = NULL;
assert ( elements >= 0 );
for (i = 0; i < elements; i++) {
int driveNameLength, strEltLen, length;
Tcl_PathType type;
char *strElt, *ptr;
Tcl_Obj *driveName = NULL;
Tcl_Obj *elt = objv[i];
if (elements == 0) {
return Tcl_NewObj();
}
assert ( elements > 0 );
if (elements == 2) {
Tcl_Obj *elt = objv[0];
/*
* This is a special case where we can be much more efficient, where
@@ -869,18 +872,17 @@ TclJoinPath(
* object which can be normalized more efficiently. Currently we only
* use the special case when we have exactly two elements, but we
* could expand that in the future.
*
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
* to be an absolute path. Added a check for that elt is absolute.
*
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
* to be an absolute path. Added a check for that elt is absolute.
*/
if ((i == (elements-2)) && (i == 0)
&& (elt->typePtr == &tclFsPathType)
if ((elt->typePtr == &tclFsPathType)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[i+1];
Tcl_Obj *tailObj = objv[1];
Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL);
type = TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
int len;
@@ -893,9 +895,6 @@ TclJoinPath(
* the base itself is just fine!
*/
if (res != NULL) {
TclDecrRefCount(res);
}
return elt;
}
@@ -918,9 +917,6 @@ TclJoinPath(
if ((tclPlatform != TCL_PLATFORM_WINDOWS)
|| (strchr(Tcl_GetString(elt), '\\') == NULL)) {
if (res != NULL) {
TclDecrRefCount(res);
}
if (PATHFLAGS(elt)) {
return TclNewFSPathObj(elt, str, len);
@@ -940,23 +936,28 @@ TclJoinPath(
* more general code below handle things.
*/
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
if (res != NULL) {
TclDecrRefCount(res);
}
return tailObj;
} else {
const char *str = TclGetString(tailObj);
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
if (strchr(str, '\\') == NULL) {
if (res != NULL) {
TclDecrRefCount(res);
}
return tailObj;
}
}
}
}
}
assert ( res == NULL );
for (i = 0; i < elements; i++) {
int driveNameLength, strEltLen, length;
Tcl_PathType type;
char *strElt, *ptr;
Tcl_Obj *driveName = NULL;
Tcl_Obj *elt = objv[i];
strElt = TclGetStringFromObj(elt, &strEltLen);
driveNameLength = 0;
type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
@@ -1051,10 +1052,8 @@ TclJoinPath(
noQuickReturn:
if (res == NULL) {
res = Tcl_NewObj();
ptr = TclGetStringFromObj(res, &length);
} else {
ptr = TclGetStringFromObj(res, &length);
}
ptr = TclGetStringFromObj(res, &length);
/*
* Strip off any './' before a tilde, unless this is the beginning of
@@ -1087,6 +1086,7 @@ TclJoinPath(
if (sep != NULL) {
separator = TclGetString(sep)[0];
TclDecrRefCount(sep);
}
/* Safety check in case the VFS driver caused sharing */
if (Tcl_IsShared(res)) {
@@ -1122,9 +1122,7 @@ TclJoinPath(
Tcl_SetObjLength(res, length);
}
}
if (res == NULL) {
res = Tcl_NewObj();
}
assert ( res != NULL );
return res;
}
@@ -1811,7 +1809,6 @@ Tcl_FSGetNormalizedPath(
*/
(void) TclGetStringFromObj(dir, &cwdLen);
cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
/* Normalize the combined string. */
@@ -1833,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. */
+7 -1
View File
@@ -668,7 +668,13 @@ TclCreatePipeline(
if (*p == '>') {
p++;
atOK = 0;
flags = O_WRONLY | O_CREAT;
/*
* Note that the O_APPEND flag only has an effect on POSIX
* platforms. On Windows, we just have to carry on regardless.
*/
flags = O_WRONLY | O_CREAT | O_APPEND;
}
if (errorClose != 0) {
errorClose = 0;
+470 -324
View File
@@ -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.
@@ -331,8 +349,8 @@ Tcl_PkgRequireEx(
*
* Second, how does this work? If we reach this point, then the global
* variable tclEmptyStringRep has the value NULL. Compare that with
* the definition of tclEmptyStringRep near the top of the file
* generic/tclObj.c. It clearly should not have the value NULL; it
* the definition of tclEmptyStringRep near the top of this file.
* It clearly should not have the value NULL; it
* should point to the char tclEmptyString. If we see it having the
* value NULL, then somehow we are seeing a Tcl library that isn't
* completely initialized, and that's an indicator for the error
@@ -348,18 +366,11 @@ Tcl_PkgRequireEx(
* After all, two Tcl libraries can't be a good thing!)
*
* Trouble is that's going to be tricky. We're now using a Tcl library
* that's not fully initialized. In particular, it doesn't have a
* proper value for tclEmptyStringRep. The Tcl_Obj system heavily
* depends on the value of tclEmptyStringRep and all of Tcl depends
* (increasingly) on the Tcl_Obj system, we need to correct that flaw
* before making the calls to set the interpreter result to the error
* message. That's the only flaw corrected; other problems with
* initialization of the Tcl library are not remedied, so be very
* careful about adding any other calls here without checking how they
* behave when initialization is incomplete.
* that's not fully initialized. Functions in it may not work
* reliably, so be very careful about adding any other calls here
* without checking how they behave when initialization is incomplete.
*/
tclEmptyStringRep = &tclEmptyString;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Cannot load package \"%s\" in standalone executable:"
" This package is not compiled with stub support", name));
@@ -372,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)) {
@@ -383,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;
}
@@ -401,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);
@@ -722,20 +548,299 @@ 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;
Tcl_Preserve(versionToProvide);
pkgPtr->clientData = versionToProvide;
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;
PkgFiles *pkgFiles;
PkgName *pkgName;
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;
/* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
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;
}
/*
@@ -841,10 +946,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. */
@@ -861,7 +975,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;
@@ -870,6 +984,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 ...?");
@@ -928,6 +1043,7 @@ Tcl_PackageObjCmd(
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
availPtr->pkgIndex = NULL;
}
ckfree(availPtr);
}
@@ -981,6 +1097,7 @@ Tcl_PackageObjCmd(
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
availPtr->pkgIndex = NULL;
}
break;
}
@@ -992,7 +1109,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) {
@@ -1113,7 +1230,6 @@ Tcl_PackageObjCmd(
argv2 = TclGetString(objv[2]);
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
Tcl_Obj *ov;
int res;
if (objc != 5) {
goto requireSyntax;
@@ -1130,20 +1246,42 @@ Tcl_PackageObjCmd(
*/
ov = Tcl_NewStringObj(version, -1);
Tcl_IncrRefCount(ov);
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: {
@@ -1283,6 +1421,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;
}
/*
*----------------------------------------------------------------------
@@ -1364,6 +1509,7 @@ TclFreePackageInfo(
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
availPtr->pkgIndex = NULL;
}
ckfree(availPtr);
}
+57 -93
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
@@ -393,13 +369,13 @@ TclCreateProc(
Proc **procPtrPtr) /* Returns: pointer to proc data. */
{
Interp *iPtr = (Interp *) interp;
const char **argArray = NULL;
register Proc *procPtr;
int i, length, result, numArgs;
const char *args, *bytes, *p;
int i, result, numArgs, plen;
const char *bytes, *argname, *argnamei;
char argnamelast;
register CompiledLocal *localPtr = NULL;
Tcl_Obj *defPtr;
Tcl_Obj *defPtr, *errorObj, **argArray;
int precompiled = 0;
if (bodyPtr->typePtr == &tclProcBodyType) {
@@ -436,6 +412,7 @@ TclCreateProc(
*/
if (Tcl_IsShared(bodyPtr)) {
int length;
Tcl_Obj *sharedBodyPtr = bodyPtr;
bytes = TclGetStringFromObj(bodyPtr, &length);
@@ -473,12 +450,9 @@ TclCreateProc(
* argument specifier. If the body is precompiled, processing is limited
* to checking that the parsed argument is consistent with the one stored
* in the Proc.
*
* THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
*/
args = TclGetStringFromObj(argsPtr, &length);
result = Tcl_SplitList(interp, args, &numArgs, &argArray);
result = Tcl_ListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
if (result != TCL_OK) {
goto procError;
}
@@ -502,28 +476,28 @@ TclCreateProc(
for (i = 0; i < numArgs; i++) {
int fieldCount, nameLength;
size_t valueLength;
const char **fieldValues;
Tcl_Obj **fieldValues;
/*
* Now divide the specifier up into name and default.
*/
result = Tcl_SplitList(interp, argArray[i], &fieldCount,
result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount,
&fieldValues);
if (result != TCL_OK) {
goto procError;
}
if (fieldCount > 2) {
ckfree(fieldValues);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"too many fields in argument specifier \"%s\"",
argArray[i]));
errorObj = Tcl_NewStringObj(
"too many fields in argument specifier \"", -1);
Tcl_AppendObjToObj(errorObj, argArray[i]);
Tcl_AppendToObj(errorObj, "\"", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
ckfree(fieldValues);
if ((fieldCount == 0) || (fieldValues[0]->length == 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
@@ -531,9 +505,10 @@ TclCreateProc(
goto procError;
}
nameLength = strlen(fieldValues[0]);
nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
if (fieldCount == 2) {
valueLength = strlen(fieldValues[1]);
valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
fieldValues[1]->length);
} else {
valueLength = 0;
}
@@ -542,33 +517,29 @@ TclCreateProc(
* Check that the formal parameter name is a scalar.
*/
p = fieldValues[0];
while (*p != '\0') {
if (*p == '(') {
const char *q = p;
do {
q++;
} while (*q != '\0');
q--;
if (*q == ')') { /* We have an array element. */
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
argnamei = argname;
argnamelast = argname[plen-1];
while (plen--) {
if (argnamei[0] == '(') {
if (argnamelast == ')') { /* We have an array element. */
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"formal parameter \"%s\" is an array element",
fieldValues[0]));
ckfree(fieldValues);
Tcl_GetString(fieldValues[0])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else if ((*p == ':') && (*(p+1) == ':')) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"formal parameter \"%s\" is not a simple name",
fieldValues[0]));
ckfree(fieldValues);
} else if ((argnamei[0] == ':') && (argnamei[1] == ':')) {
errorObj = Tcl_NewStringObj("formal parameter \"", -1);
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
p++;
argnamei = Tcl_UtfNext(argnamei);
}
if (precompiled) {
@@ -584,7 +555,7 @@ TclCreateProc(
*/
if ((localPtr->nameLength != nameLength)
|| (strcmp(localPtr->name, fieldValues[0]))
|| (Tcl_UtfNcmp(localPtr->name, argname, nameLength))
|| (localPtr->frameIndex != i)
|| !(localPtr->flags & VAR_ARGUMENT)
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
@@ -592,7 +563,6 @@ TclCreateProc(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter %d is "
"inconsistent with precompiled body", procName, i));
ckfree(fieldValues);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
goto procError;
@@ -607,12 +577,13 @@ TclCreateProc(
size_t tmpLength = localPtr->defValuePtr->length;
if ((valueLength != tmpLength) ||
strncmp(fieldValues[1], tmpPtr, tmpLength)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter \"%s\" has "
"default value inconsistent with precompiled body",
procName, fieldValues[0]));
ckfree(fieldValues);
Tcl_UtfNcmp(Tcl_GetString(fieldValues[1]), tmpPtr, tmpLength)) {
errorObj = Tcl_ObjPrintf(
"procedure \"%s\": formal parameter \"" ,procName);
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
Tcl_AppendToObj(errorObj, "\" has "
"default value inconsistent with precompiled body", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
goto procError;
@@ -632,7 +603,7 @@ TclCreateProc(
* local variables for the argument.
*/
localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1);
localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -640,19 +611,18 @@ TclCreateProc(
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
localPtr->nameLength = nameLength;
localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
localPtr->frameIndex = i;
localPtr->flags = VAR_ARGUMENT;
localPtr->resolveInfo = NULL;
if (fieldCount == 2) {
localPtr->defValuePtr =
Tcl_NewStringObj(fieldValues[1], valueLength);
localPtr->defValuePtr = fieldValues[1];
Tcl_IncrRefCount(localPtr->defValuePtr);
} else {
localPtr->defValuePtr = NULL;
}
memcpy(localPtr->name, fieldValues[0], nameLength + 1);
memcpy(localPtr->name, argname, fieldValues[0]->length + 1);
if ((i == numArgs - 1)
&& (localPtr->nameLength == 4)
&& (localPtr->name[0] == 'a')
@@ -660,12 +630,9 @@ TclCreateProc(
localPtr->flags |= VAR_IS_ARGS;
}
}
ckfree(fieldValues);
}
*procPtrPtr = procPtr;
ckfree(argArray);
return TCL_OK;
procError:
@@ -686,9 +653,6 @@ TclCreateProc(
}
ckfree(procPtr);
}
if (argArray != NULL) {
ckfree(argArray);
}
return TCL_ERROR;
}
@@ -826,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);
@@ -834,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;
@@ -2416,7 +2380,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);
+1 -1
View File
@@ -37,7 +37,7 @@ typedef struct TclRegexp {
* of subexpressions. */
rm_detail_t details; /* Detailed information on match (currently
* used only for REG_EXPECT). */
unsigned int refCount; /* Count of number of references to this
size_t refCount; /* Count of number of references to this
* compiled regexp. */
} TclRegexp;
+28 -15
View File
@@ -10,6 +10,7 @@
*/
#include "tclInt.h"
#include "tommath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -72,7 +73,7 @@ BuildCharSet(
CharSet *cset,
const char *format) /* Points to first char of set. */
{
Tcl_UniChar ch, start;
Tcl_UniChar ch = 0, start;
int offset, nranges;
const char *end;
@@ -257,7 +258,7 @@ ValidateFormat(
{
int gotXpg, gotSequential, value, i, flags;
char *end;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
int objIndex, xpgSize, nspace = numVars;
int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
char buf[TCL_UTF_MAX+1];
@@ -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
@@ -582,7 +576,7 @@ Tcl_ScanObjCmd(
char op = 0;
int width, underflow = 0;
Tcl_WideInt wideValue;
Tcl_UniChar ch, sch;
Tcl_UniChar ch = 0, sch = 0;
Tcl_Obj **objs = NULL, *objPtr = NULL;
int flags;
char buf[513]; /* Temporary buffer to hold scanned number
@@ -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;
@@ -934,9 +936,20 @@ 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;
if ((Tcl_GetBignumFromObj(interp, objPtr, &big) != TCL_OK)
|| (mp_cmp_d(&big, 0) == MP_LT)) {
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 +961,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;
+68 -81
View File
@@ -482,7 +482,7 @@ TclParseNumber(
{
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
ZERO_O, ZERO_B, BINARY,
ZERO_O, ZERO_B, ZERO_D, BINARY,
HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
LEADING_RADIX_POINT, FRACTION,
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
@@ -664,6 +664,10 @@ TclParseNumber(
state = ZERO_O;
break;
}
if (c == 'd' || c == 'D') {
state = ZERO_D;
break;
}
#ifdef TCL_NO_DEPRECATED
goto decimal;
#endif
@@ -707,7 +711,7 @@ TclParseNumber(
|| (octalSignificandWide >
(~(Tcl_WideUInt)0 >> shift)))) {
octalSignificandOverflow = 1;
TclBNInitBignumFromWideUInt(&octalSignificandBig,
TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
}
}
@@ -824,7 +828,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (~(Tcl_WideUInt)0 >> shift))) {
significandOverflow = 1;
TclBNInitBignumFromWideUInt(&significandBig,
TclInitBignumFromWideUInt(&significandBig,
significandWide);
}
}
@@ -865,7 +869,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (~(Tcl_WideUInt)0 >> shift))) {
significandOverflow = 1;
TclBNInitBignumFromWideUInt(&significandBig,
TclInitBignumFromWideUInt(&significandBig,
significandWide);
}
}
@@ -880,6 +884,16 @@ TclParseNumber(
state = BINARY;
break;
case ZERO_D:
if (c == '0') {
numTrailZeros++;
} else if ( ! isdigit(UCHAR(c))) {
goto endgame;
}
state = DECIMAL;
flags |= TCL_PARSE_INTEGER_ONLY;
/* FALLTHROUGH */
case DECIMAL:
/*
* Scanned an optional + or - followed by a string of decimal
@@ -1176,6 +1190,7 @@ TclParseNumber(
case ZERO_X:
case ZERO_O:
case ZERO_B:
case ZERO_D:
case LEADING_RADIX_POINT:
case EXPONENT_START:
case EXPONENT_SIGNUM:
@@ -1199,7 +1214,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
TclBNInitBignumFromWideUInt(&significandBig, significandWide);
TclInitBignumFromWideUInt(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
@@ -1220,7 +1235,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
TclBNInitBignumFromWideUInt(&significandBig, significandWide);
TclInitBignumFromWideUInt(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
@@ -1241,7 +1256,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
octalSignificandWide > (MOST_BITS + signum) >> shift)) {
octalSignificandOverflow = 1;
TclBNInitBignumFromWideUInt(&octalSignificandBig,
TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
}
if (shift) {
@@ -1253,32 +1268,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
TclBNInitBignumFromWideUInt(&octalSignificandBig,
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;
}
}
}
@@ -1296,36 +1297,22 @@ TclParseNumber(
&significandWide, &significandBig, significandOverflow);
if (!significandOverflow && (significandWide > MOST_BITS+signum)){
significandOverflow = 1;
TclBNInitBignumFromWideUInt(&significandBig, significandWide);
TclInitBignumFromWideUInt(&significandBig, significandWide);
}
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
TclBNInitBignumFromWideUInt(&significandBig,
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;
}
}
}
@@ -1470,7 +1457,7 @@ AccumulateDecimalDigit(
* bignum and fall through into the bignum case.
*/
TclBNInitBignumFromWideUInt(bignumRepPtr, w);
TclInitBignumFromWideUInt(bignumRepPtr, w);
} else {
/*
* Wide multiplication.
@@ -1613,7 +1600,7 @@ MakeLowPrecisionDouble(
* call MakeHighPrecisionDouble to do it the hard way.
*/
TclBNInitBignumFromWideUInt(&significandBig, significand);
TclInitBignumFromWideUInt(&significandBig, significand);
retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
exponent);
mp_clear(&significandBig);
@@ -1980,7 +1967,7 @@ RefineApproximation(
*----------------------------------------------------------------------
*/
inline static void
static inline void
MulPow5(
mp_int *base, /* Number to multiply. */
unsigned n, /* Power of 5 to multiply by. */
@@ -2025,7 +2012,7 @@ MulPow5(
*----------------------------------------------------------------------
*/
inline static int
static inline int
NormalizeRightward(
Tcl_WideUInt *wPtr) /* INOUT: Number to shift. */
{
@@ -2116,7 +2103,7 @@ RequiredPrecision(
*----------------------------------------------------------------------
*/
inline static void
static inline void
DoubleToExpAndSig(
double dv, /* Number to convert. */
Tcl_WideUInt *significand, /* OUTPUT: Significand of the number. */
@@ -2164,7 +2151,7 @@ DoubleToExpAndSig(
*----------------------------------------------------------------------
*/
inline static void
static inline void
TakeAbsoluteValue(
Double *d, /* Number to replace with absolute value. */
int *sign) /* Place to put the signum. */
@@ -2195,7 +2182,7 @@ TakeAbsoluteValue(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
FormatInfAndNaN(
Double *d, /* Exceptional number to format. */
int *decpt, /* Decimal point to set to a bogus value. */
@@ -2237,7 +2224,7 @@ FormatInfAndNaN(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
FormatZero(
int *decpt, /* Location of the decimal point. */
char **endPtr) /* Pointer to the end of the formatted data */
@@ -2267,7 +2254,7 @@ FormatZero(
*----------------------------------------------------------------------
*/
inline static int
static inline int
ApproximateLog10(
Tcl_WideUInt bw, /* Integer significand of the number. */
int be, /* Power of two to scale bw. */
@@ -2315,7 +2302,7 @@ ApproximateLog10(
*----------------------------------------------------------------------
*/
inline static int
static inline int
BetterLog10(
double d, /* Original number to format. */
int k, /* Characteristic(Log base 10) of the
@@ -2358,7 +2345,7 @@ BetterLog10(
*----------------------------------------------------------------------
*/
inline static void
static inline void
ComputeScale(
int be, /* Exponent part of number: d = bw * 2**be. */
int k, /* Characteristic of log10(number). */
@@ -2421,7 +2408,7 @@ ComputeScale(
*----------------------------------------------------------------------
*/
inline static void
static inline void
SetPrecisionLimits(
int convType, /* Type of conversion: TCL_DD_SHORTEST,
* TCL_DD_STEELE0, TCL_DD_E_FMT,
@@ -2482,7 +2469,7 @@ SetPrecisionLimits(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
BumpUp(
char *s, /* Cursor pointing one past the end of the
* string. */
@@ -2516,7 +2503,7 @@ BumpUp(
*----------------------------------------------------------------------
*/
inline static int
static inline int
AdjustRange(
double *dPtr, /* INOUT: Number to adjust. */
int k) /* IN: floor(log10(d)) */
@@ -2589,7 +2576,7 @@ AdjustRange(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
ShorteningQuickFormat(
double d, /* Number to convert. */
int k, /* floor(log10(d)) */
@@ -2664,7 +2651,7 @@ ShorteningQuickFormat(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
StrictQuickFormat(
double d, /* Number to convert. */
int k, /* floor(log10(d)) */
@@ -2738,7 +2725,7 @@ StrictQuickFormat(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
QuickConversion(
double e, /* Number to format. */
int k, /* floor(log10(d)), approximately. */
@@ -2843,7 +2830,7 @@ QuickConversion(
*----------------------------------------------------------------------
*/
inline static void
static inline void
CastOutPowersOf2(
int *b2, /* Power of 2 to multiply the significand. */
int *m2, /* Power of 2 to multiply 1/2 ulp. */
@@ -2887,7 +2874,7 @@ CastOutPowersOf2(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
ShorteningInt64Conversion(
Double *dPtr, /* Original number to convert. */
int convType, /* Type of conversion (shortest, Steele,
@@ -3056,7 +3043,7 @@ ShorteningInt64Conversion(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
StrictInt64Conversion(
Double *dPtr, /* Original number to convert. */
int convType, /* Type of conversion (shortest, Steele,
@@ -3162,7 +3149,7 @@ StrictInt64Conversion(
*----------------------------------------------------------------------
*/
inline static int
static inline int
ShouldBankerRoundUpPowD(
mp_int *b, /* Numerator of the fraction. */
int sd, /* Denominator is 2**(sd*DIGIT_BIT). */
@@ -3200,7 +3187,7 @@ ShouldBankerRoundUpPowD(
*----------------------------------------------------------------------
*/
inline static int
static inline int
ShouldBankerRoundUpToNextPowD(
mp_int *b, /* Numerator of the fraction. */
mp_int *m, /* Numerator of the rounding tolerance. */
@@ -3263,7 +3250,7 @@ ShouldBankerRoundUpToNextPowD(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
ShorteningBignumConversionPowD(
Double *dPtr, /* Original number to convert. */
int convType, /* Type of conversion (shortest, Steele,
@@ -3300,7 +3287,7 @@ ShorteningBignumConversionPowD(
* mminus = 5**m5
*/
TclBNInitBignumFromWideUInt(&b, bw);
TclInitBignumFromWideUInt(&b, bw);
mp_init_set_int(&mminus, 1);
MulPow5(&b, b5, &b);
mp_mul_2d(&b, b2, &b);
@@ -3456,7 +3443,7 @@ ShorteningBignumConversionPowD(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
StrictBignumConversionPowD(
Double *dPtr, /* Original number to convert. */
int convType, /* Type of conversion (shortest, Steele,
@@ -3487,7 +3474,7 @@ StrictBignumConversionPowD(
* b = bw * 2**b2 * 5**b5
*/
TclBNInitBignumFromWideUInt(&b, bw);
TclInitBignumFromWideUInt(&b, bw);
MulPow5(&b, b5, &b);
mp_mul_2d(&b, b2, &b);
@@ -3572,7 +3559,7 @@ StrictBignumConversionPowD(
*----------------------------------------------------------------------
*/
inline static int
static inline int
ShouldBankerRoundUp(
mp_int *twor, /* 2x the remainder from thd division that
* produced the last digit. */
@@ -3607,7 +3594,7 @@ ShouldBankerRoundUp(
*----------------------------------------------------------------------
*/
inline static int
static inline int
ShouldBankerRoundUpToNext(
mp_int *b, /* Remainder from the division that produced
* the last digit. */
@@ -3661,7 +3648,7 @@ ShouldBankerRoundUpToNext(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
ShorteningBignumConversion(
Double *dPtr, /* Original number being converted. */
int convType, /* Conversion type. */
@@ -3695,7 +3682,7 @@ ShorteningBignumConversion(
* S = 2**s2 * 5*s5
*/
TclBNInitBignumFromWideUInt(&b, bw);
TclInitBignumFromWideUInt(&b, bw);
mp_mul_2d(&b, b2, &b);
mp_init_set_int(&S, 1);
MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
@@ -3877,7 +3864,7 @@ ShorteningBignumConversion(
*----------------------------------------------------------------------
*/
inline static char *
static inline char *
StrictBignumConversion(
Double *dPtr, /* Original number being converted. */
int convType, /* Conversion type. */
@@ -3908,7 +3895,7 @@ StrictBignumConversion(
*/
mp_init_multi(&temp, &dig, NULL);
TclBNInitBignumFromWideUInt(&b, bw);
TclInitBignumFromWideUInt(&b, bw);
mp_mul_2d(&b, b2, &b);
mp_init_set_int(&S, 1);
MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
@@ -4564,7 +4551,7 @@ Tcl_InitBignumFromDouble(
Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
int shift = expt - mantBits;
TclBNInitBignumFromWideInt(b, w);
TclInitBignumFromWideInt(b, w);
if (shift < 0) {
mp_div_2d(b, -shift, b, NULL);
} else if (shift > 0) {
+532 -194
View File
File diff suppressed because it is too large Load Diff
+127 -49
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,6 +43,7 @@
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
@@ -49,7 +51,7 @@
#undef TclWinNToHS
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED)
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
@@ -59,16 +61,31 @@ static int TclSockMinimumBuffersOld(int sock, int size)
}
#endif
#if defined(TCL_NO_DEPRECATED)
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSetStartupScriptPath 0
# define TclGetStartupScriptPath 0
# define TclSetStartupScriptFileName 0
# define TclGetStartupScriptFileName 0
# define TclPrecTraceProc 0
# define TclpInetNtoa 0
# define TclWinGetServByName 0
# define TclWinGetSockOpt 0
# define TclWinSetSockOpt 0
# define TclWinNToHS 0
# define TclWinGetPlatformId 0
# define TclWinResetInterfaces 0
# define TclWinSetInterfaces 0
# define TclWinGetPlatformId 0
# define TclBNInitBignumFromWideUInt 0
# define TclBNInitBignumFromWideInt 0
# define TclBNInitBignumFromLong 0
# define Tcl_Backslash 0
# define Tcl_GetDefaultEncodingDir 0
# define Tcl_SetDefaultEncodingDir 0
# define Tcl_EvalTokens 0
# define Tcl_CreateMathFunc 0
# define Tcl_GetMathFuncInfo 0
# define Tcl_ListMathFuncs 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
@@ -95,14 +112,32 @@ static const char *TclGetStartupScriptFileName(void)
}
return Tcl_GetString(path);
}
#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
#undef TclWinGetPlatformId
#undef TclWinResetInterfaces
#undef TclWinSetInterfaces
static void
doNothing(void)
{
/* dummy implementation, no need to do anything */
}
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
return ntohs(ns);
}
#define TclWinGetPlatformId winGetPlatformId
static int
TclWinGetPlatformId(void)
{
return 2; /* VER_PLATFORM_WIN32_NT */;
}
#define TclWinResetInterfaces doNothing
#define TclWinSetInterfaces (void (*) (int)) doNothing
#endif
# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
# define TclBNInitBignumFromLong TclInitBignumFromLong
#endif /* TCL_NO_DEPRECATED */
#ifdef _WIN32
@@ -113,12 +148,15 @@ static unsigned short TclWinNToHS(unsigned short ns) {
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
# define TclpIsAtty TclPlatIsAtty
# define TclWinSetInterfaces (void (*) (int)) doNothing
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
static void
doNothing(void)
{
/* dummy implementation, no need to do anything */
}
#endif
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
# define TclWinResetInterfaces doNothing
static Tcl_Encoding winTCharEncoding;
static int
TclpIsAtty(int fd)
@@ -126,24 +164,15 @@ 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
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
@@ -188,23 +217,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 *
@@ -213,11 +242,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)
@@ -238,7 +277,7 @@ static Tcl_Obj *dbNewLongObj(
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.longValue = (long) intValue;
objPtr->internalRep.wideValue = (long) intValue;
objPtr->typePtr = &tclIntType;
return objPtr;
#else
@@ -305,7 +344,7 @@ static int formatInt(char *buffer, int n){
#endif /* __CYGWIN__ */
#ifdef TCL_NO_DEPRECATED
#if defined(TCL_NO_DEPRECATED)
# define Tcl_SeekOld 0
# define Tcl_TellOld 0
# undef Tcl_SetBooleanObj
@@ -360,6 +399,26 @@ static int formatInt(char *buffer, int n){
# define TclBackgroundException 0
# undef TclpReaddir
# define TclpReaddir 0
# define TclSetStartupScript 0
# define TclGetStartupScript 0
# define TclCreateNamespace 0
# define TclDeleteNamespace 0
# define TclAppendExportList 0
# define TclExport 0
# define TclImport 0
# define TclForgetImport 0
# define TclGetCurrentNamespace_ 0
# define TclGetGlobalNamespace_ 0
# define TclFindNamespace 0
# define TclFindCommand 0
# define TclGetCommandFromObj 0
# define TclGetCommandFullName 0
# define TclCopyChannelOld 0
# define Tcl_AppendResultVA 0
# define Tcl_AppendStringsToObjVA 0
# define Tcl_SetErrorCodeVA 0
# define Tcl_PanicVA 0
# define Tcl_VarEvalVA 0
# undef TclpGetDate
# define TclpGetDate 0
# undef TclpLocaltime
@@ -372,6 +431,20 @@ static int formatInt(char *buffer, int n){
# define Tcl_SeekOld seekOld
# define Tcl_TellOld tellOld
# define TclBackgroundException Tcl_BackgroundException
# define TclSetStartupScript Tcl_SetStartupScript
# define TclGetStartupScript Tcl_GetStartupScript
# define TclCreateNamespace Tcl_CreateNamespace
# define TclDeleteNamespace Tcl_DeleteNamespace
# define TclAppendExportList Tcl_AppendExportList
# define TclExport Tcl_Export
# define TclImport Tcl_Import
# define TclForgetImport Tcl_ForgetImport
# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
# define TclFindNamespace Tcl_FindNamespace
# define TclFindCommand Tcl_FindCommand
# define TclGetCommandFromObj Tcl_GetCommandFromObj
# define TclGetCommandFullName Tcl_GetCommandFullName
# define TclpLocaltime_unix TclpLocaltime
# define TclpGmtime_unix TclpGmtime
@@ -524,22 +597,22 @@ 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 */
TclAppendExportList, /* 112 */
TclCreateNamespace, /* 113 */
TclDeleteNamespace, /* 114 */
TclExport, /* 115 */
TclFindCommand, /* 116 */
TclFindNamespace, /* 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 */
TclForgetImport, /* 121 */
TclGetCommandFromObj, /* 122 */
TclGetCommandFullName, /* 123 */
TclGetCurrentNamespace_, /* 124 */
TclGetGlobalNamespace_, /* 125 */
Tcl_GetVariableFullName, /* 126 */
Tcl_Import, /* 127 */
TclImport, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
@@ -590,8 +663,8 @@ static const TclIntStubs tclIntStubs = {
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
Tcl_SetStartupScript, /* 178 */
Tcl_GetStartupScript, /* 179 */
TclSetStartupScript, /* 178 */
TclGetStartupScript, /* 179 */
0, /* 180 */
0, /* 181 */
TclpLocaltime, /* 182 */
@@ -859,6 +932,10 @@ const TclTomMathStubs tclTomMathStubs = {
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
TclBN_mp_expt_d_ex, /* 67 */
TclBN_mp_set_long_long, /* 68 */
TclBN_mp_get_long_long, /* 69 */
TclBN_mp_set_long, /* 70 */
TclBN_mp_get_long, /* 71 */
};
static const TclStubHooks tclStubHooks = {
@@ -1526,6 +1603,7 @@ const TclStubs tclStubs = {
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
Tcl_OpenTcpServerEx, /* 631 */
Tcl_ReplaceObj, /* 632 */
};
/* !END!: Do not edit above this line. */
+101 -169
View File
@@ -227,6 +227,9 @@ static int TestasyncCmd(ClientData dummy,
static int TestbytestringObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TeststringbytesObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestcmdinfoCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestcmdtokenCmd(ClientData dummy,
@@ -302,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,
@@ -421,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[]);
@@ -546,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;
@@ -581,6 +578,7 @@ Tcltest_Init(
Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
@@ -688,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,
@@ -697,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,
@@ -711,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,
@@ -1985,9 +1976,12 @@ TestencodingObjCmd(
if (objc != 3) {
return TCL_ERROR;
}
encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
Tcl_FreeEncoding(encoding);
Tcl_FreeEncoding(encoding);
if (TCL_OK != Tcl_GetEncodingFromObj(interp, objv[2], &encoding)) {
return TCL_ERROR;
}
Tcl_FreeEncoding(encoding); /* Free returned reference */
Tcl_FreeEncoding(encoding); /* Free to match CREATE */
TclFreeIntRep(objv[2]); /* Free the cached ref */
break;
}
return TCL_OK;
@@ -3337,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 */
/*
*----------------------------------------------------------------------
*
@@ -5043,6 +4897,40 @@ NoopObjCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TeststringbytesObjCmd --
* Returns bytearray value of the bytes in argument string rep
*
* Results:
* Returns the TCL_OK result code.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TeststringbytesObjCmd(
ClientData unused, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int n;
const unsigned char *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n);
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -5319,7 +5207,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;
@@ -5716,8 +5604,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;
}
@@ -6844,6 +6732,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)
/*
*----------------------------------------------------------------------
+8
View File
@@ -1088,6 +1088,9 @@ TestobjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
typeName = objv[2]->typePtr->name;
#ifndef TCL_WIDE_INT_IS_LONG
if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
} else if (strcmp(subCmd, "refcount") == 0) {
@@ -1115,6 +1118,11 @@ TestobjCmd(
}
if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) {
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"int", -1);
#endif
} else {
Tcl_AppendToObj(Tcl_GetObjResult(interp),
varPtr[varIndex]->typePtr->name, -1);
+2 -2
View File
@@ -248,7 +248,7 @@ ThreadObjCmd(
switch ((enum options)option) {
case THREAD_CANCEL: {
long id;
Tcl_WideInt id;
const char *result;
int flags, arg;
@@ -264,7 +264,7 @@ ThreadObjCmd(
arg++;
}
}
if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
+11 -24
View File
@@ -819,9 +819,6 @@ Tcl_AfterObjCmd(
*/
if (objv[1]->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
|| objv[1]->typePtr == &tclWideIntType
#endif
|| objv[1]->typePtr == &tclBignumType
|| (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
&index) != TCL_OK)) {
@@ -1045,37 +1042,27 @@ AfterDelay(
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
#ifndef TCL_WIDE_INT_IS_LONG
if (diff > LONG_MAX) {
diff = LONG_MAX;
}
#endif
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
diff = 1;
}
if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
diff = 1;
}
if (diff > 0) {
Tcl_Sleep((long) diff);
if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
break;
}
Tcl_Sleep((int) diff);
if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
break;
}
} else {
break;
}
break;
}
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
if (diff > LONG_MAX) {
diff = LONG_MAX;
}
#endif
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
if (diff > 0) {
Tcl_Sleep((long) diff);
Tcl_Sleep((int) diff);
}
if (Tcl_AsyncReady()) {
if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
@@ -1089,7 +1076,7 @@ AfterDelay(
return TCL_ERROR;
}
}
Tcl_GetTime(&now);
Tcl_GetTime(&now);
} while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
+49 -36
View File
@@ -30,13 +30,13 @@ declare 1 {
}
declare 2 {
int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 3 {
int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
int TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c)
}
declare 4 {
int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 5 {
void TclBN_mp_clamp(mp_int *a)
@@ -63,25 +63,25 @@ declare 12 {
int TclBN_mp_count_bits(const mp_int *a)
}
declare 13 {
int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
int TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r)
}
declare 14 {
int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
int TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
}
declare 15 {
int TclBN_mp_div_2(mp_int *a, mp_int *q)
int TclBN_mp_div_2(const mp_int *a, mp_int *q)
}
declare 16 {
int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
}
declare 17 {
int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
int TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r)
}
declare 18 {
void TclBN_mp_exch(mp_int *a, mp_int *b)
}
declare 19 {
int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
int TclBN_mp_expt_d(const mp_int *a, mp_digit b, mp_int *c)
}
declare 20 {
int TclBN_mp_grow(mp_int *a, int size)
@@ -105,19 +105,19 @@ declare 26 {
int TclBN_mp_lshd(mp_int *a, int shift)
}
declare 27 {
int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
int TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r)
}
declare 28 {
int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r)
}
declare 29 {
int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
int TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p)
}
declare 30 {
int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
int TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p)
}
declare 31 {
int TclBN_mp_mul_2(mp_int *a, mp_int *p)
int TclBN_mp_mul_2(const mp_int *a, mp_int *p)
}
declare 32 {
int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
@@ -126,7 +126,7 @@ declare 33 {
int TclBN_mp_neg(const mp_int *a, mp_int *b)
}
declare 34 {
int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 35 {
int TclBN_mp_radix_size(const mp_int *a, int radix, int *size)
@@ -144,32 +144,32 @@ declare 39 {
void TclBN_mp_set(mp_int *a, mp_digit b)
}
declare 40 {
int TclBN_mp_sqr(mp_int *a, mp_int *b)
int TclBN_mp_sqr(const mp_int *a, mp_int *b)
}
declare 41 {
int TclBN_mp_sqrt(mp_int *a, mp_int *b)
int TclBN_mp_sqrt(const mp_int *a, mp_int *b)
}
declare 42 {
int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 43 {
int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
int TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c)
}
declare 44 {
int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
int TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
}
declare 45 {
int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
int TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b,
unsigned long *outlen)
}
declare 46 {
int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
int TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
}
declare 47 {
int TclBN_mp_unsigned_bin_size(mp_int *a)
int TclBN_mp_unsigned_bin_size(const mp_int *a)
}
declare 48 {
int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 49 {
void TclBN_mp_zero(mp_int *a)
@@ -182,34 +182,34 @@ declare 50 {
void TclBN_reverse(unsigned char *s, int len)
}
declare 51 {
int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
int TclBN_fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
}
declare 52 {
int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
int TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b)
}
declare 53 {
int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 54 {
int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
int TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b)
}
declare 55 {
int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
int TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 56 {
int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
int TclBN_mp_toom_sqr(const mp_int *a, mp_int *b)
}
declare 57 {
int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
int TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 58 {
int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
int TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
}
declare 59 {
int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
int TclBN_s_mp_sqr(const mp_int *a, mp_int *b)
}
declare 60 {
int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
int TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 61 {
int TclBN_mp_init_set_int(mp_int *a, unsigned long i)
@@ -223,19 +223,32 @@ declare 63 {
# Formerly internal API to allow initialisation of bignums without knowing the
# typedefs of how a bignum works internally.
declare 64 {
declare 64 {deprecated {Use mp_init() + mp_set_long_long()}} {
void TclBNInitBignumFromLong(mp_int *bignum, long initVal)
}
declare 65 {
declare 65 {deprecated {Use mp_init() + mp_set_long_long()}} {
void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal)
}
declare 66 {
declare 66 {deprecated {Use mp_init() + mp_set_long_long()}} {
void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
}
# Added in libtommath 1.0
declare 67 {
int TclBN_mp_expt_d_ex(mp_int *a, mp_digit b, mp_int *c, int fast)
int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
}
# Added in libtommath 1.0.1
declare 68 {
int TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i)
}
declare 69 {
Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a)
}
declare 70 {
int TclBN_mp_set_long(mp_int *a, unsigned long i)
}
declare 71 {
unsigned long TclBN_mp_get_long(const mp_int *a)
}
# Local Variables:
+159 -148
View File
@@ -27,10 +27,10 @@ extern "C" {
#endif
/* detect 64-bit mode if possible */
#if defined(NEVER) /* 128-bit ints fail in too many places */
#if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
#define MP_64BIT
#endif
#if defined(NEVER) /* 128-bit ints fail in too many places */
# if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
# define MP_64BIT
# endif
#endif
/* some default configurations.
@@ -43,89 +43,94 @@ extern "C" {
*/
#ifdef MP_8BIT
#ifndef MP_DIGIT_DECLARED
typedef uint8_t mp_digit;
typedef uint8_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef uint16_t mp_word;
#define MP_SIZEOF_MP_DIGIT 1
#ifdef DIGIT_BIT
#error You must not define DIGIT_BIT when using MP_8BIT
#ifndef MP_WORD_DECLARED
typedef uint16_t mp_word;
#define MP_WORD_DECLARED
#endif
# define MP_SIZEOF_MP_DIGIT 1
# ifdef DIGIT_BIT
# error You must not define DIGIT_BIT when using MP_8BIT
# endif
#elif defined(MP_16BIT)
#ifndef MP_DIGIT_DECLARED
typedef uint16_t mp_digit;
typedef uint16_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef uint32_t mp_word;
#define MP_SIZEOF_MP_DIGIT 2
#ifdef DIGIT_BIT
#error You must not define DIGIT_BIT when using MP_16BIT
#ifndef MP_WORD_DECLARED
typedef uint32_t mp_word;
#define MP_WORD_DECLARED
#endif
# define MP_SIZEOF_MP_DIGIT 2
# ifdef DIGIT_BIT
# error You must not define DIGIT_BIT when using MP_16BIT
# endif
#elif defined(MP_64BIT)
/* for GCC only on supported platforms */
#ifndef CRYPT
typedef unsigned long long ulong64;
typedef signed long long long64;
#endif
/* for GCC only on supported platforms */
#ifndef MP_DIGIT_DECLARED
typedef ulong64 mp_digit;
typedef uint64_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
#if defined(_WIN32)
typedef unsigned __int128 mp_word;
#elif defined(__GNUC__)
typedef unsigned long mp_word __attribute__ ((mode(TI)));
#else
/* it seems you have a problem
* but we assume you can somewhere define your own uint128_t */
typedef uint128_t mp_word;
# if defined(_WIN32)
#ifndef MP_WORD_DECLARED
typedef unsigned __int128 mp_word;
#define MP_WORD_DECLARED
#endif
#define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */
/* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
typedef unsigned long long ulong64;
typedef signed long long long64;
# elif defined(__GNUC__)
typedef unsigned long mp_word __attribute__((mode(TI)));
# else
/* it seems you have a problem
* but we assume you can somewhere define your own uint128_t */
#ifndef MP_WORD_DECLARED
typedef uint128_t mp_word;
#define MP_WORD_DECLARED
#endif
# endif
# define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */
/* this is to make porting into LibTomCrypt easier :-) */
#ifndef MP_DIGIT_DECLARED
typedef uint32_t mp_digit;
typedef uint32_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef ulong64 mp_word;
#ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
#define DIGIT_BIT 31
#else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
#define DIGIT_BIT 28
#define MP_28BIT
#ifndef MP_WORD_DECLARED
typedef uint64_t mp_word;
#define MP_WORD_DECLARED
#endif
# ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
# define DIGIT_BIT 31
# else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
# define DIGIT_BIT 28
# define MP_28BIT
# endif
#endif
/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
#define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1)) /* bits per digit */
typedef uint_least32_t mp_min_u32;
# define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1)) /* bits per digit */
typedef uint_least32_t mp_min_u32;
#else
typedef mp_digit mp_min_u32;
#endif
/* platforms that can use a better rand function */
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
#define MP_USE_ALT_RAND 1
typedef mp_digit mp_min_u32;
#endif
/* use arc4random on platforms that support it */
#ifdef MP_USE_ALT_RAND
#define MP_GEN_RANDOM() arc4random()
#else
#define MP_GEN_RANDOM() rand()
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
# define MP_GEN_RANDOM() arc4random()
# define MP_GEN_RANDOM_MAX 0xffffffff
#endif
/* use rand() as fall-back if there's no better rand function */
#ifndef MP_GEN_RANDOM
# define MP_GEN_RANDOM() rand()
# define MP_GEN_RANDOM_MAX RAND_MAX
#endif
#define MP_DIGIT_BIT DIGIT_BIT
@@ -158,9 +163,9 @@ typedef int mp_err;
/* you'll have to tune these... */
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
KARATSUBA_SQR_CUTOFF,
TOOM_MUL_CUTOFF,
TOOM_SQR_CUTOFF;
KARATSUBA_SQR_CUTOFF,
TOOM_MUL_CUTOFF,
TOOM_SQR_CUTOFF;
#endif
/* define this to use lower memory usage routines (exptmods mostly) */
@@ -168,11 +173,11 @@ MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
/* default precision */
#ifndef MP_PREC
#ifndef MP_LOW_MEM
#define MP_PREC 32 /* default digits of precision */
#else
#define MP_PREC 8 /* default digits of precision */
#endif
# ifndef MP_LOW_MEM
# define MP_PREC 32 /* default digits of precision */
# else
# define MP_PREC 8 /* default digits of precision */
# endif
#endif
/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
@@ -184,17 +189,17 @@ MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
typedef struct mp_int mp_int;
#endif
struct mp_int {
int used, alloc, sign;
mp_digit *dp;
int used, alloc, sign;
mp_digit *dp;
};
/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
#define USED(m) ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m) ((m)->sign)
#define USED(m) ((m)->used)
#define DIGIT(m, k) ((m)->dp[(k)])
#define SIGN(m) ((m)->sign)
/* error code to char* string */
const char *mp_error_to_string(int code);
@@ -272,22 +277,28 @@ int mp_set_long_long(mp_int *a, unsigned long long b);
*/
/* get a 32-bit value */
unsigned long mp_get_int(mp_int * a);
/*
unsigned long mp_get_int(const mp_int *a);
*/
/* get a platform dependent unsigned long value */
unsigned long mp_get_long(mp_int * a);
/*
unsigned long mp_get_long(const mp_int *a);
*/
/* get a platform dependent unsigned long long value */
unsigned long long mp_get_long_long(mp_int * a);
/*
unsigned long long mp_get_long_long(const mp_int *a);
*/
/* initialize and set a digit */
/*
int mp_init_set (mp_int * a, mp_digit b);
int mp_init_set(mp_int *a, mp_digit b);
*/
/* initialize and set 32-bit value */
/*
int mp_init_set_int (mp_int * a, unsigned long b);
int mp_init_set_int(mp_int *a, unsigned long b);
*/
/* copy, b = a */
@@ -307,12 +318,12 @@ void mp_clamp(mp_int *a);
/* import binary data */
/*
int mp_import(mp_int* rop, size_t count, int order, size_t size, int endian, size_t nails, const void* op);
int mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op);
*/
/* export binary data */
/*
int mp_export(void* rop, size_t* countp, int order, size_t size, int endian, size_t nails, mp_int* op);
int mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op);
*/
/* ---> digit manipulation <--- */
@@ -334,7 +345,7 @@ int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
/* b = a/2 */
/*
int mp_div_2(mp_int *a, mp_int *b);
int mp_div_2(const mp_int *a, mp_int *b);
*/
/* c = a * 2**b, implemented as c = a << b */
@@ -344,7 +355,7 @@ int mp_mul_2d(const mp_int *a, int b, mp_int *c);
/* b = a*2 */
/*
int mp_mul_2(mp_int *a, mp_int *b);
int mp_mul_2(const mp_int *a, mp_int *b);
*/
/* c = a mod 2**b */
@@ -372,17 +383,17 @@ int mp_rand(mp_int *a, int digits);
/* ---> binary operations <--- */
/* c = a XOR b */
/*
int mp_xor(mp_int *a, mp_int *b, mp_int *c);
int mp_xor(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* c = a OR b */
/*
int mp_or(mp_int *a, mp_int *b, mp_int *c);
int mp_or(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* c = a AND b */
/*
int mp_and(mp_int *a, mp_int *b, mp_int *c);
int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* ---> Basic arithmetic <--- */
@@ -394,7 +405,7 @@ int mp_neg(const mp_int *a, mp_int *b);
/* b = |a| */
/*
int mp_abs(mp_int *a, mp_int *b);
int mp_abs(const mp_int *a, mp_int *b);
*/
/* compare a to b */
@@ -409,32 +420,32 @@ int mp_cmp_mag(const mp_int *a, const mp_int *b);
/* c = a + b */
/*
int mp_add(mp_int *a, mp_int *b, mp_int *c);
int mp_add(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* c = a - b */
/*
int mp_sub(mp_int *a, mp_int *b, mp_int *c);
int mp_sub(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* c = a * b */
/*
int mp_mul(mp_int *a, mp_int *b, mp_int *c);
int mp_mul(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* b = a*a */
/*
int mp_sqr(mp_int *a, mp_int *b);
int mp_sqr(const mp_int *a, mp_int *b);
*/
/* a/b => cb + d == a */
/*
int mp_div(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d);
*/
/* c = a mod b, 0 <= c < b */
/*
int mp_mod(mp_int *a, mp_int *b, mp_int *c);
int mp_mod(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* ---> single digit functions <--- */
@@ -446,82 +457,82 @@ int mp_cmp_d(const mp_int *a, mp_digit b);
/* c = a + b */
/*
int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
int mp_add_d(const mp_int *a, mp_digit b, mp_int *c);
*/
/* c = a - b */
/*
int mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
int mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
*/
/* c = a * b */
/*
int mp_mul_d(mp_int *a, mp_digit b, mp_int *c);
int mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);
*/
/* a/b => cb + d == a */
/*
int mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
int mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
*/
/* a/3 => 3c + d == a */
/*
int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
int mp_div_3(const mp_int *a, mp_int *c, mp_digit *d);
*/
/* c = a**b */
/*
int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
int mp_expt_d(const mp_int *a, mp_digit b, mp_int *c);
*/
/*
int mp_expt_d_ex (mp_int * a, mp_digit b, mp_int * c, int fast);
int mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast);
*/
/* c = a mod b, 0 <= c < b */
/*
int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
int mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c);
*/
/* ---> number theory <--- */
/* d = a + b (mod c) */
/*
int mp_addmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
int mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
*/
/* d = a - b (mod c) */
/*
int mp_submod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
int mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
*/
/* d = a * b (mod c) */
/*
int mp_mulmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
int mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
*/
/* c = a * a (mod b) */
/*
int mp_sqrmod(mp_int *a, mp_int *b, mp_int *c);
int mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* c = 1/a (mod b) */
/*
int mp_invmod(mp_int *a, mp_int *b, mp_int *c);
int mp_invmod(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* c = (a, b) */
/*
int mp_gcd(mp_int *a, mp_int *b, mp_int *c);
int mp_gcd(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* produces value such that U1*a + U2*b = U3 */
/*
int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
int mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
*/
/* c = [a, b] or (a*b)/(a, b) */
/*
int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c);
*/
/* finds one of the b'th root of a, such that |c|**b <= |a|
@@ -529,35 +540,35 @@ int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
* returns error if a < 0 and b is even
*/
/*
int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
int mp_n_root(const mp_int *a, mp_digit b, mp_int *c);
*/
/*
int mp_n_root_ex (mp_int * a, mp_digit b, mp_int * c, int fast);
int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast);
*/
/* special sqrt algo */
/*
int mp_sqrt(mp_int *arg, mp_int *ret);
int mp_sqrt(const mp_int *arg, mp_int *ret);
*/
/* special sqrt (mod prime) */
/*
int mp_sqrtmod_prime(mp_int *arg, mp_int *prime, mp_int *ret);
int mp_sqrtmod_prime(const mp_int *arg, const mp_int *prime, mp_int *ret);
*/
/* is number a square? */
/*
int mp_is_square(mp_int *arg, int *ret);
int mp_is_square(const mp_int *arg, int *ret);
*/
/* computes the jacobi c = (a | n) (or Legendre if b is prime) */
/*
int mp_jacobi(mp_int *a, mp_int *n, int *c);
int mp_jacobi(const mp_int *a, const mp_int *n, int *c);
*/
/* used to setup the Barrett reduction for a given modulus b */
/*
int mp_reduce_setup(mp_int *a, mp_int *b);
int mp_reduce_setup(mp_int *a, const mp_int *b);
*/
/* Barrett Reduction, computes a (mod b) with a precomputed value c
@@ -566,83 +577,83 @@ int mp_reduce_setup(mp_int *a, mp_int *b);
* compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
*/
/*
int mp_reduce(mp_int *a, mp_int *b, mp_int *c);
int mp_reduce(mp_int *a, const mp_int *b, const mp_int *c);
*/
/* setups the montgomery reduction */
/*
int mp_montgomery_setup(mp_int *a, mp_digit *mp);
int mp_montgomery_setup(const mp_int *a, mp_digit *mp);
*/
/* computes a = B**n mod b without division or multiplication useful for
* normalizing numbers in a Montgomery system.
*/
/*
int mp_montgomery_calc_normalization(mp_int *a, mp_int *b);
int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b);
*/
/* computes x/R == x (mod N) via Montgomery Reduction */
/*
int mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
int mp_montgomery_reduce(mp_int *a, const mp_int *m, mp_digit mp);
*/
/* returns 1 if a is a valid DR modulus */
/*
int mp_dr_is_modulus(mp_int *a);
int mp_dr_is_modulus(const mp_int *a);
*/
/* sets the value of "d" required for mp_dr_reduce */
/*
void mp_dr_setup(mp_int *a, mp_digit *d);
void mp_dr_setup(const mp_int *a, mp_digit *d);
*/
/* reduces a modulo b using the Diminished Radix method */
/*
int mp_dr_reduce(mp_int *a, mp_int *b, mp_digit mp);
int mp_dr_reduce(mp_int *a, const mp_int *b, mp_digit mp);
*/
/* returns true if a can be reduced with mp_reduce_2k */
/*
int mp_reduce_is_2k(mp_int *a);
int mp_reduce_is_2k(const mp_int *a);
*/
/* determines k value for 2k reduction */
/*
int mp_reduce_2k_setup(mp_int *a, mp_digit *d);
int mp_reduce_2k_setup(const mp_int *a, mp_digit *d);
*/
/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
/*
int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d);
int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d);
*/
/* returns true if a can be reduced with mp_reduce_2k_l */
/*
int mp_reduce_is_2k_l(mp_int *a);
int mp_reduce_is_2k_l(const mp_int *a);
*/
/* determines k value for 2k reduction */
/*
int mp_reduce_2k_setup_l(mp_int *a, mp_int *d);
int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d);
*/
/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
/*
int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d);
int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d);
*/
/* d = a**b (mod c) */
/*
int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
int mp_exptmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
*/
/* ---> Primes <--- */
/* number of primes */
#ifdef MP_8BIT
# define PRIME_SIZE 31
# define PRIME_SIZE 31
#else
# define PRIME_SIZE 256
# define PRIME_SIZE 256
#endif
/* table of first PRIME_SIZE primes */
@@ -652,21 +663,21 @@ MODULE_SCOPE const mp_digit ltm_prime_tab[PRIME_SIZE];
/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
/*
int mp_prime_is_divisible(mp_int *a, int *result);
int mp_prime_is_divisible(const mp_int *a, int *result);
*/
/* performs one Fermat test of "a" using base "b".
* Sets result to 0 if composite or 1 if probable prime
*/
/*
int mp_prime_fermat(mp_int *a, mp_int *b, int *result);
int mp_prime_fermat(const mp_int *a, const mp_int *b, int *result);
*/
/* performs one Miller-Rabin test of "a" using base "b".
* Sets result to 0 if composite or 1 if probable prime
*/
/*
int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result);
*/
/* This gives [for a given bit size] the number of trials required
@@ -684,7 +695,7 @@ int mp_prime_rabin_miller_trials(int size);
* Sets result to 1 if probably prime, 0 otherwise
*/
/*
int mp_prime_is_prime(mp_int *a, int t, int *result);
int mp_prime_is_prime(const mp_int *a, int t, int *result);
*/
/* finds the next prime after the number "a" using "t" trials
@@ -730,39 +741,39 @@ int mp_count_bits(const mp_int *a);
*/
/*
int mp_unsigned_bin_size(mp_int *a);
int mp_unsigned_bin_size(const mp_int *a);
*/
/*
int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
*/
/*
int mp_to_unsigned_bin(mp_int *a, unsigned char *b);
int mp_to_unsigned_bin(const mp_int *a, unsigned char *b);
*/
/*
int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
int mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen);
*/
/*
int mp_signed_bin_size(mp_int *a);
int mp_signed_bin_size(const mp_int *a);
*/
/*
int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
*/
/*
int mp_to_signed_bin(mp_int *a, unsigned char *b);
int mp_to_signed_bin(const mp_int *a, unsigned char *b);
*/
/*
int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
int mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen);
*/
/*
int mp_read_radix(mp_int *a, const char *str, int radix);
*/
/*
int mp_toradix(mp_int *a, char *str, int radix);
int mp_toradix(const mp_int *a, char *str, int radix);
*/
/*
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
int mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen);
*/
/*
int mp_radix_size(const mp_int *a, int radix, int *size);
@@ -773,7 +784,7 @@ int mp_radix_size(const mp_int *a, int radix, int *size);
int mp_fread(mp_int *a, int radix, FILE *stream);
*/
/*
int mp_fwrite(mp_int *a, int radix, FILE *stream);
int mp_fwrite(const mp_int *a, int radix, FILE *stream);
*/
#endif
@@ -790,13 +801,13 @@ int mp_fwrite(mp_int *a, int radix, FILE *stream);
#define mp_tohex(M, S) mp_toradix((M), (S), 16)
#ifdef __cplusplus
}
}
#endif
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
/* ref: $Format:%D$ */
/* git commit: $Format:%H$ */
/* commit time: $Format:%ai$ */
+123 -79
View File
@@ -74,6 +74,9 @@
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex
#define mp_get_int TclBN_mp_get_int
#define mp_get_long TclBN_mp_get_long
#define mp_get_long_long TclBN_mp_get_long_long
#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
@@ -98,6 +101,8 @@
#define mp_s_rmap TclBNMpSRmap
#define mp_set TclBN_mp_set
#define mp_set_int TclBN_mp_set_int
#define mp_set_long TclBN_mp_set_long
#define mp_set_long_long TclBN_mp_set_long_long
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
@@ -148,11 +153,14 @@ EXTERN int TclBN_epoch(void);
/* 1 */
EXTERN int TclBN_revision(void);
/* 2 */
EXTERN int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_mp_add(const mp_int *a, const mp_int *b,
mp_int *c);
/* 3 */
EXTERN int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
EXTERN int TclBN_mp_add_d(const mp_int *a, mp_digit b,
mp_int *c);
/* 4 */
EXTERN int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_mp_and(const mp_int *a, const mp_int *b,
mp_int *c);
/* 5 */
EXTERN void TclBN_mp_clamp(mp_int *a);
/* 6 */
@@ -170,22 +178,24 @@ EXTERN int TclBN_mp_copy(const mp_int *a, mp_int *b);
/* 12 */
EXTERN int TclBN_mp_count_bits(const mp_int *a);
/* 13 */
EXTERN int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
mp_int *r);
EXTERN int TclBN_mp_div(const mp_int *a, const mp_int *b,
mp_int *q, mp_int *r);
/* 14 */
EXTERN int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
mp_digit *r);
EXTERN int TclBN_mp_div_d(const mp_int *a, mp_digit b,
mp_int *q, mp_digit *r);
/* 15 */
EXTERN int TclBN_mp_div_2(mp_int *a, mp_int *q);
EXTERN int TclBN_mp_div_2(const mp_int *a, mp_int *q);
/* 16 */
EXTERN int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
mp_int *r);
/* 17 */
EXTERN int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
EXTERN int TclBN_mp_div_3(const mp_int *a, mp_int *q,
mp_digit *r);
/* 18 */
EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b);
/* 19 */
EXTERN int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
EXTERN int TclBN_mp_expt_d(const mp_int *a, mp_digit b,
mp_int *c);
/* 20 */
EXTERN int TclBN_mp_grow(mp_int *a, int size);
/* 21 */
@@ -201,21 +211,25 @@ EXTERN int TclBN_mp_init_size(mp_int *a, int size);
/* 26 */
EXTERN int TclBN_mp_lshd(mp_int *a, int shift);
/* 27 */
EXTERN int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
EXTERN int TclBN_mp_mod(const mp_int *a, const mp_int *b,
mp_int *r);
/* 28 */
EXTERN int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r);
/* 29 */
EXTERN int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
EXTERN int TclBN_mp_mul(const mp_int *a, const mp_int *b,
mp_int *p);
/* 30 */
EXTERN int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
EXTERN int TclBN_mp_mul_d(const mp_int *a, mp_digit b,
mp_int *p);
/* 31 */
EXTERN int TclBN_mp_mul_2(mp_int *a, mp_int *p);
EXTERN int TclBN_mp_mul_2(const mp_int *a, mp_int *p);
/* 32 */
EXTERN int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
/* 33 */
EXTERN int TclBN_mp_neg(const mp_int *a, mp_int *b);
/* 34 */
EXTERN int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_mp_or(const mp_int *a, const mp_int *b,
mp_int *c);
/* 35 */
EXTERN int TclBN_mp_radix_size(const mp_int *a, int radix,
int *size);
@@ -229,52 +243,59 @@ EXTERN int TclBN_mp_shrink(mp_int *a);
/* 39 */
EXTERN void TclBN_mp_set(mp_int *a, mp_digit b);
/* 40 */
EXTERN int TclBN_mp_sqr(mp_int *a, mp_int *b);
EXTERN int TclBN_mp_sqr(const mp_int *a, mp_int *b);
/* 41 */
EXTERN int TclBN_mp_sqrt(mp_int *a, mp_int *b);
EXTERN int TclBN_mp_sqrt(const mp_int *a, mp_int *b);
/* 42 */
EXTERN int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_mp_sub(const mp_int *a, const mp_int *b,
mp_int *c);
/* 43 */
EXTERN int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
EXTERN int TclBN_mp_sub_d(const mp_int *a, mp_digit b,
mp_int *c);
/* 44 */
EXTERN int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
EXTERN int TclBN_mp_to_unsigned_bin(const mp_int *a,
unsigned char *b);
/* 45 */
EXTERN int TclBN_mp_to_unsigned_bin_n(mp_int *a,
EXTERN int TclBN_mp_to_unsigned_bin_n(const mp_int *a,
unsigned char *b, unsigned long *outlen);
/* 46 */
EXTERN int TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
int maxlen);
EXTERN int TclBN_mp_toradix_n(const mp_int *a, char *str,
int radix, int maxlen);
/* 47 */
EXTERN int TclBN_mp_unsigned_bin_size(mp_int *a);
EXTERN int TclBN_mp_unsigned_bin_size(const mp_int *a);
/* 48 */
EXTERN int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_mp_xor(const mp_int *a, const mp_int *b,
mp_int *c);
/* 49 */
EXTERN void TclBN_mp_zero(mp_int *a);
/* 50 */
EXTERN void TclBN_reverse(unsigned char *s, int len);
/* 51 */
EXTERN int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
mp_int *c, int digs);
EXTERN int TclBN_fast_s_mp_mul_digs(const mp_int *a,
const mp_int *b, mp_int *c, int digs);
/* 52 */
EXTERN int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
EXTERN int TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b);
/* 53 */
EXTERN int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
mp_int *c);
EXTERN int TclBN_mp_karatsuba_mul(const mp_int *a,
const mp_int *b, mp_int *c);
/* 54 */
EXTERN int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
EXTERN int TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b);
/* 55 */
EXTERN int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_mp_toom_mul(const mp_int *a, const mp_int *b,
mp_int *c);
/* 56 */
EXTERN int TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
EXTERN int TclBN_mp_toom_sqr(const mp_int *a, mp_int *b);
/* 57 */
EXTERN int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_s_mp_add(const mp_int *a, const mp_int *b,
mp_int *c);
/* 58 */
EXTERN int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
int digs);
EXTERN int TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b,
mp_int *c, int digs);
/* 59 */
EXTERN int TclBN_s_mp_sqr(mp_int *a, mp_int *b);
EXTERN int TclBN_s_mp_sqr(const mp_int *a, mp_int *b);
/* 60 */
EXTERN int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
EXTERN int TclBN_s_mp_sub(const mp_int *a, const mp_int *b,
mp_int *c);
/* 61 */
EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i);
/* 62 */
@@ -282,16 +303,27 @@ EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i);
/* 63 */
EXTERN int TclBN_mp_cnt_lsb(const mp_int *a);
/* 64 */
EXTERN void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
TCL_DEPRECATED("Use mp_init() + mp_set_long_long()")
void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
/* 65 */
EXTERN void TclBNInitBignumFromWideInt(mp_int *bignum,
TCL_DEPRECATED("Use mp_init() + mp_set_long_long()")
void TclBNInitBignumFromWideInt(mp_int *bignum,
Tcl_WideInt initVal);
/* 66 */
EXTERN void TclBNInitBignumFromWideUInt(mp_int *bignum,
TCL_DEPRECATED("Use mp_init() + mp_set_long_long()")
void TclBNInitBignumFromWideUInt(mp_int *bignum,
Tcl_WideUInt initVal);
/* 67 */
EXTERN int TclBN_mp_expt_d_ex(mp_int *a, mp_digit b, mp_int *c,
int fast);
EXTERN int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b,
mp_int *c, int fast);
/* 68 */
EXTERN int TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i);
/* 69 */
EXTERN Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a);
/* 70 */
EXTERN int TclBN_mp_set_long(mp_int *a, unsigned long i);
/* 71 */
EXTERN unsigned long TclBN_mp_get_long(const mp_int *a);
typedef struct TclTomMathStubs {
int magic;
@@ -299,9 +331,9 @@ typedef struct TclTomMathStubs {
int (*tclBN_epoch) (void); /* 0 */
int (*tclBN_revision) (void); /* 1 */
int (*tclBN_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 2 */
int (*tclBN_mp_add_d) (mp_int *a, mp_digit b, mp_int *c); /* 3 */
int (*tclBN_mp_and) (mp_int *a, mp_int *b, mp_int *c); /* 4 */
int (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 2 */
int (*tclBN_mp_add_d) (const mp_int *a, mp_digit b, mp_int *c); /* 3 */
int (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 4 */
void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
void (*tclBN_mp_clear) (mp_int *a); /* 6 */
void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
@@ -310,13 +342,13 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b); /* 10 */
int (*tclBN_mp_copy) (const mp_int *a, mp_int *b); /* 11 */
int (*tclBN_mp_count_bits) (const mp_int *a); /* 12 */
int (*tclBN_mp_div) (mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 13 */
int (*tclBN_mp_div_d) (mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
int (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r); /* 13 */
int (*tclBN_mp_div_d) (const mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
int (*tclBN_mp_div_2) (const mp_int *a, mp_int *q); /* 15 */
int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
int (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, mp_digit *r); /* 17 */
void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
int (*tclBN_mp_expt_d) (const mp_int *a, mp_digit b, mp_int *c); /* 19 */
int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
int (*tclBN_mp_init) (mp_int *a); /* 21 */
int (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */
@@ -324,47 +356,51 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
int (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r); /* 27 */
int (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */
int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
int (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p); /* 29 */
int (*tclBN_mp_mul_d) (const mp_int *a, mp_digit b, mp_int *p); /* 30 */
int (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p); /* 31 */
int (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */
int (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */
int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
int (*tclBN_mp_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 34 */
int (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size); /* 35 */
int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */
void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
int (*tclBN_mp_sub_d) (mp_int *a, mp_digit b, mp_int *c); /* 43 */
int (*tclBN_mp_to_unsigned_bin) (mp_int *a, unsigned char *b); /* 44 */
int (*tclBN_mp_to_unsigned_bin_n) (mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
int (*tclBN_mp_toradix_n) (mp_int *a, char *str, int radix, int maxlen); /* 46 */
int (*tclBN_mp_unsigned_bin_size) (mp_int *a); /* 47 */
int (*tclBN_mp_xor) (mp_int *a, mp_int *b, mp_int *c); /* 48 */
int (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */
int (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b); /* 41 */
int (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 42 */
int (*tclBN_mp_sub_d) (const mp_int *a, mp_digit b, mp_int *c); /* 43 */
int (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */
int (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
int (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */
int (*tclBN_mp_unsigned_bin_size) (const mp_int *a); /* 47 */
int (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 48 */
void (*tclBN_mp_zero) (mp_int *a); /* 49 */
void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
int (*tclBN_fast_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 51 */
int (*tclBN_fast_s_mp_sqr) (mp_int *a, mp_int *b); /* 52 */
int (*tclBN_mp_karatsuba_mul) (mp_int *a, mp_int *b, mp_int *c); /* 53 */
int (*tclBN_mp_karatsuba_sqr) (mp_int *a, mp_int *b); /* 54 */
int (*tclBN_mp_toom_mul) (mp_int *a, mp_int *b, mp_int *c); /* 55 */
int (*tclBN_mp_toom_sqr) (mp_int *a, mp_int *b); /* 56 */
int (*tclBN_s_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 57 */
int (*tclBN_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 58 */
int (*tclBN_s_mp_sqr) (mp_int *a, mp_int *b); /* 59 */
int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
int (*tclBN_fast_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 51 */
int (*tclBN_fast_s_mp_sqr) (const mp_int *a, mp_int *b); /* 52 */
int (*tclBN_mp_karatsuba_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 53 */
int (*tclBN_mp_karatsuba_sqr) (const mp_int *a, mp_int *b); /* 54 */
int (*tclBN_mp_toom_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 55 */
int (*tclBN_mp_toom_sqr) (const mp_int *a, mp_int *b); /* 56 */
int (*tclBN_s_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 57 */
int (*tclBN_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 58 */
int (*tclBN_s_mp_sqr) (const mp_int *a, mp_int *b); /* 59 */
int (*tclBN_s_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 60 */
int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
int (*tclBN_mp_expt_d_ex) (mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */
Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */
int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */
unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */
} TclTomMathStubs;
extern const TclTomMathStubs *tclTomMathStubsPtr;
@@ -515,6 +551,14 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
#define TclBN_mp_expt_d_ex \
(tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */
#define TclBN_mp_set_long_long \
(tclTomMathStubsPtr->tclBN_mp_set_long_long) /* 68 */
#define TclBN_mp_get_long_long \
(tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */
#define TclBN_mp_set_long \
(tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */
#define TclBN_mp_get_long \
(tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */
#endif /* defined(USE_TCL_STUBS) */
+23 -143
View File
@@ -89,86 +89,11 @@ TclBN_revision(void)
{
return TCLTOMMATH_REVISION;
}
#if 0
/*
*----------------------------------------------------------------------
*
* TclBNAlloc --
*
* Allocate memory for libtommath.
*
* Results:
* Returns a pointer to the allocated block.
*
* This procedure is a wrapper around Tcl_Alloc, needed because of a
* mismatched type signature between Tcl_Alloc and malloc.
*
*----------------------------------------------------------------------
*/
extern void *
TclBNAlloc(
size_t x)
{
return (void *) ckalloc((unsigned int) x);
}
/*
*----------------------------------------------------------------------
*
* TclBNRealloc --
*
* Change the size of an allocated block of memory in libtommath
*
* Results:
* Returns a pointer to the allocated block.
*
* This procedure is a wrapper around Tcl_Realloc, needed because of a
* mismatched type signature between Tcl_Realloc and realloc.
*
*----------------------------------------------------------------------
*/
void *
TclBNRealloc(
void *p,
size_t s)
{
return (void *) ckrealloc((char *) p, (unsigned int) s);
}
/*
*----------------------------------------------------------------------
*
* TclBNFree --
*
* Free allocated memory in libtommath.
*
* Results:
* None.
*
* Side effects:
* Memory is freed.
*
* This function is simply a wrapper around Tcl_Free, needed in libtommath
* because of a type mismatch between free and Tcl_Free.
*
*----------------------------------------------------------------------
*/
extern void
TclBNFree(
void *p)
{
ckree((char *) p);
}
#endif
/*
*----------------------------------------------------------------------
*
* TclBNInitBignumFromLong --
* TclInitBignumFromLong --
*
* Allocate and initialize a 'bignum' from a native 'long'.
*
@@ -181,47 +106,20 @@ TclBNFree(
*----------------------------------------------------------------------
*/
extern void
TclBNInitBignumFromLong(
void
TclInitBignumFromLong(
mp_int *a,
long initVal)
long v)
{
int status;
unsigned long v;
mp_digit *p;
/*
* Allocate enough memory to hold the largest possible long
*/
status = mp_init_size(a,
(CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT);
if (status != MP_OKAY) {
Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
if (mp_init_size(a, (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
Tcl_Panic("initialization failure in TclInitBignumFromLong");
}
/*
* Convert arg to sign and magnitude.
*/
if (initVal < 0) {
a->sign = MP_NEG;
v = -initVal;
if (v < (long)0) {
mp_set_long_long(a, (Tcl_WideUInt)(-(Tcl_WideInt)v));
mp_neg(a, a);
} else {
a->sign = MP_ZPOS;
v = initVal;
mp_set_long_long(a, (Tcl_WideUInt)v);
}
/*
* Store the magnitude in the bignum.
*/
p = a->dp;
while (v) {
*p++ = (mp_digit) (v & MP_MASK);
v >>= MP_DIGIT_BIT;
}
a->used = p - a->dp;
}
/*
@@ -240,16 +138,19 @@ TclBNInitBignumFromLong(
*----------------------------------------------------------------------
*/
extern void
TclBNInitBignumFromWideInt(
void
TclInitBignumFromWideInt(
mp_int *a, /* Bignum to initialize */
Tcl_WideInt v) /* Initial value */
{
if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
}
if (v < (Tcl_WideInt)0) {
TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v));
mp_set_long_long(a, (Tcl_WideUInt)(-v));
mp_neg(a, a);
} else {
TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v);
mp_set_long_long(a, (Tcl_WideUInt)v);
}
}
@@ -269,36 +170,15 @@ TclBNInitBignumFromWideInt(
*----------------------------------------------------------------------
*/
extern void
TclBNInitBignumFromWideUInt(
void
TclInitBignumFromWideUInt(
mp_int *a, /* Bignum to initialize */
Tcl_WideUInt v) /* Initial value */
{
int status;
mp_digit *p;
/*
* Allocate enough memory to hold the largest possible Tcl_WideUInt.
*/
status = mp_init_size(a,
(CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT);
if (status != MP_OKAY) {
Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
}
a->sign = MP_ZPOS;
/*
* Store the magnitude in the bignum.
*/
p = a->dp;
while (v) {
*p++ = (mp_digit) (v & MP_MASK);
v >>= MP_DIGIT_BIT;
}
a->used = p - a->dp;
if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
}
mp_set_long_long(a, v);
}
/*
+176 -55
View File
@@ -68,11 +68,7 @@ static const unsigned char totalBytes[256] = {
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
#if TCL_UTF_MAX > 3
4,4,4,4,4,4,4,4,
#else
1,1,1,1,1,1,1,1,
#endif
1,1,1,1,1,1,1,1
};
@@ -94,7 +90,7 @@ static const unsigned char totalBytes[256] = {
int
TclUtfCount(
int ch) /* The Tcl_UniChar whose size is returned. */
int ch) /* The Unicode character whose size is returned. */
{
if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
return 1;
@@ -253,6 +249,15 @@ Tcl_UniCharToUtfDString(
* Tcl_UtfCharComplete() before calling this routine to ensure that
* enough bytes remain in the string.
*
* If TCL_UTF_MAX == 4, special handling of Surrogate pairs is done:
* For any UTF-8 string containing a character outside of the BMP, the
* first call to this function will fill *chPtr with the high surrogate
* and generate a return value of 0. Calling Tcl_UtfToUniChar again
* will produce the low surrogate and a return value of 4. Because *chPtr
* is used to remember whether the high surrogate is already produced, it
* is recommended to initialize the variable it points to as 0 before
* the first call to Tcl_UtfToUniChar is done.
*
* Results:
* *chPtr is filled with the Tcl_UniChar, and the return value is the
* number of bytes from the UTF-8 string that were consumed.
@@ -272,7 +277,7 @@ Tcl_UtfToUniChar(
register int byte;
/*
* Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
* Unroll 1 to 3 (or 4) byte UTF-8 sequences.
*/
byte = *((unsigned char *) src);
@@ -319,18 +324,45 @@ Tcl_UtfToUniChar(
* represents itself.
*/
}
#if TCL_UTF_MAX > 3
else if (byte < 0xF8) {
if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
/*
* Four-byte-character lead byte followed by three trail bytes.
*/
#if TCL_UTF_MAX == 3
byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000;
if (byte & 0x100000) {
/* out of range, < 0x10000 or > 0x10ffff */
} else {
/* produce replacement character, and advance source pointer */
*chPtr = (Tcl_UniChar) 0xFFFD;
return 4;
}
#elif TCL_UTF_MAX == 4
Tcl_UniChar surrogate;
byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000;
surrogate = (Tcl_UniChar) (0xD800 + (byte >> 10));
if (byte & 0x100000) {
/* out of range, < 0x10000 or > 0x10ffff */
} else if (*chPtr != surrogate) {
/* produce high surrogate, but don't advance source pointer */
*chPtr = surrogate;
return 0;
} else {
/* produce low surrogate, and advance source pointer */
*chPtr = (Tcl_UniChar) (0xDC00 | (byte & 0x3FF));
return 4;
}
#else
*chPtr = (Tcl_UniChar) (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) {
return 4;
}
#endif
}
/*
@@ -338,7 +370,6 @@ Tcl_UtfToUniChar(
* represents itself.
*/
}
#endif
*chPtr = (Tcl_UniChar) byte;
return 1;
@@ -371,7 +402,7 @@ Tcl_UtfToUniCharDString(
* appended to this previously initialized
* DString. */
{
Tcl_UniChar *w, *wString;
Tcl_UniChar ch = 0, *w, *wString;
const char *p, *end;
int oldLength;
@@ -393,8 +424,8 @@ Tcl_UtfToUniCharDString(
w = wString;
end = src + length;
for (p = src; p < end; ) {
p += TclUtfToUniChar(p, w);
w++;
p += TclUtfToUniChar(p, &ch);
*w++ = ch;
}
*w = '\0';
Tcl_DStringSetLength(dsPtr,
@@ -428,10 +459,7 @@ Tcl_UtfCharComplete(
* a complete UTF-8 character. */
int length) /* Length of above string in bytes. */
{
int ch;
ch = *((unsigned char *) src);
return length >= totalBytes[ch];
return length >= totalBytes[(unsigned char)*src];
}
/*
@@ -458,8 +486,8 @@ Tcl_NumUtfChars(
int length) /* The length of the string in bytes, or -1
* for strlen(string). */
{
Tcl_UniChar ch;
register int i;
Tcl_UniChar ch = 0;
register int i = 0;
/*
* The separate implementations are faster.
@@ -468,7 +496,6 @@ Tcl_NumUtfChars(
* single-byte char case specially.
*/
i = 0;
if (length < 0) {
while (*src != '\0') {
src += TclUtfToUniChar(src, &ch);
@@ -476,13 +503,13 @@ Tcl_NumUtfChars(
}
if (i < 0) i = INT_MAX; /* Bug [2738427] */
} else {
register const char *endPtr = src + length - TCL_UTF_MAX;
register const char *endPtr = src + length - 4;
while (src < endPtr) {
src += TclUtfToUniChar(src, &ch);
i++;
}
endPtr += TCL_UTF_MAX;
endPtr += 4;
while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
src += TclUtfToUniChar(src, &ch);
i++;
@@ -499,13 +526,13 @@ Tcl_NumUtfChars(
*
* Tcl_UtfFindFirst --
*
* Returns a pointer to the first occurance of the given Tcl_UniChar in
* the NULL-terminated UTF-8 string. The NULL terminator is considered
* Returns a pointer to the first occurance of the given Unicode character
* in the NULL-terminated UTF-8 string. The NULL terminator is considered
* part of the UTF-8 string. Equivalent to Plan 9 utfrune().
*
* Results:
* As above. If the Tcl_UniChar does not exist in the given string, the
* return value is NULL.
* As above. If the Unicode character does not exist in the given string,
* the return value is NULL.
*
* Side effects:
* None.
@@ -516,14 +543,21 @@ Tcl_NumUtfChars(
const char *
Tcl_UtfFindFirst(
const char *src, /* The UTF-8 string to be searched. */
int ch) /* The Tcl_UniChar to search for. */
int ch) /* The Unicode character to search for. */
{
int len;
Tcl_UniChar find;
int len, fullchar;
Tcl_UniChar find = 0;
while (1) {
len = TclUtfToUniChar(src, &find);
if (find == ch) {
fullchar = find;
#if TCL_UTF_MAX == 4
if (!len) {
len += TclUtfToUniChar(src, &find);
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
}
#endif
if (fullchar == ch) {
return src;
}
if (*src == '\0') {
@@ -538,12 +572,12 @@ Tcl_UtfFindFirst(
*
* Tcl_UtfFindLast --
*
* Returns a pointer to the last occurance of the given Tcl_UniChar in
* the NULL-terminated UTF-8 string. The NULL terminator is considered
* Returns a pointer to the last occurance of the given Unicode character
* in the NULL-terminated UTF-8 string. The NULL terminator is considered
* part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
*
* Results:
* As above. If the Tcl_UniChar does not exist in the given string, the
* As above. If the Unicode character does not exist in the given string, the
* return value is NULL.
*
* Side effects:
@@ -555,16 +589,23 @@ Tcl_UtfFindFirst(
const char *
Tcl_UtfFindLast(
const char *src, /* The UTF-8 string to be searched. */
int ch) /* The Tcl_UniChar to search for. */
int ch) /* The Unicode character to search for. */
{
int len;
Tcl_UniChar find;
int len, fullchar;
Tcl_UniChar find = 0;
const char *last;
last = NULL;
while (1) {
len = TclUtfToUniChar(src, &find);
if (find == ch) {
fullchar = find;
#if TCL_UTF_MAX == 4
if (!len) {
len += TclUtfToUniChar(src, &find);
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
}
#endif
if (fullchar == ch) {
last = src;
}
if (*src == '\0') {
@@ -598,9 +639,15 @@ const char *
Tcl_UtfNext(
const char *src) /* The current location in the string. */
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
int len = TclUtfToUniChar(src, &ch);
return src + TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX == 4
if (len == 0) {
len = TclUtfToUniChar(src, &ch);
}
#endif
return src + len;
}
/*
@@ -633,9 +680,8 @@ Tcl_UtfPrev(
const char *look;
int i, byte;
src--;
look = src;
for (i = 0; i < TCL_UTF_MAX; i++) {
look = --src;
for (i = 0; i < 4; i++) {
if (look < start) {
if (src < start) {
src = start;
@@ -659,7 +705,7 @@ Tcl_UtfPrev(
*
* Tcl_UniCharAtIndex --
*
* Returns the Unicode character represented at the specified character
* Returns the Tcl_UniChar represented at the specified character
* (not byte) position in the UTF-8 string.
*
* Results:
@@ -678,8 +724,7 @@ Tcl_UniCharAtIndex(
{
Tcl_UniChar ch = 0;
while (index >= 0) {
index--;
while (index-- >= 0) {
src += TclUtfToUniChar(src, &ch);
}
return ch;
@@ -707,10 +752,9 @@ Tcl_UtfAtIndex(
register const char *src, /* The UTF-8 string. */
register int index) /* The position of the desired character. */
{
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
while (index > 0) {
index--;
while (index-- > 0) {
src += TclUtfToUniChar(src, &ch);
}
return src;
@@ -791,7 +835,7 @@ int
Tcl_UtfToUpper(
char *str) /* String to convert in place. */
{
Tcl_UniChar ch, upChar;
Tcl_UniChar ch = 0, upChar;
char *src, *dst;
int bytes;
@@ -844,7 +888,7 @@ int
Tcl_UtfToLower(
char *str) /* String to convert in place. */
{
Tcl_UniChar ch, lowChar;
Tcl_UniChar ch = 0, lowChar;
char *src, *dst;
int bytes;
@@ -898,7 +942,7 @@ int
Tcl_UtfToTitle(
char *str) /* String to convert in place. */
{
Tcl_UniChar ch, titleChar, lowChar;
Tcl_UniChar ch = 0, titleChar, lowChar;
char *src, *dst;
int bytes;
@@ -1007,7 +1051,7 @@ Tcl_UtfNcmp(
const char *ct, /* UTF string cs is compared to. */
unsigned long numChars) /* Number of UTF chars to compare. */
{
Tcl_UniChar ch1, ch2;
Tcl_UniChar ch1 = 0, ch2 = 0;
/*
* Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
@@ -1025,6 +1069,16 @@ Tcl_UtfNcmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return (ch1 - ch2);
}
}
@@ -1055,7 +1109,8 @@ Tcl_UtfNcasecmp(
const char *ct, /* UTF string cs is compared to. */
unsigned long numChars) /* Number of UTF chars to compare. */
{
Tcl_UniChar ch1, ch2;
Tcl_UniChar ch1 = 0, ch2 = 0;
while (numChars-- > 0) {
/*
* n must be interpreted as chars, not bytes.
@@ -1065,6 +1120,16 @@ Tcl_UtfNcasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1074,11 +1139,57 @@ Tcl_UtfNcasecmp(
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UtfCmp --
*
* Compare UTF chars of string cs to string ct case sensitively.
* Replacement for strcmp in Tcl core, in places where UTF-8 should
* be handled.
*
* Results:
* Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclUtfCmp(
const char *cs, /* UTF string to compare to ct. */
const char *ct) /* UTF string cs is compared to. */
{
Tcl_UniChar ch1 = 0, ch2 = 0;
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return ch1 - ch2;
}
}
return UCHAR(*cs) - UCHAR(*ct);
}
/*
*----------------------------------------------------------------------
*
* Tcl_UtfNcasecmp --
* TclUtfCasecmp --
*
* Compare UTF chars of string cs to string ct case insensitively.
* Replacement for strcasecmp in Tcl core, in places where UTF-8 should
@@ -1098,12 +1209,22 @@ TclUtfCasecmp(
const char *cs, /* UTF string to compare to ct. */
const char *ct) /* UTF string cs is compared to. */
{
while (*cs && *ct) {
Tcl_UniChar ch1, ch2;
Tcl_UniChar ch1 = 0, ch2 = 0;
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1684,7 +1805,7 @@ Tcl_UniCharCaseMatch(
* characters. */
int nocase) /* 0 for case sensitive, 1 for insensitive */
{
Tcl_UniChar ch1, p;
Tcl_UniChar ch1 = 0, p;
while (1) {
p = *uniPattern;
+43 -85
View File
@@ -110,7 +110,6 @@ static void FreeThreadHash(ClientData clientData);
static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int SetEndOffsetFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void UpdateStringOfEndOffset(Tcl_Obj *objPtr);
static int FindElement(Tcl_Interp *interp, const char *string,
int stringLength, const char *typeStr,
const char *typeCode, const char **elementPtr,
@@ -119,15 +118,18 @@ static int FindElement(Tcl_Interp *interp, const char *string,
/*
* The following is the Tcl object type definition for an object that
* represents a list index in the form, "end-offset". It is used as a
* performance optimization in TclGetIntForIndex. The internal rep is an
* integer, so no memory management is required for it.
* performance optimization in TclGetIntForIndex. The internal rep is
* stored directly in the wideValue, so no memory management is required
* for it. This is a caching intrep, keeping the result of a parse
* around. This type is only created from a pre-existing string, so an
* updateStringProc will never be called and need not exist.
*/
const Tcl_ObjType tclEndOffsetType = {
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfEndOffset, /* updateStringProc */
NULL, /* updateStringProc */
SetEndOffsetFromAny
};
@@ -974,7 +976,7 @@ Tcl_ScanCountedElement(
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
int flags = CONVERT_ANY;
char flags = CONVERT_ANY;
int numBytes = TclScanElement(src, length, &flags);
*flagPtr = flags;
@@ -1015,7 +1017,7 @@ int
TclScanElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
int *flagPtr) /* Where to store information to guide
char *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
const char *p = src;
@@ -1547,11 +1549,10 @@ Tcl_Merge(
int argc, /* How many strings to merge. */
const char *const *argv) /* Array of string values. */
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
int i, bytesNeeded = 0;
char *result, *dst;
const int maxFlags = UINT_MAX / sizeof(int);
/*
* Handle empty list case first, so logic of the general case can be
@@ -1570,22 +1571,8 @@ Tcl_Merge(
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
} else if (argc > maxFlags) {
/*
* We cannot allocate a large enough flag array to format this list in
* one pass. We could imagine converting this routine to a multi-pass
* implementation, but for sizeof(int) == 4, the limit is a max of
* 2^30 list elements and since each element is at least one byte
* formatted, and requires one byte space between it and the next one,
* that a minimum space requirement of 2^31 bytes, which is already
* INT_MAX. If we tried to format a list of > maxFlags elements, we're
* just going to overflow the size limits on the formatted string
* anyway, so just issue that same panic early.
*/
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
flagPtr = ckalloc(argc * sizeof(int));
flagPtr = ckalloc(argc);
}
for (i = 0; i < argc; i++) {
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
@@ -1619,6 +1606,7 @@ Tcl_Merge(
return result;
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
*----------------------------------------------------------------------
*
@@ -1646,12 +1634,13 @@ Tcl_Backslash(
* src, unless NULL. */
{
char buf[TCL_UTF_MAX];
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
Tcl_UtfBackslash(src, readPtr, buf);
TclUtfToUniChar(buf, &ch);
return (char) ch;
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1680,6 +1669,7 @@ TclTrimRight(
{
const char *p = bytes + numBytes;
int pInc;
Tcl_UniChar ch1 = 0, ch2 = 0;
if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
Tcl_Panic("TclTrimRight works only on null-terminated strings");
@@ -1698,7 +1688,6 @@ TclTrimRight(
*/
do {
Tcl_UniChar ch1;
const char *q = trim;
int bytesLeft = numTrim;
@@ -1710,7 +1699,6 @@ TclTrimRight(
*/
do {
Tcl_UniChar ch2;
int qInc = TclUtfToUniChar(q, &ch2);
if (ch1 == ch2) {
@@ -1760,6 +1748,7 @@ TclTrimLeft(
int numTrim) /* ...and its length in bytes */
{
const char *p = bytes;
Tcl_UniChar ch1 = 0, ch2 = 0;
if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
Tcl_Panic("TclTrimLeft works only on null-terminated strings");
@@ -1778,7 +1767,6 @@ TclTrimLeft(
*/
do {
Tcl_UniChar ch1;
int pInc = TclUtfToUniChar(p, &ch1);
const char *q = trim;
int bytesLeft = numTrim;
@@ -1788,7 +1776,6 @@ TclTrimLeft(
*/
do {
Tcl_UniChar ch2;
int qInc = TclUtfToUniChar(q, &ch2);
if (ch1 == ch2) {
@@ -2122,7 +2109,7 @@ Tcl_StringCaseMatch(
{
int p, charLen;
const char *pstart = pattern;
Tcl_UniChar ch1, ch2;
Tcl_UniChar ch1 = 0, ch2 = 0;
while (1) {
p = *pattern;
@@ -2232,7 +2219,7 @@ Tcl_StringCaseMatch(
*/
if (p == '[') {
Tcl_UniChar startChar, endChar;
Tcl_UniChar startChar = 0, endChar = 0;
pattern++;
if (UCHAR(*str) < 0x80) {
@@ -2545,7 +2532,8 @@ TclStringMatchObj(
udata = Tcl_GetUnicodeFromObj(strObj, &length);
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
} else if (TclIsPureByteArray(strObj) && !flags) {
} else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
&& !flags) {
unsigned char *data, *ptn;
data = Tcl_GetByteArrayFromObj(strObj, &length);
@@ -2717,7 +2705,7 @@ Tcl_DStringAppendElement(
{
char *dst = dsPtr->string + dsPtr->length;
int needSpace = TclNeedSpace(dsPtr->string, dst);
int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
int newSize = dsPtr->length + needSpace
+ TclScanElement(element, -1, &flags);
@@ -3315,6 +3303,7 @@ Tcl_PrintDouble(
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/* ARGSUSED */
char *
TclPrecTraceProc(
@@ -3372,6 +3361,7 @@ TclPrecTraceProc(
*precisionPtr = prec;
return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/
/*
*----------------------------------------------------------------------
@@ -3489,9 +3479,9 @@ int
TclFormatInt(
char *buffer, /* Points to the storage into which the
* formatted characters are written. */
long n) /* The integer to format. */
Tcl_WideInt n) /* The integer to format. */
{
long intVal;
Tcl_WideInt intVal;
int i;
int numFormatted, j;
const char *digits = "0123456789";
@@ -3514,7 +3504,7 @@ TclFormatInt(
intVal = -n; /* [Bug 3390638] Workaround for*/
if (n == -n || intVal == n) { /* broken compiler optimizers. */
return sprintf(buffer, "%ld", n);
return sprintf(buffer, "%" TCL_LL_MODIFIER "d", n);
}
/*
@@ -3598,7 +3588,7 @@ TclGetIntForIndex(
* be converted to one, use it.
*/
*indexPtr = endValue + objPtr->internalRep.longValue;
*indexPtr = endValue + (int)objPtr->internalRep.wideValue;
return TCL_OK;
}
@@ -3662,43 +3652,6 @@ TclGetIntForIndex(
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfEndOffset --
*
* Update the string rep of a Tcl object holding an "end-offset"
* expression.
*
* Results:
* None.
*
* Side effects:
* Stores a valid string in the object's string rep.
*
* This function does NOT free any earlier string rep. If it is called on an
* object that already has a valid string rep, it will leak memory.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfEndOffset(
register Tcl_Obj *objPtr)
{
char buffer[TCL_INTEGER_SPACE + 5];
register int len = 3;
memcpy(buffer, "end", 4);
if (objPtr->internalRep.longValue != 0) {
buffer[len++] = '-';
len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
}
objPtr->bytes = ckalloc((unsigned) len+1);
memcpy(objPtr->bytes, buffer, (unsigned) len+1);
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
*
@@ -3722,7 +3675,7 @@ SetEndOffsetFromAny(
Tcl_Interp *interp, /* Tcl interpreter or NULL */
Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
int offset; /* Offset in the "end-offset" expression */
Tcl_WideInt offset; /* Offset in the "end-offset" expression */
register const char *bytes; /* String rep of the object */
int length; /* Length of the object's string rep */
@@ -3730,7 +3683,7 @@ SetEndOffsetFromAny(
* If it's already the right type, we're fine.
*/
if (objPtr->typePtr == &tclEndOffsetType) {
if (objPtr->typePtr == &endOffsetType) {
return TCL_OK;
}
@@ -3758,15 +3711,20 @@ SetEndOffsetFromAny(
} else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
/*
* This is our limited string expression evaluator. Pass everything
* after "end-" to Tcl_GetInt, then reverse for offset.
* after "end-" to TclParseNumber.
*/
if (TclIsSpaceProc(bytes[4])) {
goto badIndexFormat;
}
if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
if (TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL,
TCL_PARSE_INTEGER_ONLY) != TCL_OK) {
return TCL_ERROR;
}
if (objPtr->typePtr != &tclIntType) {
goto badIndexFormat;
}
offset = objPtr->internalRep.wideValue;
if (bytes[3] == '-') {
offset = -offset;
}
@@ -3790,8 +3748,8 @@ SetEndOffsetFromAny(
*/
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = offset;
objPtr->typePtr = &tclEndOffsetType;
objPtr->internalRep.wideValue = offset;
objPtr->typePtr = &endOffsetType;
return TCL_OK;
}
@@ -4027,7 +3985,7 @@ TclSetProcessGlobalValue(
Tcl_IncrRefCount(newValue);
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy);
hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(size_t)(pgvPtr->epoch), &dummy);
Tcl_SetHashValue(hPtr, newValue);
Tcl_MutexUnlock(&pgvPtr->mutex);
}
@@ -4053,7 +4011,7 @@ TclGetProcessGlobalValue(
Tcl_Obj *value = NULL;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
size_t epoch = pgvPtr->epoch;
unsigned int epoch = pgvPtr->epoch;
if (pgvPtr->encoding) {
Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
@@ -4087,7 +4045,7 @@ TclGetProcessGlobalValue(
}
}
cacheMap = GetThreadHash(&pgvPtr->key);
hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch));
hPtr = Tcl_FindHashEntry(cacheMap, (void *)(size_t)epoch);
if (NULL == hPtr) {
int dummy;
@@ -4120,7 +4078,7 @@ TclGetProcessGlobalValue(
value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
hPtr = Tcl_CreateHashEntry(cacheMap,
(void *)(pgvPtr->epoch), &dummy);
(void *)(size_t)(pgvPtr->epoch), &dummy);
Tcl_MutexUnlock(&pgvPtr->mutex);
Tcl_SetHashValue(hPtr, value);
Tcl_IncrRefCount(value);
+2 -2
View File
@@ -280,7 +280,7 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
&& (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
&& (VarHashRefCount(varPtr) == (unsigned)!TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
ckfree(varPtr);
} else {
@@ -289,7 +289,7 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
(VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
(VarHashRefCount(arrayPtr) == (unsigned)!TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
ckfree(arrayPtr);
} else {
+1 -1
View File
@@ -373,7 +373,7 @@ ConvertErrorToList(
default:
TclNewLiteralStringObj(objv[2], "UNKNOWN");
TclNewLongObj(objv[3], code);
TclNewIntObj(objv[3], code);
return Tcl_NewListObj(4, objv);
}
}
+2 -2
View File
@@ -203,7 +203,7 @@ proc auto_mkindex {dir args} {
}
auto_mkindex_parser::init
foreach file [glob -- {*}$args] {
foreach file [lsort [glob -- {*}$args]] {
try {
append index [auto_mkindex_parser::mkindex $file]
} on error {msg opts} {
@@ -236,7 +236,7 @@ proc auto_mkindex_old {dir args} {
if {![llength $args]} {
set args *.tcl
}
foreach file [glob -- {*}$args] {
foreach file [lsort [glob -- {*}$args]] {
set f ""
set error [catch {
set f [open $file]

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